{-# LANGUAGE ScopedTypeVariables, TypeApplications, TupleSections #-}

-- |Module `TuringMachine.Optimization` include functions for reducing size of
--  Turing machine with saving of functionality.
module TuringMachine.Optimization (
    optimize,
    optimal,
    ifCanOptimize,
    safeOptimize,
    safeOptimal,
    ifCanSafeOptimize,
    DiffTM,
    diffTM,
    module TuringMachine.Optimization.Level,
    module TuringMachine.Optimization.Safe,
    module TuringMachine,
  ) where

import TuringMachine.Optimization.Level
import TuringMachine.Optimization.Safe
import TuringMachine

import TuringMachine.Constructors
import Containers.Set (findMin, deleteMin)
import Containers.Map (fromListWith, mapWithKey)

import qualified Control.Monad.State.Lazy as ST
import Control.Monad.State.Lazy (runState, execStateT, get, put)
import Control.Monad.Trans (lift)
import Control.Monad (when)
import Data.Tuple (swap)
import Data.List (maximumBy)
import Data.Maybe (fromMaybe)
import Data.Containers.ListUtils (nubOrd)

type TMConverting = ST.StateT TuringMachine (ST.State IsChanged) ()

type IsChanged = Bool

isChanged :: TMConverting
isChanged :: TMConverting
isChanged = State IsChanged () -> TMConverting
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State IsChanged () -> TMConverting)
-> State IsChanged () -> TMConverting
forall a b. (a -> b) -> a -> b
$ IsChanged -> State IsChanged ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IsChanged
True

isn'tChanged :: TMConverting
isn'tChanged :: TMConverting
isn'tChanged = State IsChanged () -> TMConverting
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State IsChanged () -> TMConverting)
-> State IsChanged () -> TMConverting
forall a b. (a -> b) -> a -> b
$ IsChanged -> State IsChanged ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put IsChanged
False

ifIsChanged :: TMConverting -> TMConverting
ifIsChanged :: TMConverting -> TMConverting
ifIsChanged TMConverting
tmConv = do
    IsChanged
changed <- State IsChanged IsChanged
-> StateT TuringMachine (State IsChanged) IsChanged
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State IsChanged IsChanged
forall s (m :: * -> *). MonadState s m => m s
get
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when IsChanged
changed
        TMConverting
tmConv

infinityConverting :: TMConverting -> TMConverting
infinityConverting :: TMConverting -> TMConverting
infinityConverting TMConverting
tmConv = do
    TMConverting
isn'tChanged
    TMConverting
tmConv
    TMConverting -> TMConverting
ifIsChanged (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        TMConverting -> TMConverting
infinityConverting TMConverting
tmConv
        TMConverting
isChanged

removeUselessQuadruples :: TMConverting
removeUselessQuadruples :: TMConverting
removeUselessQuadruples = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    Set State
allQs <- Getting (Set State) TuringMachine (Set State)
-> StateT TuringMachine (State IsChanged) (Set State)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set State) TuringMachine (Set State)
TMGetter (Set State)
allStates
    let qsWithM :: Quadruples
qsWithM =
            Predicate QuadrupleToPart
withAnyMove Predicate QuadrupleToPart -> Quadruples -> Quadruples
forall c v. Filterable c v => (v -> IsChanged) -> c -> c
<?> Quadruples
qs
        statesToM :: Set State
statesToM =
            Map QuadrupleFromPart State -> Set State
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet (Map QuadrupleFromPart State -> Set State)
-> Map QuadrupleFromPart State -> Set State
forall a b. (a -> b) -> a -> b
$ QuadrupleToPart -> State
forall a b. (a, b) -> b
snd (QuadrupleToPart -> State)
-> Quadruples -> Map QuadrupleFromPart State
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples
qsWithM
        statesToS :: Set State
statesToS =
            Set State
allQs Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
\\ Set State
statesToM Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
\\ [State] -> Set State
forall c v. UnsafeListable c v => [v] -> c
fromList [State
startState, State
finalState]
        loops :: Quadruples
loops =
            Predicate Quadruple
isLoop Predicate Quadruple -> Quadruples -> Quadruples
forall c v. Filterable c v => (v -> IsChanged) -> c -> c
<?> Quadruples
qs
        qsToStatesToS :: Quadruples
qsToStatesToS =
            (Set State -> Predicate QuadrupleToPart
stateToFrom Set State
statesToS Predicate QuadrupleToPart -> Quadruples -> Quadruples
forall c v. Filterable c v => (v -> IsChanged) -> c -> c
<?> Quadruples
qs) Quadruples -> Quadruples -> Quadruples
forall c. Operable c => c -> c -> c
\\ Quadruples
loops
        [QuadrupleFromPart]
statesAndSymbolsToS :: [(State, Symbol)] =
            (\(S Symbol
s, State
q) -> (State
q, Symbol
s)) (QuadrupleToPart -> QuadrupleFromPart)
-> [QuadrupleToPart] -> [QuadrupleFromPart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [QuadrupleToPart]
forall c v. Valuable c v => c -> [v]
values Quadruples
qsToStatesToS
        Map State (Set Symbol)
statesWithSymbolsToS :: Map State (Set Symbol) =
            (Set Symbol -> Set Symbol -> Set Symbol)
-> [(State, Set Symbol)] -> Map State (Set Symbol)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith Set Symbol -> Set Symbol -> Set Symbol
forall c. Operable c => c -> c -> c
(\/) ([(State, Set Symbol)] -> Map State (Set Symbol))
-> [(State, Set Symbol)] -> Map State (Set Symbol)
forall a b. (a -> b) -> a -> b
$ (QuadrupleFromPart -> (State, Set Symbol))
-> [QuadrupleFromPart] -> [(State, Set Symbol)]
forall a b. (a -> b) -> [a] -> [b]
map ((Symbol -> Identity (Set Symbol))
-> QuadrupleFromPart -> Identity (State, Set Symbol)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Symbol -> Identity (Set Symbol))
 -> QuadrupleFromPart -> Identity (State, Set Symbol))
