{-# LANGUAGE OverloadedStrings #-}

-- |Module `TuringMachine.TMs` include set of Turing machines for testing.
module TuringMachine.TMs (
    testingSetTMs,
    module TuringMachine,
    module ShowInfo,
  ) where

import TuringMachine
import ShowInfo

import TuringMachine.Constructors
import TuringMachine.Optimization

-- here "." == blankChar (from TuringMachine.Symbol)
-- I use "." for more readable code

simple :: String -> TuringMachine
simple :: String -> TuringMachine
simple String
s = (TuringMachine -> TuringMachine -> TuringMachine)
-> [TuringMachine] -> TuringMachine
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 TuringMachine -> TuringMachine -> TuringMachine
(++>) ([TuringMachine] -> TuringMachine)
-> [TuringMachine] -> TuringMachine
forall a b. (a -> b) -> a -> b
$ Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight (String -> TuringMachine)
-> (Char -> String) -> Char -> TuringMachine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> TuringMachine) -> String -> [TuringMachine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s

star :: String -> TuringMachine
star :: String -> TuringMachine
star String
s = TuringMachine -> TuringMachine
loop (String -> TuringMachine
simple String
s) TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"."

plus :: String -> TuringMachine
plus :: String -> TuringMachine
plus String
s = String -> TuringMachine
simple String
s TuringMachine -> TuringMachine -> TuringMachine
++> String -> TuringMachine
star String
s

opt :: String -> TuringMachine
opt :: String -> TuringMachine
opt String
s = String -> TuringMachine
simple String
s TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"."

just :: TuringMachine -> TuringMachine
just :: TuringMachine -> TuringMachine
just = (TuringMachine -> TuringMachine -> TuringMachine
++> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
".")

dyck_v1 :: TuringMachine
dyck_v1 :: TuringMachine
dyck_v1 =
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"*" TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        (
                String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"(" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
                (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
"()*" TuringMachine -> TuringMachine -> TuringMachine
||> String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
"." ShowedSymbol
"*")
              TuringMachine -> TuringMachine -> TuringMachine
||>
                String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
")" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
                (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
"()*" TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toLeft String
".") TuringMachine -> TuringMachine -> TuringMachine
++>
                (String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"*" ShowedSymbol
"." Move
toLeft TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
".()")
          ) TuringMachine -> TuringMachine -> TuringMachine
++> (
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toLeft String
"()*" TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"."
          )
      )

dyck_v2 :: TuringMachine
dyck_v2 :: TuringMachine
dyck_v2 = Level -> TuringMachine -> TuringMachine
optimize Level
maxO (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
")" TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"(" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
        (String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
"(" ShowedSymbol
"{" TuringMachine -> TuringMachine -> TuringMachine
||> String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
")" ShowedSymbol
"}" TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
".")
      ) TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"{" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
        (
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
"{}" TuringMachine -> TuringMachine -> TuringMachine
||>
            String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"(" ShowedSymbol
"{" Move
toRight TuringMachine -> TuringMachine -> TuringMachine
||>
            String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
")" ShowedSymbol
"}" Move
toRight TuringMachine -> TuringMachine -> TuringMachine
||>
            String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"."
          ) TuringMachine -> TuringMachine -> TuringMachine
++>
        (
            String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
"(" ShowedSymbol
"{" TuringMachine -> TuringMachine -> TuringMachine
||>
            String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
")" ShowedSymbol
"}" TuringMachine -> TuringMachine -> TuringMachine
||>
            String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"."
          ) TuringMachine -> TuringMachine -> TuringMachine
++>
        (
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toLeft String
"{}" TuringMachine -> TuringMachine -> TuringMachine
||>
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"."
          )
      ) TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"}" ShowedSymbol
"." Move
toRight)

dyck_v3 :: TuringMachine
dyck_v3 :: TuringMachine
dyck_v3 = Level -> TuringMachine -> TuringMachine
optimize Level
maxO (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
")" TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"(" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
@@>
        String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
")" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
        (
            String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
            (
                String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove String
"(" ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
                (
                    Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
"(" TuringMachine -> TuringMachine -> TuringMachine
||>
                    String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite String
")" ShowedSymbol
"(" TuringMachine -> TuringMachine -> TuringMachine
||>
                    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"."
                  ) TuringMachine -> TuringMachine -> TuringMachine
++>
                (
                    Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toLeft String
"(" TuringMachine -> TuringMachine -> TuringMachine
||>
                    Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"."
                  )
              )
          )
      )

