-- Import packages -----------------------------------------

module Automata (

    Automata,
    -- * Creating functions
    createAutomata,
    
    -- * Accesing functions
    getStates,
    getAcceptingStates,
    getInitialState,
    getInputs,
    getAssociations,
    getTransitions,
    getHoles,
    
    -- * Checking functions
    validInput,
    
    -- * Editing functions
    addState,
    deleteState,
    changeInitialState,
    addAcceptingState
     

) where

import Data.Set 
import qualified Data.List   as L
import qualified Data.Matrix as M
import qualified Data.Vector as V
    

-- Create data types -----------------------------------------

data Automata = A (Set Int,Set Char,Int,M.Matrix Int,Set Int)
                deriving Int -> Automata -> ShowS
[Automata] -> ShowS
Automata -> String
(Int -> Automata -> ShowS)
-> (Automata -> String) -> ([Automata] -> ShowS) -> Show Automata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Automata] -> ShowS
$cshowList :: [Automata] -> ShowS
show :: Automata -> String
$cshow :: Automata -> String
showsPrec :: Int -> Automata -> ShowS
$cshowsPrec :: Int -> Automata -> ShowS
Show


-- Creating functions -----------------------------------------

-- | This is the main function for creating the Automata abstract data type. 
--
--  Please pay attention to how the object is built. E.g.,
--
-- > createAutomata s i s0 m a
--  where:
--
-- -s is the number of states of the automata.
-- -i is the language the automata accepts.
-- -s0 is the initial state of the automata.
-- -m is the matrix of associations of the automata. (Details here: 'getAssociations')
-- -a is the list of accepting states of the automata.
--
-- More specifically you could
--
-- > import qualified Data.Matrix as M
-- > mat = M.fromLists [[2,0,0,0],[2,1,4,0],[1,4,0,0],[0,0,0,3]]
-- > tom = createAutomata 4 ['a', 'b', 'c', 'd'] 1 mat [4]


createAutomata :: Int -> String -> Int -> M.Matrix Int -> [Int] -> Automata
createAutomata :: Int -> String -> Int -> Matrix Int -> [Int] -> Automata
createAutomata s :: Int
s i :: String
i s0 :: Int
s0 m :: Matrix Int
m a :: [Int]
a
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
s0 Set Int
s') =
        String -> Automata
forall a. HasCallStack => String -> a
error "Not valid initial state"
    | Bool -> Bool