-> (Symbol -> Set Symbol)
-> QuadrupleFromPart
-> (State, Set Symbol)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Symbol -> Set Symbol
forall c v. Singletonable c v => v -> c
singleton) [QuadrupleFromPart]
statesAndSymbolsToS
        QuadrupleFromPart -> IsChanged
predicate :: (State, Symbol) -> Bool =
            \(State
q, Symbol
s) -> IsChanged -> Maybe IsChanged -> IsChanged
forall a. a -> Maybe a -> a
fromMaybe IsChanged
True (Maybe IsChanged -> IsChanged) -> Maybe IsChanged -> IsChanged
forall a b. (a -> b) -> a -> b
$ do
                Set Symbol
symbolsToS <- Map State (Set Symbol)
statesWithSymbolsToS Map State (Set Symbol) -> State -> Maybe (Set Symbol)
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? State
q
                IsChanged -> Maybe IsChanged
forall (m :: * -> *) a. Monad m => a -> m a
return (IsChanged -> Maybe IsChanged) -> IsChanged -> Maybe IsChanged
forall a b. (a -> b) -> a -> b
$ Symbol
s Symbol -> Set Symbol -> IsChanged
forall c v. Containable c v => v -> c -> IsChanged
`member` Set Symbol
symbolsToS
    (Quadruples -> Identity Quadruples)
-> TuringMachine -> Identity TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> Identity Quadruples)
 -> TuringMachine -> Identity TuringMachine)
-> (QuadrupleFromPart -> IsChanged) -> TMConverting
forall c v s (m :: * -> *).
(Filterable c v, MonadState s m) =>
ASetter s s c c -> (v -> IsChanged) -> m ()
<?>= QuadrupleFromPart -> IsChanged
predicate
    Quadruples
qs' <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when (Quadruples -> Int
forall c. Sizable c => c -> Int
size Quadruples
qs Int -> Int -> IsChanged
forall a. Ord a => a -> a -> IsChanged
> Quadruples -> Int
forall c. Sizable c => c -> Int
size Quadruples
qs')
        TMConverting
isChanged
      where
        isLoop :: Predicate Quadruple
        isLoop :: Predicate Quadruple
isLoop ((State
q1, Symbol
s), (MoveOr Symbol
sm, State
q2)) = State
q1 State -> State -> IsChanged
forall a. Eq a => a -> a -> IsChanged
== State
q2 IsChanged -> IsChanged -> IsChanged
&& MoveOr Symbol
sm MoveOr Symbol -> MoveOr Symbol -> IsChanged
forall a. Eq a => a -> a -> IsChanged
== Symbol -> MoveOr Symbol
forall s. s -> MoveOr s
S Symbol
s
        withAnyMove :: Predicate QuadrupleToPart
        withAnyMove :: Predicate QuadrupleToPart
withAnyMove (M Move
_, State
_) = IsChanged
True
        withAnyMove QuadrupleToPart
_ = IsChanged
False
        stateToFrom :: Set State -> Predicate QuadrupleToPart
        stateToFrom :: Set State -> Predicate QuadrupleToPart
stateToFrom Set State
qs (MoveOr Symbol
_, State
q) = State
q State -> Set State -> IsChanged
forall c v. Containable c v => v -> c -> IsChanged
`member` Set State
qs

unconsSet :: Set a -> (a, Set a)
unconsSet :: Set a -> (a, Set a)
unconsSet Set a
s = (Set a -> a
forall a. Set a -> a
findMin Set a
s, Set a -> Set a
forall a. Set a -> Set a
deleteMin Set a
s)

mergeSimilarStates :: TMConverting
mergeSimilarStates :: TMConverting
mergeSimilarStates = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    Set State
allQs <- Getting (Set State) TuringMachine (Set State)
-> StateT TuringMachine (State IsChanged) (Set State)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Set State) TuringMachine (Set State)
TMGetter (Set State)
allStates
    let Map Symbol (Set State)
statesWithSymbols :: Map Symbol (Set State) =
            (Set State -> Set State -> Set State)
-> [(Symbol, Set State)] -> Map Symbol (Set State)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
(\/) ([(Symbol, Set State)] -> Map Symbol (Set State))
-> [(Symbol, Set State)] -> Map Symbol (Set State)
forall a b. (a -> b) -> a -> b
$ ((Set State, Symbol) -> (Symbol, Set State)
forall a b. (a, b) -> (b, a)
swap ((Set State, Symbol) -> (Symbol, Set State))
-> (QuadrupleFromPart -> (Set State, Symbol))
-> QuadrupleFromPart
-> (Symbol, Set State)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State -> Identity (Set State))
-> QuadrupleFromPart -> Identity (Set State, Symbol)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((State -> Identity (Set State))
 -> QuadrupleFromPart -> Identity (Set State, Symbol))
