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

module FSM.Automata (

    Automata,
    -- * Creating functions
    createAutomata,
    
    -- * Accessing functions
    getStates,
    getAcceptingStates,
    getInitialState,
    getInputs,
    getAssociations,
    getTransitions,
    getHoles,
    
    -- * Checking functions
    validInput,
    
    -- * Action functions
    
    performAction,
    -- * 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

-- Custom show functions ---------------------------------------

showIntSet :: [Int] -> Int -> String
showIntSet :: [Int] -> Int -> String
showIntSet [l :: Int
l] 0 = String -> String
forall a. a -> a
id "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "}"
showIntSet [l :: Int
l] _ = Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "}"
showIntSet (l :: Int
l:ls :: [Int]
ls) 0 = String -> String
forall a. a -> a
id "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id ","String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> Int -> String
showIntSet [Int]
ls 1
showIntSet (l :: Int
l:ls :: [Int]
ls) k :: Int
k = Int -> String
forall a. Show a => a -> String
show Int
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id ","String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> Int -> String
showIntSet [Int]
ls Int
k

showCharSet :: [Char] -> Int -> String
showCharSet :: String -> Int -> String
showCharSet [l :: Char
l] 0 = String -> String
forall a. a -> a
id "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "}"
showCharSet [l :: Char
l] _ = Char -> String
forall a. Show a => a -> String
show Char
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "}"
showCharSet (l :: Char
l:ls :: String
ls) 0 = String -> String
forall a. a -> a
id "{" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id ","String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
showCharSet String
ls 1
showCharSet (l :: Char
l:ls :: String
ls) k :: Int
k = Char -> String
forall a. Show a => a -> String
show Char
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id ","String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Int -> String
showCharSet String
ls Int
k
    
-- Create data types -----------------------------------------

data Automata = A (Set Int,Set Char,Int,M.Matrix Int,Set Int,Int)
                --deriving Show
                
instance Show Automata where
    show :: Automata -> String
show (A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a,c :: Int
c)) = 
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Set of states:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" ) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Set of inputs (language):" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" ) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Initial state:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" ) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Matrix of associations:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Matrix Int -> String
forall a. Show a => a -> String
show Matrix Int
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" ) String -> String -> String
forall a. [a] -> [a] -> [a]
++
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Set of accepting states:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a') String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
        (String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "Current state:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. a -> a
id "\n" 
        where s' :: String
s' = [Int] -> Int -> String
showIntSet (Set Int -> [Int]
forall a. Set a -> [a]
toList Set Int
s) 0
              i' :: String
i' = String -> Int -> String
showCharSet (Set Char -> String
forall a. Set a -> [a]
toList Set Char
i) 0
              a' :: String
a' = [Int] -> Int -> String
showIntSet (Set Int -> [Int]
forall a. Set a -> [a]
toList Set Int
a) 0

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

-- | This is the main function for creating the Automata abstract data type. By default, the inital state and the current state of the automata are the same.
--
--  Please pay attention to how the object is built. E.g.,
--
-- > createAutomata s i s0 m a c0
--  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.
-- -c0 is the placeholder for the current state. If it's the first time defining this Automata, leave it as c0 = s0
--
-- 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] 1


createAutomata :: Int -> String -> Int -> M.Matrix Int -> [Int] -> Int -> Automata
createAutomata :: Int -> String -> Int -> Matrix Int -> [Int] -> Int -> Automata
createAutomata s :: Int
s i :: String
i s0 :: Int
s0 m :: Matrix Int
m a :: [Int]
a c0 :: Int
c0
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = 
        String -> Automata
forall a. HasCallStack => String -> a
error "Number of states must be greater than 1"
    | 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, Int) -> Automata
A (Set Int
s',Set Char
i',Int
s0,Matrix Int
m,Set Int
a',Int
c0)
      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 (String -> String
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,c :: Int
c) = 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,c :: Int
c) = 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,c :: Int
c) = 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,c :: Int
c) = 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 <https://en.wikipedia.org/wiki/Lexicographical_order 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.
--
-- More info can be found here: <https://en.wikipedia.org/wiki/State-transition_table Wikipedia: State-transition table>
--
-- 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] 1
--
-- 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,c :: Int
c) = Automata
t
         
-- | This function returns the inputs that a state accepts for transitioning into another state.
--
getTransitions :: Automata -> Int -> Set Char
getTransitions :: Automata -> Int -> Set Char
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) = String -> Set Char
forall a. HasCallStack => String -> a
error "Not a valid state"
    | Bool
otherwise = String -> Set Char
forall a. Ord a => [a] -> Set a
fromList 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 the current state in which the automata currently is.
--
getCurrentState :: Automata -> Int
getCurrentState :: Automata -> Int
getCurrentState t :: Automata
t = Int
c
    where A (s :: Set Int
s,i :: Set Char
i,s0 :: Int
s0,m :: Matrix Int
m,a :: Set Int
a,c :: Int
c) = Automata
t 
          
-- | This function returns the states you can possibly reach from a given state.
--
getOutgoingStates :: Automata -> Int -> Set Int
getOutgoingStates :: Automata -> Int -> Set Int
getOutgoingStates 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) = String -> Set Int
forall a. HasCallStack => String -> a
error "Not a valid state"
    | Bool
otherwise = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList [Int]
l
    where m :: Matrix Int