not ((Matrix Int -> Int
forall a. Matrix a -> Int
M.nrows Matrix Int
m,Matrix Int -> Int
forall a. Matrix a -> Int
M.ncols Matrix Int
m) (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Set Int -> Int
forall a. Set a -> Int
size Set Int
s',Set Char -> Int
forall a. Set a -> Int
size Set Char
i')) =
        String -> Automata
forall a. HasCallStack => String -> a
error "Not valid matrix size"
    | Bool -> Bool
not (Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf (Int -> Set Int -> Set Int
forall a. Ord a => a -> Set a -> Set a
delete 0 ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList (Matrix Int -> [Int]
forall a. Matrix a -> [a]
M.toList Matrix Int
m))) Set Int
s') =
        String -> Automata
forall a. HasCallStack => String -> a
error "Not valid matrix elems"
    | Bool -> Bool
not (Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf Set Int
a' Set Int
s') =
        String -> Automata
forall a. HasCallStack => String -> a
error "Not valid accepting states"
    | Bool
otherwise = (Set Int, Set Char, Int, Matrix Int, Set Int) -> Automata
A (Set Int
s',Set Char
i',Int
s0,Matrix Int
m,Set Int
a')
      where s' :: Set Int
s' = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList [1..Int
s]
            i' :: Set Char
i' = String -> Set Char
forall a. Ord a => [a] -> Set a
fromList (ShowS
forall a. Ord a => [a] -> [a]
L.sort String
i)
            a' :: Set Int
a' = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList ([Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort [Int]
a)



-- Accessing functions ----------------------------------------- 
 
 
-- | This function returns the set of states of the automata. It is really of not much use since the generation of the automata only needs the number of states and not the whole set of them, but just in case you want to check which states does the current automata have. 
getStates :: Automata -> Set Int 
getStates :: Automata -> Set Int
getStates t :: Automata
t = Set Int
s
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t

-- | This function returns the list of accepting states of the automata. It is a list and not a set for coherence purpouses. When you build the automata you have to give a list of accepting states so I though it made sense to also return a list of accepting states as the accessing function.
getAcceptingStates :: Automata -> [Int]
getAcceptingStates :: Automata -> [Int]
getAcceptingStates t :: Automata
t = [Int]
a'
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t     
          a' :: [Int]
a' = Set Int -> [Int]
forall a. Set a -> [a]
toList Set Int
a

-- | This function returns the current initial state of the automata.
getInitialState :: Automata -> Int 
getInitialState :: Automata -> Int
getInitialState t :: Automata
t = Int
s0
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t 

-- | This function returns the string of inputs that the automata accepts.    
getInputs :: Automata -> String
getInputs :: Automata -> String
getInputs t :: Automata
t = Set Char -> String
forall a. Set a -> [a]
toList Set Char
i
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t 
          
-- | This function returns the associations matrix of the automata.  This matrix is built according to the following rules:
--
-- 1. The columns of the matrix represent the inputs of the language that the automata accepts in lexicographical order.
-- 2. The rows of the matrix represent the states of the automata in ascending order.
-- 3. The element \(a_{ij} = k \) means that the state  \(i\) is connected to the state  \(k\) thanks to the input that the column  \(j\)  of the matrix represents.
--
-- Continuing with the previous example, the following matrix correspongs to the automata in the figure.
--
-- > mat = M.fromLists [[2,0,0,0],[2,1,4,0],[1,4,0,0],[0,0,0,3]]
-- > tom = createAutomata 4 ['a', 'b', 'c', 'd'] 1 mat [4]
--
-- The code above represent this matrix: 
--
-- >     'a' 'b' 'c' 'd'         <= inputs
-- >   ------------------
-- > 1 |  2   0   0   0 
-- > 2 |  2   1   4   0  
-- > 3 |  1   4   0   0 
-- > 4 |  0   0   0   3  
-- > 
-- > ^
-- > |
-- > states
-- 
-- And the matrix above represents the transitions in the following automata:
--
-- <<https://i.imgur.com/ymWLlsb.png Tom automata figure>>
{-
--
-- +-----------+------------+----------+----------+----------+
-- |           | 'a'        | 'b'      | 'c'      | 'd'      |  
-- +-----------+------------+----------+----------+----------+
-- | 1         |  \[                                         |
-- +-----------+    \begin{matrix}                           |
-- | 2         |                                             |
-- +-----------+                                             |
-- | 3         |                                             |
-- +-----------+                                             |
-- | 4         |    2 & 0 & 0 & 0 \\                         |
-- |           |    2 & 1 & 4 & 0 \\                         |
-- |           |    1 & 4 & 0 & 0 \\                         |
-- |           |    0 & 0 & 0 & 3                            |
-- |           |    \end{matrix}                             |
-- |           |                                             |
-- |           |    \]                                       |
-- +-----------+------------+----------+----------+----------+
--
-}

getAssociations :: Automata -> M.Matrix Int
getAssociations :: Automata -> Matrix Int
getAssociations t :: Automata
t = Matrix Int
m
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t
         
-- | This function returns the inputs that a state accepts for transitioning into another state.
--
getTransitions :: Automata -> Int -> [Char]
getTransitions :: Automata -> Int -> String
getTransitions t :: Automata
t k :: Int
k 
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k Set Int
s) = ShowS
forall a. HasCallStack => String -> a
error "Not a valid state"
    | Bool
otherwise = String
l
    where m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
t
          i :: String
i = Automata -> String
getInputs Automata
t
          s :: Set Int
s = Automata -> Set Int
getStates Automata
t
          row :: [Int]
row = Vector Int -> [Int]
forall a. Vector a -> [a]
V.toList (Int -> Matrix Int -> Vector Int
forall a. Int -> Matrix a -> Vector a
M.getRow Int
k Matrix Int
m)
          l :: String
l = [ Char
a | (a :: Char
a,k :: Int
k) <- String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip String
i [Int]
row, Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]

-- | This function returns those states of the automata that do not have any input to any other state, i.e., once that a 'hole' state is reached, none of the rest of state can be reached anymore for the current execution.
getHoles :: Automata -> Set Int
getHoles :: Automata -> Set Int
getHoles t :: Automata
t = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList [Int]
hs
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a) = Automata
t 
          hs :: [Int]
hs = [Int
n | Int
n <- Set Int -> [Int]
forall a. Set a -> [a]
toList Set Int
s,
                [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int -> Matrix Int -> Vector Int
forall a. Int -> Matrix a -> Vector a
M.getRow Int
n Matrix Int
m)Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.!Int
k Bool -> Bool -> Bool
|| (Int -> Matrix Int -> Vector Int
forall a. Int -> Matrix a -> Vector a
M.getRow Int
n Matrix Int
m)Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.!Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 | Int
k <- [0..((Set Char -> Int
forall a. Set a -> Int
size Set Char
i)Int -> Int -> Int
forall a. Num a => a -> a -> a
-1)]]]
         
-- getHoles devuelve los estados de los que no parte ninguna arista, i.e. aquellos en los que la matriz tiene en su fila todos los elementos iguales al índice de la fila o nulos

               

 