-> (State -> Set State) -> QuadrupleFromPart -> (Set State, Symbol)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ State -> Set State
forall c v. Singletonable c v => v -> c
singleton)) (QuadrupleFromPart -> (Symbol, Set State))
-> [QuadrupleFromPart] -> [(Symbol, Set State)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [QuadrupleFromPart]
forall c k. Keyable c k => c -> [k]
keys Quadruples
qs
        statesWithoutSymbols :: Map Symbol (Set State)
statesWithoutSymbols =
            (Set State
allQs Set State -> State -> Set State
forall c v. Deletable c v => c -> v -> c
<\ State
finalState Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
\\) (Set State -> Set State)
-> Map Symbol (Set State) -> Map Symbol (Set State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol (Set State)
statesWithSymbols
        [Set State] -> [Set State]
removeUselessGroups :: [Set State] -> [Set State] =
            (Set State -> IsChanged) -> [Set State] -> [Set State]
forall a. (a -> IsChanged) -> [a] -> [a]
filter ((Int -> Int -> IsChanged
forall a. Ord a => a -> a -> IsChanged
> Int
1) (Int -> IsChanged) -> (Set State -> Int) -> Set State -> IsChanged
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set State -> Int
forall c. Sizable c => c -> Int
size)
        cloneLoops :: [Quadruple] -> [Quadruple]
cloneLoops =
            (Quadruple -> [Quadruple]) -> [Quadruple] -> [Quadruple]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Quadruple -> [Quadruple]) -> [Quadruple] -> [Quadruple])
-> (Quadruple -> [Quadruple]) -> [Quadruple] -> [Quadruple]
forall a b. (a -> b) -> a -> b
$ \quad :: Quadruple
quad@((State
qf, Symbol
s), (MoveOr Symbol
sm, State
qt)) ->
                if State
qf State -> State -> IsChanged
forall a. Eq a => a -> a -> IsChanged
== State
qt
                then [Quadruple
quad, ((State
qf, Symbol
s), (MoveOr Symbol
sm, Int -> State
state (-Int
1)))]
                else [Quadruple
quad :: TuringMachine.Quadruple]
        Map Symbol [(QuadrupleToPart, Set State)]
qsGroupedBySymbol :: Map Symbol [((SymbolOrMove, State), Set State)] =
            ([(QuadrupleToPart, Set State)]
 -> [(QuadrupleToPart, Set State)]
 -> [(QuadrupleToPart, Set State)])
