module Automata (
Automata,
createAutomata,
getStates,
getAcceptingStates,
getInitialState,
getInputs,
getAssociations,
getTransitions,
getHoles,
validInput,
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
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
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)
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
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
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
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
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
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]
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)]]]
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
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
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
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
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
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