-- Checking functions -----------------------------------------

validInputAux :: String -> Automata -> Int -> Bool
validInputAux :: String -> Automata -> Int -> Bool
validInputAux str :: String
str a :: Automata
a k :: Int
k
    | Bool -> Bool
not (Set Char -> Set Char -> Bool
forall a. Ord a => Set a -> Set a -> Bool
isSubsetOf (String -> Set Char
forall a. Ord a => [a] -> Set a
fromList String
str) Set Char
i) = String -> Bool
forall a. HasCallStack => String -> a
error "Invalid input"
    | Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
k Set Int
h Bool -> Bool -> Bool
&& Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k Set Int
ac = Bool
True
    | Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
k Set Int
h Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k Set Int
ac) = Bool
False
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
str Bool -> Bool -> Bool
&& Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k Set Int
ac = Bool
True
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null String
str Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k Set Int
ac) = Bool
False
    | Bool -> Bool
not (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
member Char
st (String -> Set Char
forall a. Ord a => [a] -> Set a
fromList (Automata -> Int -> String
getTransitions Automata
a Int
k))) =  String -> Bool
forall a. HasCallStack => String -> a
error ("Not valid input "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall a. Show a => a -> String
show Char
st) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " for state " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
k) )
    | Bool
otherwise = String -> Automata -> Int -> Bool
validInputAux (ShowS
forall a. [a] -> [a]
tail String
str) Automata
a Int
k'
    where s :: Set Int
s = Automata -> Set Int
getStates Automata
a
          i :: Set Char
i = String -> Set Char
forall a. Ord a => [a] -> Set a
fromList (Automata -> String
getInputs Automata
a)
          s0 :: Int
s0 = Automata -> Int
getInitialState Automata
a
          m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
a
          ac :: Set Int
ac = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList (Automata -> [Int]
getAcceptingStates Automata
a)
          h :: Set Int
h = Automata -> Set Int
getHoles Automata
a
          st :: Char
st = String -> Char
forall a. [a] -> a
head String
str
          k' :: Int
k' = Int -> Int -> Matrix Int -> Int
forall a. Int -> Int -> Matrix a -> a
M.getElem Int
k ((Char -> Set Char -> Int
forall a. Ord a => a -> Set a -> Int
findIndex Char
st Set Char
i)Int -> Int -> Int
forall a. Num a => a -> a -> a
+1) Matrix Int
m
         



-- | This function test if a string is @/valid/@, i.e., if when the automata receives the string, ends in one of the accepting states.
validInput :: String -> Automata -> Bool
validInput :: String -> Automata -> Bool
validInput str :: String
str a :: Automata
a = String -> Automata -> Int -> Bool
validInputAux String
str Automata
a Int
s0
    where s0 :: Int
s0 = Automata -> Int
getInitialState Automata
a


-- Editing functions -----------------------------------------


-- | Function for adding a state to an Automata with the list of associations to the other states. If you would want to add a non-connected state, simply enter the list [0,..,0], with as many zeros as possible inputs.
addState :: Automata -> [Int] -> Automata
addState :: Automata -> [Int] -> Automata
addState a :: Automata
a ls :: [Int]
ls 
    | [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Int]
ls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (Automata -> String
getInputs Automata
a) = String -> Automata
forall a. HasCallStack => String -> a
error ( "Not a valid list of associations" ) 
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Automata
createAutomata Int
s String
i Int
s0 Matrix Int
m [Int]
t
    where s :: Int