-> [(Symbol, [(QuadrupleToPart, Set State)])]
-> Map Symbol [(QuadrupleToPart, Set State)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith [(QuadrupleToPart, Set State)]
-> [(QuadrupleToPart, Set State)] -> [(QuadrupleToPart, Set State)]
forall a. [a] -> [a] -> [a]
(++) ([(Symbol, [(QuadrupleToPart, Set State)])]
 -> Map Symbol [(QuadrupleToPart, Set State)])
-> [(Symbol, [(QuadrupleToPart, Set State)])]
-> Map Symbol [(QuadrupleToPart, Set State)]
forall a b. (a -> b) -> a -> b
$
                (Quadruple -> (Symbol, [(QuadrupleToPart, Set State)]))
-> [Quadruple] -> [(Symbol, [(QuadrupleToPart, Set State)])]
forall a b. (a -> b) -> [a] -> [b]
map (\((State
qf, Symbol
s), QuadrupleToPart
sm_qt) -> (Symbol
s, [(QuadrupleToPart
sm_qt, State -> Set State
forall c v. Singletonable c v => v -> c
singleton State
qf)])) ([Quadruple] -> [(Symbol, [(QuadrupleToPart, Set State)])])
-> [Quadruple] -> [(Symbol, [(QuadrupleToPart, Set State)])]
forall a b. (a -> b) -> a -> b
$
                    [Quadruple] -> [Quadruple]
cloneLoops ([Quadruple] -> [Quadruple]) -> [Quadruple] -> [Quadruple]
forall a b. (a -> b) -> a -> b
$
                        Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs
        qsGroupedBySymbolAndQuadrupleSndPart :: Map Symbol (Map QuadrupleToPart (Set State))
qsGroupedBySymbolAndQuadrupleSndPart =
            (Set State -> Set State -> Set State)
-> [(QuadrupleToPart, Set State)]
-> Map QuadrupleToPart (Set State)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
(\/) ([(QuadrupleToPart, Set State)] -> Map QuadrupleToPart (Set State))
-> Map Symbol [(QuadrupleToPart, Set State)]
-> Map Symbol (Map QuadrupleToPart (Set State))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Symbol [(QuadrupleToPart, Set State)]
qsGroupedBySymbol
        [[Set State]]
groupsOfStates :: [[Set State]] =
            Map Symbol [Set State] -> [[Set State]]
forall c v. Valuable c v => c -> [v]
values (Map Symbol [Set State] -> [[Set State]])
-> Map Symbol [Set State] -> [[Set State]]
forall a b. (a -> b) -> a -> b
$
                (Symbol -> Map QuadrupleToPart (Set State) -> [Set State])
-> Map Symbol (Map QuadrupleToPart (Set State))
-> Map Symbol [Set State]
forall k a b. (k -> a -> b) -> Map k a -> Map k b
mapWithKey (\Symbol
s ->
                    let qsWithoutS :: Set State
qsWithoutS =
                            Set State -> Maybe (Set State) -> Set State
forall a. a -> Maybe a -> a
fromMaybe Set State
forall c. Nullable c => c
emptyC (Maybe (Set State) -> Set State) -> Maybe (Set State) -> Set State
forall a b. (a -> b) -> a -> b
$ Map Symbol (Set State)
statesWithoutSymbols Map Symbol (Set State) -> Symbol -> Maybe (Set State)
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? Symbol
s
                    in  [Set State] -> [Set State]
removeUselessGroups ([Set State] -> [Set State])
-> (Map QuadrupleToPart (Set State) -> [Set State])
-> Map QuadrupleToPart (Set State)
-> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (Set State
qsWithoutS Set State -> [Set State] -> [Set State]
forall a. a -> [a] -> [a]
:) ([Set State] -> [Set State])
-> (Map QuadrupleToPart (Set State) -> [Set State])
-> Map QuadrupleToPart (Set State)
-> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (Set State -> Set State) -> [Set State] -> [Set State]
forall a b. (a -> b) -> [a] -> [b]
map (Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
\/ Set State
qsWithoutS) ([Set State] -> [Set State])
-> (Map QuadrupleToPart (Set State) -> [Set State])
-> Map QuadrupleToPart (Set State)
-> [Set State]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        Map QuadrupleToPart (Set State) -> [Set State]
forall c v. Valuable c v => c -> [v]
values
                  ) (Map Symbol (Map QuadrupleToPart (Set State))
 -> Map Symbol [Set State])
-> Map Symbol (Map QuadrupleToPart (Set State))
-> Map Symbol [Set State]
forall a b. (a -> b) -> a -> b
$
                    Map Symbol (Map QuadrupleToPart (Set State))
qsGroupedBySymbolAndQuadrupleSndPart
        merge2ListsOfGroups :: [Set State] -> [Set State] -> [Set State]
merge2ListsOfGroups [Set State]
log1 [Set State]
log2 = [Set State] -> [Set State]
removeUselessGroups ([Set State] -> [Set State]) -> [Set State] -> [Set State]
forall a b. (a -> b) -> a -> b
$ [Set State] -> [Set State]
forall a. Ord a => [a] -> [a]
nubOrd ([Set State] -> [Set State]) -> [Set State] -> [Set State]
forall a b. (a -> b) -> a -> b
$ do
            Set State
g1 <- [Set State]
log1
            Set State
g2 <- [Set State]
log2
            Set State -> [Set State]
forall (m :: * -> *) a. Monad m => a -> m a
return (Set State -> [Set State]) -> Set State -> [Set State]
forall a b. (a -> b) -> a -> b
$ Set State
g1 Set State -> Set State -> Set State
forall c. Operable c => c -> c -> c
/\ Set State
g2
        totalListOfGroups :: [Set State]
totalListOfGroups = ([Set State] -> [Set State] -> [Set State])
-> [[Set State]] -> [Set State]
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 [Set State] -> [Set State] -> [Set State]
merge2ListsOfGroups [[Set State]]
groupsOfStates
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when (IsChanged -> IsChanged
not (IsChanged -> IsChanged) -> IsChanged -> IsChanged
forall a b. (a -> b) -> a -> b
$ [Set State] -> IsChanged
forall (t :: * -> *) a. Foldable t => t a -> IsChanged
null [Set State]
totalListOfGroups) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        let Map State State
statesWithSimilarState :: Map State State =
                [(State, State)] -> Map State State
forall c v. UnsafeListable c v => [v] -> c
fromList ([(State, State)] -> Map State State)
-> [(State, State)] -> Map State State
forall a b. (a -> b) -> a -> b
$
                    (\(State
q, Set State
qs') -> (,State
q) (State -> (State, State)) -> [State] -> [(State, State)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set State -> [State]
forall c v. Valuable c v => c -> [v]
values Set State
qs') ((State, Set State) -> [(State, State)])
-> (State, Set State) -> [(State, State)]
forall a b. (a -> b) -> a -> b
$
                        Set State -> (State, Set State)
forall a. Set a -> (a, Set a)
unconsSet (Set State -> (State, Set State))
-> Set State -> (State, Set State)
forall a b. (a -> b) -> a -> b
$
                            (Set State -> Set State -> Ordering) -> [Set State] -> Set State
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Set State -> Int) -> Set State -> Set State -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Set State -> Int
forall c. Sizable c => c -> Int
size) ([Set State] -> Set State) -> [Set State] -> Set State
forall a b. (a -> b) -> a -> b
$
                                [Set State]
totalListOfGroups
        (State -> Identity (Maybe State))
-> TuringMachine -> Identity TuringMachine
TMSetter State (Maybe State)
states ((State -> Identity (Maybe State))
 -> TuringMachine -> Identity TuringMachine)
-> (State -> Maybe State) -> TMConverting
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \State
s -> State -> Maybe State
forall a. a -> Maybe a
Just (State -> Maybe State) -> State -> Maybe State
forall a b. (a -> b) -> a -> b
$ State -> Maybe State -> State
forall a. a -> Maybe a -> a
fromMaybe State
s (Maybe State -> State) -> Maybe State -> State
forall a b. (a -> b) -> a -> b
$ Map State State
statesWithSimilarState Map State State -> State -> Maybe State
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!? State
s
        TMConverting
isChanged

removeUnknownSymbols :: TMConverting
removeUnknownSymbols :: TMConverting
removeUnknownSymbols = do
    Set Symbol
symbolsFromAlphabet  :: Set Symbol <- LensLike' (Const (Set Symbol)) TuringMachine Alphabet
-> (Alphabet -> Set Symbol)
-> StateT TuringMachine (State IsChanged) (Set Symbol)
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const (Set Symbol)) TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet Alphabet -> Set Symbol
forall c v. (Valuable c v, Ord v) => c -> Set v
valuesSet
    Set Symbol