m = Automata -> Matrix Int
getAssociations 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 :: [Int]
l = [ Int
p | Int
p <- [Int]
row, Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
          
-- | This function returns the states that can possibly reach a given state.
--
getIncomingStates :: Automata -> Int -> Set Int
getIncomingStates :: Automata -> Int -> Set Int
getIncomingStates 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) = String -> Set Int
forall a. HasCallStack => String -> a
error "Not a valid state"
    | Bool
otherwise = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList [Int]
l
    where m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
t
          s :: Set Int
s = Automata -> Set Int
getStates Automata
t
          rows :: [(Int, Bool)]
rows = [(Int
n,Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
member Int
k ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList (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
n Matrix Int
m)))) | Int
n <- [1..(Matrix Int -> Int
forall a. Matrix a -> Int
M.nrows Matrix Int
m)]]
          l :: [Int]
l = [Int
n | (n :: Int
n,bool :: Bool
bool) <- [(Int, Bool)]
rows, Bool
bool Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True]         
          
-- | 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,c :: Int
c) = 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)]]]

-- | This function returns the states of the given automata that cannot be reached.
--
getIsolated :: Automata -> Set Int
getIsolated :: Automata -> Set Int
getIsolated t :: Automata
t = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
fromList [Int]
l
    where s :: Set Int
s = Automata -> Set Int
getStates Automata
t
          l :: [Int]
l = [ Int
p | Int
p <- Set Int -> [Int]
forall a. Set a -> [a]
toList Set Int
s, Automata -> Int -> Set Int
getIncomingStates Automata
t Int
p Set Int -> Set Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set Int
forall a. Set a
empty]


-- 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 (Automata -> Int -> Set Char
getTransitions Automata
a Int
k)) =  String -> Bool
forall a. HasCallStack => String -> a
error ("Not valid input "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String
forall a. Show a => a -> String
show Char
st) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " for state " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
k) )
    | Bool
otherwise = String -> Automata -> Int -> Bool
validInputAux (String -> String
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

-- Action functions

-- | This funcion perform the given transition from the current state and changes to a new current state.
performAction :: Automata -> Char -> Automata
performAction :: Automata -> Char -> Automata
performAction t :: Automata
t char :: Char
char
    | Bool -> Bool
not (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
member Char
char Set Char
i) = String -> Automata
forall a. HasCallStack => String -> a
error ("This is not one of the valid inputs. Please try again with one of the following options: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ts')
    | Bool -> Bool
not (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
member Char
char Set Char
ts) = String -> Automata
forall a. HasCallStack => String -> a
error ("This is not one of the valid inputs for the current state. Please try again with one of the following options: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ts')
    | Bool
otherwise = Automata -> Int -> Automata
changeCurrentState Automata
t Int
c'
        where i :: Set Char
i = String -> Set Char
forall a. Ord a => [a] -> Set a
fromList (Automata -> String
getInputs Automata
t)
              c :: Int
c = Automata -> Int
getCurrentState Automata
t
              ts :: Set Char
ts = Automata -> Int -> Set Char
getTransitions Automata
t Int
c
              ts' :: String
ts' = String -> Int -> String
showCharSet (Set Char -> String
forall a. Set a -> [a]
toList Set Char
ts) 0
              m :: Matrix Int
m = Automata -> Matrix Int
getAssociations Automata
t
              n :: Int
n = (Char -> Set Char -> Int
forall a. Ord a => a -> Set a -> Int
findIndex Char
char Set Char
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
              c' :: Int
c' = Int -> Int -> Matrix Int -> Int
forall a. Int -> Int -> Matrix a -> a
M.getElem Int
c Int
n Matrix Int
m

-- 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] -> Int -> Automata
createAutomata Int
s String
i Int
s0 Matrix Int
m [Int]
t Int
c
    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
          c :: Int
c = Automata -> Int
getCurrentState 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.")
    | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c = String -> Automata
forall a. HasCallStack => String -> a
error ( "You are trying to delete the current state. If you want to perform this action, first change the current state and then delete the old one.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Int -> Automata
createAutomata Int
s String
i' Int
s0' Matrix Int
m [Int]
t Int
c
    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
          c :: Int
c = Automata -> Int
getCurrentState 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is already the initial state.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Int -> Automata
createAutomata Int
s' String
i' Int
s0' Matrix Int
m [Int]
a Int
c
        where a :: [Int]
a = Automata -> [Int]
getAcceptingStates Automata
t 
              c :: Int
c = Automata -> Int
getCurrentState 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 changes the current state.
changeCurrentState :: Automata -> Int -> Automata
changeCurrentState :: Automata -> Int -> Automata
changeCurrentState t :: Automata
t c' :: Int
c'
    | Bool -> Bool
not (Int -> Set Int -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Int
c' (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
getCurrentState Automata
t) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c' = String -> Automata
forall a. HasCallStack => String -> a
error ( "State " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c' String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is already the current state.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Int -> Automata
createAutomata Int
s' String
i' Int
s0 Matrix Int
m [Int]
a Int
c
        where a :: [Int]
a = Automata -> [Int]
getAcceptingStates Automata
t 
              s0 :: Int
s0 = Automata -> Int
getInitialState Automata
t
              c :: Int
c = Automata -> Int
getCurrentState 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is already one of the accepting states.")
    | Bool
otherwise = Int -> String -> Int -> Matrix Int -> [Int] -> Int -> Automata
createAutomata Int
s' String
i' Int
s0 Matrix Int
m [Int]
a' Int
c
    where a :: [Int]
a = Automata -> [Int]
getAcceptingStates Automata
t
          c :: Int
c = Automata -> Int
getCurrentState 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