{-# LANGUAGE MultiWayIf #-}

-- |Module `TM2SP` include functions `semigroupGamma`, `semigroupGamma_1` and
--  `semigroupGamma_2` for converting Turing machine to semigroup presentation.
module TM2SP (
    convertInput,
    semigroupGamma,
    semigroupGamma_1,
    semigroupGamma_2,
  ) where

import TM2SP.Generators
import TM2SP.Relations
import TuringMachine
import qualified SemigroupPresentation as SP
import ShowInfo

tm2sp ::
    MonadFail m =>
    Gens ->
    Rels ->
    TuringMachine ->
    m SP.SemigroupPresentation
tm2sp :: Gens -> Rels -> TuringMachine -> m SemigroupPresentation
tm2sp Gens
gs Rels
rs' TuringMachine
tm = do
    GeneratorsDescr
gd <- Gens -> TuringMachine -> m GeneratorsDescr
forall (m :: * -> *).
MonadFail m =>
Gens -> TuringMachine -> m GeneratorsDescr
gens Gens
gs TuringMachine
tm
    Relations
rs <- Rels -> GeneratorsDescr -> TuringMachine -> m Relations
forall (m :: * -> *).
MonadFail m =>
Rels -> GeneratorsDescr -> TuringMachine -> m Relations
rels Rels
rs' GeneratorsDescr
gd TuringMachine
tm
    SemigroupPresentation -> m SemigroupPresentation
forall (m :: * -> *) a. Monad m => a -> m a
return (SemigroupPresentation -> m SemigroupPresentation)
-> SemigroupPresentation -> m SemigroupPresentation
forall a b. (a -> b) -> a -> b
$ Relations -> GeneratorsDescr -> SemigroupPresentation
SP.semigroupPresentation Relations
rs GeneratorsDescr
gd

convertInput :: MonadFail m => TuringMachine -> (String, Int) -> m String
convertInput :: TuringMachine -> (String, Int) -> m String
convertInput TuringMachine
tm (String
"", Int
_) = do
    let a :: Alphabet
a = TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet
    Symbol
b <- Alphabet
a Alphabet -> ShowedSymbol -> m Symbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? ShowedSymbol
blank
    let b' :: String
b' = String
"s_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Symbol -> Int
numSymbol Symbol
b)
    String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"h", String
"q_1", String
b', String
"h"]
convertInput TuringMachine
tm (String
str, Int
pos) = do
    let a :: Alphabet
a = TuringMachine
tmTuringMachine
-> Getting Alphabet TuringMachine Alphabet -> Alphabet
forall s a. s -> Getting a s a -> a
^.Getting Alphabet TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet
    [Symbol]
ss <- (ShowedSymbol -> m Symbol) -> [ShowedSymbol] -> m [Symbol]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Alphabet
a Alphabet -> ShowedSymbol -> m Symbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?) ([ShowedSymbol] -> m [Symbol]) -> [ShowedSymbol] -> m [Symbol]
forall a b. (a -> b) -> a -> b
$ String -> [ShowedSymbol]
forall s. ShowedSymbolClass s => [s] -> [ShowedSymbol]
showedSymbols String
str
    String
b' <- (String
"s_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Symbol -> Int) -> Symbol -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> Int
numSymbol (Symbol -> String) -> m Symbol -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Alphabet
a Alphabet -> ShowedSymbol -> m Symbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? ShowedSymbol
blank)
    let ss' :: [String]
ss' = (String
"s_" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Symbol -> Int) -> Symbol -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> Int
numSymbol (Symbol -> String) -> [Symbol] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Symbol]
ss
        ss'' :: [String]
ss'' = if
            | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
                [String
"q_1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (-Int
pos) String
b' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ss'
            | Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str ->
                [String]
ss' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) String
b' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"q_1", String
b']
            | Bool
otherwise ->
                Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
pos [String]
ss' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"q_1"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
pos [String]
ss'
    String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"h" String -> [String] -> [String]
forall c v. Insertable c v => v -> c -> c
+> [String]
ss'' [String] -> String -> [String]
forall c v. Insertable c v => c -> v -> c
<+ String
"h"

semigroupGamma :: MonadFail m => TuringMachine -> m SP.SemigroupPresentation
semigroupGamma :: TuringMachine -> m SemigroupPresentation
semigroupGamma =
    Gens -> Rels -> TuringMachine -> m SemigroupPresentation