symbolsFromAllPlaces :: Set Symbol <- Getting (Set Symbol) TuringMachine (Set Symbol)
-> StateT TuringMachine (State IsChanged) (Set Symbol)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use  Getting (Set Symbol) TuringMachine (Set Symbol)
TMGetter (Set Symbol)
allSymbols
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when (IsChanged -> IsChanged
not (IsChanged -> IsChanged) -> IsChanged -> IsChanged
forall a b. (a -> b) -> a -> b
$ Set Symbol -> IsChanged
forall c. Nullable c => c -> IsChanged
nullC (Set Symbol -> IsChanged) -> Set Symbol -> IsChanged
forall a b. (a -> b) -> a -> b
$ Set Symbol
symbolsFromAllPlaces Set Symbol -> Set Symbol -> Set Symbol
forall c. Operable c => c -> c -> c
\\ Set Symbol
symbolsFromAlphabet) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        (Symbol -> Identity (Maybe Symbol))
-> TuringMachine -> Identity TuringMachine
TMSetter Symbol (Maybe Symbol)
symbols ((Symbol -> Identity (Maybe Symbol))
 -> TuringMachine -> Identity TuringMachine)
-> (Symbol -> Maybe Symbol) -> TMConverting
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \Symbol
s ->
            if Symbol
s Symbol -> Set Symbol -> IsChanged
forall c v. Containable c v => v -> c -> IsChanged
`member` Set Symbol
symbolsFromAlphabet
            then Symbol -> Maybe Symbol
forall a. a -> Maybe a
Just Symbol
s
            else Maybe Symbol
forall a. Maybe a
Nothing
        TMConverting
isChanged

removeUnusedStates :: TMConverting
removeUnusedStates :: TMConverting
removeUnusedStates = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    let takeStates :: ((a, b), (a, a)) -> [a]
takeStates ((a
q1, b
_), (a
_, a
q2)) = [a
q1,a
q2]
        Set State
statesFromQs :: Set State =
            ([State] -> Set State
forall c v. UnsafeListable c v => [v] -> c
fromList ([State] -> Set State) -> [State] -> Set State
forall a b. (a -> b) -> a -> b
$ [[State]] -> [State]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[State]] -> [State]) -> [[State]] -> [State]
forall a b. (a -> b) -> a -> b
$ Quadruple -> [State]
forall a b a. ((a, b), (a, a)) -> [a]
takeStates (Quadruple -> [State]) -> [Quadruple] -> [[State]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs) Set State -> State -> Set State
forall c v. Insertable c v => c -> v -> c
<+
                State
startState Set State -> State -> Set State
forall c v. Insertable c v => c -> v -> c
<+ State
finalState
        Map State State
renumberedStates :: Map State State =
            [(State, State)] -> Map State State
forall c v. UnsafeListable c v => [v] -> c
fromList ([(State, State)] -> Map State State)
-> [(State, State)] -> Map State State
forall a b. (a -> b) -> a -> b
$ [State] -> [State] -> [(State, State)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set State -> [State]
forall c v. Listable c v => c -> [v]
toList Set State
statesFromQs) [State
forall a. Bounded a => a
minBound..]
    (State -> Identity (Maybe State))
-> TuringMachine -> Identity TuringMachine
TMSetter State (Maybe State)
states ((State -> Identity (Maybe State))
 -> TuringMachine -> Identity TuringMachine)
-> (State -> Maybe State) -> TMConverting
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Map State State
renumberedStates Map State State -> State -> Maybe State
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)

removeUnusedSymbols :: TMConverting
removeUnusedSymbols :: TMConverting
removeUnusedSymbols = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    let takeSymbols :: ((a, a), (MoveOr a, b)) -> [a]
takeSymbols ((a
_, a
s), (MoveOr a
ms, b
_)) =
            case MoveOr a
ms of
                M Move
_  -> [a
s]
                S a
s' -> [a
s, a
s']
        Set Symbol
symbolsFromQs :: Set Symbol =
            [Symbol] -> Set Symbol