s = (Matrix Int -> Int
forall a. Matrix a -> Int
M.nrows (Automata -> Matrix Int
getAssociations Automata
a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+1
          i :: String
i = Automata -> String
getInputs Automata
a
          s0 :: Int
s0 = Automata -> Int
getInitialState Automata
a
          t :: [Int]
t = Automata -> [Int]
getAcceptingStates Automata
a
          m :: Matrix Int
m = [[Int]] -> Matrix Int
forall a. [[a]] -> Matrix a
M.fromLists ((Matrix Int -> [[Int]]
forall a. Matrix a -> [[a]]
M.toLists (Automata -> Matrix Int
getAssociations Automata
a))[[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++[[Int]
ls])

dropElemAtIndex :: Int -> [[Int]] -> [[Int]]
dropElemAtIndex :: Int -> [[Int]] -> [[Int]]
dropElemAtIndex i :: Int
i ls :: [[Int]]
ls = Int -> [[Int]] -> [[Int]]
forall a. Int -> [a] -> [a]
L.take (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [[Int]]
ls [[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++ Int -> [[Int]] -> [[Int]]
forall a. Int -> [a] -> [a]
L.drop Int
i [[Int]]
ls

-- | This function deletes a state and all the connections it has with any other state. Please note that this function automatically reassigns new numbers for the remaining states, so the states and the associations matrix change accordingly. E.g. if you delete in the previous automata the 3rd state, then since the new automata has just 3 states, the old 4th state becomes the new 3rd state.
deleteState :: Automata -> Int ->Automata
deleteState :: Automata -> Int -> Automata
deleteState a :: Automata
a i :: Int
i 
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
i (Automata -> Set Int
getStates Automata
a)) = String -> Automata
forall a. HasCallStack => String -> a
error ( "This state is not one of the states of the automata." )
    | (Automata -> Int
getInitialState Automata
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = String -> Automata
forall a. HasCallStack => String -> a
error ( "You are trying to delete the initial state. If you want to perform this action, first change the initial state and then delete the old one.")
    | Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
i ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList (Automata -> [Int]
getAcceptingStates Automata
a)) Bool -> Bool -> Bool
&& [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (Automata -> [Int]
getAcceptingStates Automata
a) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = String -> Automata
forall a. HasCallStack => String -> a
error ("You are trying to delete the only accepting state.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Automata
createAutomata Int
s String
i' Int
s0' Matrix Int
m [Int]
t
    where s :: Int
s = (Matrix Int -> Int
forall a. Matrix a -> Int
M.nrows (Automata -> Matrix Int
getAssociations Automata
a)) Int -> Int -> Int
forall a. Num a => a -> a -> a
-1
          i' :: String
i' = Automata -> String
getInputs Automata
a
          s0 :: Int
s0 = Automata -> Int
getInitialState Automata
a
          s0' :: Int
s0' = if Int
s0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i then Int
s0 else Int
s0Int -> Int -> Int
forall a. Num a => a -> a -> a
-1
          t :: [Int]
t = [if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i then Int
l else Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1 | Int
l <- Set Int -> [Int]
forall a. Set a -> [a]
toList (([Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList (Automata -> [Int]
getAcceptingStates Automata
a)) Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`difference` Int -> Set Int
forall a. a -> Set a
singleton Int
i)]
          rows :: [[Int]]
rows = Matrix Int -> [[Int]]
forall a. Matrix a -> [[a]]
M.toLists (Automata -> Matrix Int
getAssociations Automata
a)
          rows_deleted :: [[Int]]
rows_deleted = Int -> [[Int]] -> [[Int]]
dropElemAtIndex Int
i ([[if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i 
                                              then Int
l
                                              else if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i
                                                   then Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-1
                                                   else 0 | Int
l <- [Int]
ls] | [Int]
ls <- [[Int]]
rows])
          m :: Matrix Int
m = [[Int]] -> Matrix Int
forall a. [[a]] -> Matrix a
M.fromLists [[Int]]
rows_deleted

-- | This function changes the initial state.
changeInitialState :: Automata -> Int -> Automata
changeInitialState :: Automata -> Int -> Automata
changeInitialState t :: Automata
t s0' :: Int
s0' 
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
s0' (Automata -> Set Int
getStates Automata
t)) = String -> Automata
forall a. HasCallStack => String -> a
error ( "This state is not one of the states of the automata." )
    | (Automata -> Int
getInitialState Automata
t) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s0' = String -> Automata
forall a. HasCallStack => String -> a
error ( "State " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is already the initial state.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Automata
createAutomata Int
s' String
i' Int
s0' Matrix Int
m [Int]
a
        where a :: [Int]
a = Automata -> [Int]
getAcceptingStates Automata
t 
              s' :: Int
s' = Set Int -> Int
forall a. Set a -> Int
size (Automata -> Set Int
getStates Automata
t)
              i' :: String
i' = Automata -> String
getInputs Automata
t
              m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
t


-- | This function adds one accepting state
addAcceptingState :: Automata -> Int -> Automata
addAcceptingState :: Automata -> Int -> Automata
addAcceptingState t :: Automata
t a0 :: Int
a0
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
a0 (Automata -> Set Int
getStates Automata
t)) = String -> Automata
forall a. HasCallStack => String -> a
error ( "This state is not one of the states of the automata." )
    | Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
a0 (Automata -> [Int]
getAcceptingStates Automata
t)  = String -> Automata
forall a. HasCallStack => String -> a
error ( "State " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is already one of the accepting states.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Automata
createAutomata Int
s' String
i' Int
s0 Matrix Int
m [Int]
a'
    where a :: [Int]
a = Automata -> [Int]
getAcceptingStates Automata
t 
          a' :: [Int]
a' = [Int]
a [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
a0]
          s' :: Int
s' = Set Int -> Int
forall a. Set a -> Int
size (Automata -> Set Int
getStates Automata
t)
          i' :: String
i' = Automata -> String
getInputs Automata
t
          m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
t
          s0 :: Int
s0 = Automata -> Int
getInitialState Automata
t