forall (m :: * -> *).
MonadFail m =>
Gens -> Rels -> TuringMachine -> m SemigroupPresentation
tm2sp [
            String -> Gen
simple String
"q h",
            String
"s_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumSymbols,
            String
"q_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumStates
        ] [[
            [
            String
"q_i s_j" String -> String -> Rel
=== String
"q_l s_k"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} s_{k} q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Predicate StrQuadruple
withoutMove))
              ),
            [
            String
"q_i s_j s_B" String -> String -> Rel
=== String
"s_j q_l s_B",
            String
"q_i s_j h" String -> String -> Rel
=== String
"s_j q_l s_0 h"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} R q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toRight))
              ),
            [
            String
"s_B q_i s_j" String -> String -> Rel
=== String
"q_l s_B s_j",
            String
"h q_i s_j" String -> String -> Rel
=== String
"h q_l s_0 s_j"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} L q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toLeft))
              ),
            String
"q_0 s_B" String -> String -> Rel
=== String
"q_0",
            String
"s_B q_0 h" String -> String -> Rel
=== String
"q_0 h",
            String
"h q_0 h" String -> String -> Rel
=== String
"q"
        ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range String -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (String
"s_{B}" String -> StrGetter -> Range String
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'` StrGetter
strNumSymbols)]

semigroupGamma_1 :: MonadFail m => TuringMachine -> m SP.SemigroupPresentation
semigroupGamma_1 :: TuringMachine -> m SemigroupPresentation
semigroupGamma_1 =
    Gens -> Rels -> TuringMachine -> m SemigroupPresentation
forall (m :: * -> *).
MonadFail m =>
Gens -> Rels -> TuringMachine -> m SemigroupPresentation
tm2sp [
            String -> Gen
simple String
"q h",
            String
"s_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumSymbols,
            String
"q_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumStates
        ] [[
            [
            String
"q_i s_j" String -> String -> Rel
=== String
"q_l s_k"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} s_{k} q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Predicate StrQuadruple
withoutMove))
              ),
            [
            String
"q_i h" String -> String -> Rel
=== String
"q_l s_k h"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_0 s_{k} q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Predicate StrQuadruple
withoutMovePredicate StrQuadruple
-> Predicate StrQuadruple -> Predicate StrQuadruple
forall a. Predicate a -> Predicate a -> Predicate a
&.Symbol -> Predicate StrQuadruple
fromSymbol(Symbol
blankSymbol)))
              ),
            [
            String
"q_i s_j" String -> String -> Rel
=== String
"s_j q_l"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} R q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toRight))
              ),
            [
            String
"q_i h" String -> String -> Rel
=== String
"s_0 q_l h"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_0 R q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove(Move
toRight)Predicate StrQuadruple
-> Predicate StrQuadruple -> Predicate StrQuadruple
forall a. Predicate a -> Predicate a -> Predicate a
&.Symbol -> Predicate StrQuadruple
fromSymbol(Symbol
blankSymbol)))
              ),
            [
            String
"s_B q_i s_j" String -> String -> Rel
=== String
"q_l s_B s_j",
            String
"h q_i s_j" String -> String -> Rel
=== String
"h q_l s_0 s_j"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} L q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toLeft))
              ),
            [
            String
"s_B q_i h" String -> String -> Rel
=== String
"q_l s_B h"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_0 L q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove(Move
toLeft)Predicate StrQuadruple
-> Predicate StrQuadruple -> Predicate StrQuadruple
forall a. Predicate a -> Predicate a -> Predicate a
&.Symbol -> Predicate StrQuadruple
fromSymbol(Symbol
blankSymbol)))
              ),
            String
"q_0 s_B" String -> String -> Rel
=== String
"q_0",
            String
"s_B q_0 h" String -> String -> Rel
=== String
"q_0 h",
            String
"h q_0 h" String -> String -> Rel
=== String
"q"
        ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range String -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (String
"s_{B}" String -> StrGetter -> Range String
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'` StrGetter
strNumSymbols)]

semigroupGamma_2 :: MonadFail m => TuringMachine -> m SP.SemigroupPresentation
semigroupGamma_2 :: TuringMachine -> m SemigroupPresentation
semigroupGamma_2 =
    Gens -> Rels -> TuringMachine -> m SemigroupPresentation