forall c v. UnsafeListable c v => [v] -> c
fromList ([Symbol] -> Set Symbol) -> [Symbol] -> Set Symbol
forall a b. (a -> b) -> a -> b
$ [[Symbol]] -> [Symbol]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Symbol]] -> [Symbol]) -> [[Symbol]] -> [Symbol]
forall a b. (a -> b) -> a -> b
$ Quadruple -> [Symbol]
forall a a b. ((a, a), (MoveOr a, b)) -> [a]
takeSymbols (Quadruple -> [Symbol]) -> [Quadruple] -> [[Symbol]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs
        Map Symbol Symbol
renumberedSymbols :: Map Symbol Symbol =
            [(Symbol, Symbol)] -> Map Symbol Symbol
forall c v. UnsafeListable c v => [v] -> c
fromList ([(Symbol, Symbol)] -> Map Symbol Symbol)
-> [(Symbol, Symbol)] -> Map Symbol Symbol
forall a b. (a -> b) -> a -> b
$ [Symbol] -> [Symbol] -> [(Symbol, Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set Symbol -> [Symbol]
forall c v. Listable c v => c -> [v]
toList Set Symbol
symbolsFromQs) [Symbol
forall a. Bounded a => a
minBound..]
    (Symbol -> Identity (Maybe Symbol))
-> TuringMachine -> Identity TuringMachine
TMSetter Symbol (Maybe Symbol)
symbols ((Symbol -> Identity (Maybe Symbol))
 -> TuringMachine -> Identity TuringMachine)
-> (Symbol -> Maybe Symbol) -> TMConverting
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Map Symbol Symbol
renumberedSymbols Map Symbol Symbol -> Symbol -> Maybe Symbol
forall c k v (m :: * -> *).
(Indexable c k v, MonadFail m) =>
c -> k -> m v
!?)

fixIfQuadrupleFromFinalState :: TMConverting
fixIfQuadrupleFromFinalState :: TMConverting
fixIfQuadrupleFromFinalState = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    let fromFinalState :: Predicate Quadruple
fromFinalState = LensLike' (Const IsChanged) Quadruple State
-> (State -> IsChanged) -> Predicate Quadruple
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((QuadrupleFromPart -> Const IsChanged QuadrupleFromPart)
-> Quadruple -> Const IsChanged Quadruple
forall s t a b. Field1 s t a b => Lens s t a b
_1((QuadrupleFromPart -> Const IsChanged QuadrupleFromPart)
 -> Quadruple -> Const IsChanged Quadruple)
-> ((State -> Const IsChanged State)
    -> QuadrupleFromPart -> Const IsChanged QuadrupleFromPart)
-> LensLike' (Const IsChanged) Quadruple State
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(State -> Const IsChanged State)
-> QuadrupleFromPart -> Const IsChanged QuadrupleFromPart
forall s t a b. Field1 s t a b => Lens s t a b
_1) (State -> State -> IsChanged
forall a. Eq a => a -> a -> IsChanged
== State
finalState)
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when ([IsChanged] -> IsChanged
forall (t :: * -> *). Foldable t => t IsChanged -> IsChanged
or ([IsChanged] -> IsChanged) -> [IsChanged] -> IsChanged
forall a b. (a -> b) -> a -> b
$ Predicate Quadruple
fromFinalState Predicate Quadruple -> [Quadruple] -> [IsChanged]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        [ShowedSymbol]
allSs :: [ShowedSymbol] <- LensLike' (Const [ShowedSymbol]) TuringMachine Alphabet
-> (Alphabet -> [ShowedSymbol])
-> StateT TuringMachine (State IsChanged) [ShowedSymbol]
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const [ShowedSymbol]) TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet Alphabet -> [ShowedSymbol]
forall c v. Valuable c v => c -> [v]
values
        TuringMachine -> TMConverting
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TuringMachine -> TMConverting) -> TuringMachine -> TMConverting
forall a b. (a -> b) -> a -> b
$ [ShowedSymbol] -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die [ShowedSymbol]
allSs

fixIfWithoutFinalState :: TMConverting
fixIfWithoutFinalState :: TMConverting
fixIfWithoutFinalState = do
    Quadruples
qs <- Getting Quadruples TuringMachine Quadruples
-> StateT TuringMachine (State IsChanged) Quadruples
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    let hasFinalState :: Predicate Quadruple
hasFinalState = LensLike' (Const IsChanged) Quadruple State
-> (State -> IsChanged) -> Predicate Quadruple
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((QuadrupleToPart -> Const IsChanged QuadrupleToPart)
-> Quadruple -> Const IsChanged Quadruple
forall s t a b. Field2 s t a b => Lens s t a b
_2((QuadrupleToPart -> Const IsChanged QuadrupleToPart)
 -> Quadruple -> Const IsChanged Quadruple)
-> ((State -> Const IsChanged State)
    -> QuadrupleToPart -> Const IsChanged QuadrupleToPart)
-> LensLike' (Const IsChanged) Quadruple State
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(State -> Const IsChanged State)
-> QuadrupleToPart -> Const IsChanged QuadrupleToPart
forall s t a b. Field2 s t a b => Lens s t a b
_2) (State -> State -> IsChanged
forall a. Eq a => a -> a -> IsChanged
== State
finalState)
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when ([IsChanged] -> IsChanged
forall (t :: * -> *). Foldable t => t IsChanged -> IsChanged
and ([IsChanged] -> IsChanged) -> [IsChanged] -> IsChanged
forall a b. (a -> b) -> a -> b
$ IsChanged -> IsChanged
not(IsChanged -> IsChanged)
-> Predicate Quadruple -> Predicate Quadruple
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Predicate Quadruple
hasFinalState Predicate Quadruple -> [Quadruple] -> [IsChanged]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList Quadruples
qs) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        [ShowedSymbol]
allSs :: [ShowedSymbol] <- LensLike' (Const [ShowedSymbol]) TuringMachine Alphabet
-> (Alphabet -> [ShowedSymbol])
-> StateT TuringMachine (State IsChanged) [ShowedSymbol]
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const [ShowedSymbol]) TuringMachine Alphabet
Lens' TuringMachine Alphabet
alphabet Alphabet -> [ShowedSymbol]
forall c v. Valuable c v => c -> [v]
values
        TuringMachine -> TMConverting
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TuringMachine -> TMConverting) -> TuringMachine -> TMConverting
forall a b. (a -> b) -> a -> b
$ [ShowedSymbol] -> TuringMachine
forall s. ShowedSymbolClass s => [s] -> TuringMachine
die [ShowedSymbol]
allSs