badEvenPalindrome :: String -> TuringMachine
badEvenPalindrome :: String -> TuringMachine
badEvenPalindrome String
a =
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        (TuringMachine -> TuringMachine -> TuringMachine)
-> [TuringMachine] -> TuringMachine
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 TuringMachine -> TuringMachine -> TuringMachine
(||>) [
            String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove [Char
c] ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
            (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
a TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toLeft String
".") TuringMachine -> TuringMachine -> TuringMachine
++>
            (String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite [Char
c] ShowedSymbol
"." TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
a)) TuringMachine -> TuringMachine -> TuringMachine
++>
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toLeft String
"." TuringMachine -> TuringMachine -> TuringMachine
++>
            (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toLeft String
a TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
".")
          | Char
c <- String
a
          ]
      )

evenPalindrome :: String -> TuringMachine
evenPalindrome :: String -> TuringMachine
evenPalindrome String
a =
    String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
check String
"." TuringMachine -> TuringMachine -> TuringMachine
||>
    TuringMachine -> TuringMachine
loop (
        (TuringMachine -> TuringMachine -> TuringMachine)
-> [TuringMachine] -> TuringMachine
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 TuringMachine -> TuringMachine -> TuringMachine
(||>) [
            String -> ShowedSymbol -> Move -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> Move -> TuringMachine
rewriteAndMove [Char
c] ShowedSymbol
"." Move
toRight TuringMachine -> TuringMachine -> TuringMachine
++>
            (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toRight String
a TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toLeft String
".") TuringMachine -> TuringMachine -> TuringMachine
++>
            (String -> ShowedSymbol -> TuringMachine
forall s.
ShowedSymbolClass s =>
[s] -> ShowedSymbol -> TuringMachine
rewrite [Char
c] ShowedSymbol
"." TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die (Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: String
a))
          | Char
c <- String
a
          ] TuringMachine -> TuringMachine -> TuringMachine
++>
        Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toLeft String
"." TuringMachine -> TuringMachine -> TuringMachine
++>
        (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
moveInf Move
toLeft String
a TuringMachine -> TuringMachine -> TuringMachine
||> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
".")
      )

testingSetTMs :: [WithTitle TuringMachine]
testingSetTMs :: [WithTitle TuringMachine]
testingSetTMs = (Title -> TuringMachine -> WithTitle TuringMachine)
-> (Title, TuringMachine) -> WithTitle TuringMachine
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Title -> TuringMachine -> WithTitle TuringMachine
forall a. Title -> a -> WithTitle a
withTitle ((Title, TuringMachine) -> WithTitle TuringMachine)
-> [(Title, TuringMachine)] -> [WithTitle TuringMachine]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [
    (Title
"a*", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
star String
"a"),
    (Title
"a+", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
plus String
"a"),
    (Title
"a?", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
opt String
"a"),
    (Title
"a|b", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
simple String
"a" TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
simple String
"b"),
    (Title
"abc", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
simple String
"abc"),
    (Title
"ababa", TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
simple String
"ababa"),
    (Title
"a(bc)*ba v.1",
        TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ String -> TuringMachine
simple String
"ab" TuringMachine -> TuringMachine -> TuringMachine
++> (String -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die String
"." TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
star String
"cb" TuringMachine -> TuringMachine -> TuringMachine
||> String -> TuringMachine
simple String
"a")
      ),
    (Title
"a(bc)*ba v.2",
        TuringMachine -> TuringMachine
secure (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$ TuringMachine -> TuringMachine
just (TuringMachine -> TuringMachine) -> TuringMachine -> TuringMachine
forall a b. (a -> b) -> a -> b
$
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"a" TuringMachine -> TuringMachine -> TuringMachine
++>
            (Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"b" TuringMachine -> TuringMachine -> TuringMachine
@@> Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"c") TuringMachine -> TuringMachine -> TuringMachine
++>
            Move -> String -> TuringMachine
forall s. ShowedSymbolClass s => Move -> [s] -> TuringMachine
move Move
toRight String
"a"
      ),
    (Title
"Dyck v.1", TuringMachine
dyck_v1),
    (Title
"Dyck v.2", TuringMachine
dyck_v2),
    (Title
"Dyck v.3", TuringMachine
dyck_v3),
    (Title
"wwR 2s v.1", String -> TuringMachine
badEvenPalindrome String
"ab"),
    (Title
"wwR 2s v.2", String -> TuringMachine
evenPalindrome String
"ab"),
    (Title
"wwR 4s v.1", String -> TuringMachine
badEvenPalindrome String
"abcd"),
    (Title
"wwR 4s v.2", String -> TuringMachine
evenPalindrome String
"abcd"),
    (Title
"wwR 8s", String -> TuringMachine
evenPalindrome String
"abcdefgh"),
    (Title
"wwR 16s", String -> TuringMachine
evenPalindrome String
"abcdefghijklmnop"),
    (Title
"wwR 32s", String -> TuringMachine
evenPalindrome String
"abcdefghijklmnopqrstuvwxyz012345"),
    (Title
"wwR 64s",
        String -> TuringMachine
evenPalindrome
            String
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789^_"
      )
  ]