forall (m :: * -> *).
MonadFail m =>
Gens -> Rels -> TuringMachine -> m SemigroupPresentation
tm2sp [
            String -> Gen
simple String
"q h",
            String
"s_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumSymbols,
            String
"q_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumStates,
            String
"qR_{}" String -> StrGetter -> Gen
`from` StrGetter
strNumStates
        ] [[
            [
            String
"q_i s_j" String -> String -> Rel
=== String
"q_l s_k"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} s_{k} q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Predicate StrQuadruple
withoutMove))
              ),
            [
            String
"q_i s_j" String -> String -> Rel
=== String
"s_j q_l"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{i} s_{j} R q_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toRight))
              ),
            [
            String
"s_j qR_i" String -> String -> Rel
=== String
"qR_l s_j"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range StrQuadruple -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"qR_{i} s_{j} L qR_{l}" String -> SetGetter StrQuadruple -> Range StrQuadruple
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set StrQuadruple -> f (Set StrQuadruple))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Move -> Predicate StrQuadruple
withMove Move
toLeft))
              ),
            [
            String
"q_A s_B" String -> String -> Rel
=== String
"s_B qR_A"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range [String] -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{A} qR_{A} s_{B}" String -> SetGetter [String] -> Range [String]
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set [String] -> f (Set [String]))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set [String] -> f (Set [String]))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set [String] -> f (Set [String]))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set [String] -> f (Set [String]))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrPair -> f (Set StrPair))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrPair)
takeFromPart((Set StrPair -> f (Set StrPair))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set [String] -> f (Set [String]))
    -> Set StrPair -> f (Set StrPair))
-> (Set [String] -> f (Set [String]))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (Set StrPair) (Set [String])
forall c.
(Listable c String, Indexable c Index String) =>
Int -> Getter (Set c) (Set [String])
copy(Int
0))
              ),
            [
            String
"q_A h" String -> String -> Rel
=== String
"s_0 qR_A h",
            String
"h qR_A" String -> String -> Rel
=== String
"h q_A s_0"
              ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range [String] -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (
                String
"q_{A} qR_{A} s_0" String -> SetGetter [String] -> Range [String]
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'`
                ((Set StrQuadruple -> f (Set StrQuadruple))
-> TuringMachine -> f TuringMachine
SetGetter StrQuadruple
strQuadruples((Set StrQuadruple -> f (Set StrQuadruple))
 -> TuringMachine -> f TuringMachine)
-> ((Set [String] -> f (Set [String]))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set [String] -> f (Set [String]))
-> TuringMachine
-> f TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrQuadruple -> f (Set StrQuadruple))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrQuadruple)
withoutLoops((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set [String] -> f (Set [String]))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set [String] -> f (Set [String]))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate StrQuadruple
-> Getter (Set StrQuadruple) (Set StrQuadruple)
forall a. Predicate a -> Getter (Set a) (Set a)
takeOnly(Symbol -> Predicate StrQuadruple
fromSymbol(Symbol
blankSymbol))((Set StrQuadruple -> f (Set StrQuadruple))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set [String] -> f (Set [String]))
    -> Set StrQuadruple -> f (Set StrQuadruple))
-> (Set [String] -> f (Set [String]))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Set StrPair -> f (Set StrPair))
-> Set StrQuadruple -> f (Set StrQuadruple)
Getter (Set StrQuadruple) (Set StrPair)
takeFromPart((Set StrPair -> f (Set StrPair))
 -> Set StrQuadruple -> f (Set StrQuadruple))
-> ((Set [String] -> f (Set [String]))
    -> Set StrPair -> f (Set StrPair))
-> (Set [String] -> f (Set [String]))
-> Set StrQuadruple
-> f (Set StrQuadruple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Int -> Getter (Set StrPair) (Set [String])
forall c.
(Listable c String, Indexable c Index String) =>
Int -> Getter (Set c) (Set [String])
copy(Int
0))
              ),
            String
"q_0 s_B" String -> String -> Rel
=== String
"q_0",
            String
"s_B q_0 h" String -> String -> Rel
=== String
"q_0 h",
            String
"h q_0 h" String -> String -> Rel
=== String
"q"
        ] Rels -> (Rels -> Rel) -> Rel
forall a b. a -> (a -> b) -> b
& Range String -> Rels -> Rel
forall e. RangeElement e => Range e -> Rels -> Rel
for' (String
"s_{B}" String -> StrGetter -> Range String
forall e. RangeElement e => String -> SetGetter e -> Range e
`in'` StrGetter
strNumSymbols)]