optimization :: Level -> TMConverting
optimization :: Level -> TMConverting
optimization Level
l = do
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when (Level
l Level -> Level -> IsChanged
forall a. Ord a => a -> a -> IsChanged
>= Level
O1) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$
        TMConverting -> TMConverting
infinityConverting TMConverting
removeUselessQuadruples
    IsChanged -> TMConverting -> TMConverting
forall (f :: * -> *). Applicative f => IsChanged -> f () -> f ()
when (Level
l Level -> Level -> IsChanged
forall a. Ord a => a -> a -> IsChanged
>= Level
O2) (TMConverting -> TMConverting) -> TMConverting -> TMConverting
forall a b. (a -> b) -> a -> b
$ do
        TMConverting -> TMConverting
infinityConverting TMConverting
mergeSimilarStates
    TMConverting
removeUnknownSymbols
    TMConverting
removeUnusedStates
    TMConverting
removeUnusedSymbols
    TMConverting
fixIfWithoutFinalState
    TMConverting
fixIfQuadrupleFromFinalState

optimize' :: Level -> TuringMachine -> (TuringMachine, Bool)
optimize' :: Level -> TuringMachine -> (TuringMachine, IsChanged)
optimize' Level
l TuringMachine
tm = (State IsChanged TuringMachine
 -> IsChanged -> (TuringMachine, IsChanged))
-> IsChanged
-> State IsChanged TuringMachine
-> (TuringMachine, IsChanged)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State IsChanged TuringMachine
-> IsChanged -> (TuringMachine, IsChanged)
forall s a. State s a -> s -> (a, s)
runState IsChanged
False (State IsChanged TuringMachine -> (TuringMachine, IsChanged))
-> State IsChanged TuringMachine -> (TuringMachine, IsChanged)
forall a b. (a -> b) -> a -> b
$ (TMConverting -> TuringMachine -> State IsChanged TuringMachine)
-> TuringMachine -> TMConverting -> State IsChanged TuringMachine
forall a b c. (a -> b -> c) -> b -> a -> c
flip TMConverting -> TuringMachine -> State IsChanged TuringMachine
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT TuringMachine
tm (TMConverting -> State IsChanged TuringMachine)
-> TMConverting -> State IsChanged TuringMachine
forall a b. (a -> b) -> a -> b
$ Level -> TMConverting
optimization Level
l

optimize :: Level -> TuringMachine -> TuringMachine
optimize :: Level -> TuringMachine -> TuringMachine
optimize = (((TuringMachine -> (TuringMachine, IsChanged))
 -> TuringMachine -> TuringMachine)
-> (Level -> TuringMachine -> (TuringMachine, IsChanged))
-> Level
-> TuringMachine
-> TuringMachine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((TuringMachine -> (TuringMachine, IsChanged))
  -> TuringMachine -> TuringMachine)
 -> (Level -> TuringMachine -> (TuringMachine, IsChanged))
 -> Level
 -> TuringMachine
 -> TuringMachine)
-> (((TuringMachine, IsChanged) -> TuringMachine)
    -> (TuringMachine -> (TuringMachine, IsChanged))
    -> TuringMachine
    -> TuringMachine)
-> ((TuringMachine, IsChanged) -> TuringMachine)
-> (Level -> TuringMachine -> (TuringMachine, IsChanged))
-> Level
-> TuringMachine
-> TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((TuringMachine, IsChanged) -> TuringMachine)
-> (TuringMachine -> (TuringMachine, IsChanged))
-> TuringMachine
-> TuringMachine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (TuringMachine, IsChanged) -> TuringMachine
forall a b. (a, b) -> a
fst Level -> TuringMachine -> (TuringMachine, IsChanged)
optimize'

optimal :: Level -> TuringMachine -> Bool
optimal :: Level -> TuringMachine -> IsChanged
optimal = (((TuringMachine -> (TuringMachine, IsChanged))
 -> TuringMachine -> IsChanged)
-> (Level -> TuringMachine -> (TuringMachine, IsChanged))
-> Level
-> TuringMachine
-> IsChanged
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(((TuringMachine -> (TuringMachine, IsChanged))
  -> TuringMachine -> IsChanged)
 -> (Level -> TuringMachine -> (TuringMachine, IsChanged))
 -> Level
 -> TuringMachine
 -> IsChanged)
-> (((TuringMachine, IsChanged) -> IsChanged)
    -> (TuringMachine -> (TuringMachine, IsChanged))
    -> TuringMachine
    -> IsChanged)
-> ((TuringMachine, IsChanged) -> IsChanged)
-> (Level -> TuringMachine -> (TuringMachine, IsChanged))
-> Level
-> TuringMachine
-> IsChanged
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((TuringMachine, IsChanged) -> IsChanged)
-> (TuringMachine -> (TuringMachine, IsChanged))
-> TuringMachine
-> IsChanged
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (TuringMachine, IsChanged) -> IsChanged
forall a b. (a, b) -> b
snd Level -> TuringMachine -> (TuringMachine, IsChanged)
optimize'

ifCanOptimize :: MonadFail m => Level -> TuringMachine -> m TuringMachine
ifCanOptimize :: Level -> TuringMachine -> m TuringMachine
ifCanOptimize Level
l TuringMachine
tm =
    let (TuringMachine
newTM, IsChanged
changed) = Level -> TuringMachine -> (TuringMachine, IsChanged)
optimize' Level
l TuringMachine
tm
    in  if IsChanged
changed
        then TuringMachine -> m TuringMachine
forall (m :: * -> *) a. Monad m => a -> m a
return TuringMachine
newTM
        else String -> m TuringMachine
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't optimize"

safeOptimize :: Level -> TuringMachine -> TuringMachine
safeOptimize :: Level -> TuringMachine -> TuringMachine
safeOptimize Level
l = Level -> TuringMachine -> TuringMachine
optimize Level
l (TuringMachine -> TuringMachine)
-> (TuringMachine -> TuringMachine)
-> TuringMachine
-> TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TuringMachine -> TuringMachine
secure

safeOptimal :: Level -> TuringMachine -> Bool
safeOptimal :: Level -> TuringMachine -> IsChanged
safeOptimal Level
l = Level -> TuringMachine -> IsChanged
optimal Level
l (TuringMachine -> IsChanged)
-> (TuringMachine -> TuringMachine) -> TuringMachine -> IsChanged
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TuringMachine -> TuringMachine
secure

ifCanSafeOptimize :: MonadFail m => Level -> TuringMachine -> m TuringMachine
ifCanSafeOptimize :: Level -> TuringMachine -> m TuringMachine
ifCanSafeOptimize Level
l = Level -> TuringMachine -> m TuringMachine
forall (m :: * -> *).
MonadFail m =>
Level -> TuringMachine -> m TuringMachine
ifCanOptimize Level
l (TuringMachine -> m TuringMachine)
-> (TuringMachine -> TuringMachine)
-> TuringMachine
-> m TuringMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TuringMachine -> TuringMachine
secure

newtype DiffTM = DiffTM (TuringMachine, TuringMachine)

instance Show DiffTM where
    show :: DiffTM -> String
show (DiffTM (TuringMachine
tm1, TuringMachine
tm2)) = String
"+:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TuringMachine -> String
forall a. Show a => a -> String
show TuringMachine
tm1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TuringMachine -> String
forall a. Show a => a -> String
show TuringMachine
tm2

diffTM :: Level -> TuringMachine -> DiffTM
diffTM :: Level -> TuringMachine -> DiffTM
diffTM Level
l TuringMachine
oldTM =
    let newTM :: TuringMachine
newTM = Level -> TuringMachine -> TuringMachine
optimize Level
l TuringMachine
oldTM
        Set Quadruple
oldQs :: Set TuringMachine.Quadruple =
            [Quadruple] -> Set Quadruple
forall c v. UnsafeListable c v => [v] -> c
fromList ([Quadruple] -> Set Quadruple) -> [Quadruple] -> Set Quadruple
forall a b. (a -> b) -> a -> b
$ Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList (Quadruples -> [Quadruple]) -> Quadruples -> [Quadruple]
forall a b. (a -> b) -> a -> b
$ TuringMachine
oldTMTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
        Set Quadruple
newQs :: Set TuringMachine.Quadruple =
            [Quadruple] -> Set Quadruple
forall c v. UnsafeListable c v => [v] -> c
fromList ([Quadruple] -> Set Quadruple) -> [Quadruple] -> Set Quadruple
forall a b. (a -> b) -> a -> b
$ Quadruples -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList (Quadruples -> [Quadruple]) -> Quadruples -> [Quadruple]
forall a b. (a -> b) -> a -> b
$ TuringMachine
newTMTuringMachine
-> Getting Quadruples TuringMachine Quadruples -> Quadruples
forall s a. s -> Getting a s a -> a
^.Getting Quadruples TuringMachine Quadruples
Lens' TuringMachine Quadruples
quadruples
    in  (TuringMachine, TuringMachine) -> DiffTM
DiffTM (
            TuringMachine
newTM TuringMachine -> (TuringMachine -> TuringMachine) -> TuringMachine
forall a b. a -> (a -> b) -> b
& (Quadruples -> Identity Quadruples)
-> TuringMachine -> Identity TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> Identity Quadruples)
 -> TuringMachine -> Identity TuringMachine)
-> Quadruples -> TuringMachine -> TuringMachine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Quadruple] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (Set Quadruple -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList (Set Quadruple
newQs Set Quadruple -> Set Quadruple -> Set Quadruple
forall c. Operable c => c -> c -> c
\\ Set Quadruple
oldQs)),
            TuringMachine
oldTM TuringMachine -> (TuringMachine -> TuringMachine) -> TuringMachine
forall a b. a -> (a -> b) -> b
& (Quadruples -> Identity Quadruples)
-> TuringMachine -> Identity TuringMachine
Lens' TuringMachine Quadruples
quadruples ((Quadruples -> Identity Quadruples)
 -> TuringMachine -> Identity TuringMachine)
-> Quadruples -> TuringMachine -> TuringMachine
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Quadruple] -> Quadruples
forall c v. UnsafeListable c v => [v] -> c
fromList (Set Quadruple -> [Quadruple]
forall c v. Listable c v => c -> [v]
toList (Set Quadruple
oldQs Set Quadruple -> Set Quadruple -> Set Quadruple
forall c. Operable c => c -> c -> c
\\ Set Quadruple
newQs))
          )