I assume that you know what a finite automaton is: a collection of states, a designated start state, and a designated set of accepting states. Each state is equipped with a set of transitions that indicate a succeessor state for a particular input character read in that state. In a deterministic finite automaton DFA the successor state for a given input is unique and the DFA is said to accept the input if the final state is an accepting state; in a non-deterministic finite automaton (NFA) there may be many successor states for a given state and input and an NFA accepts an input if there is some choice amongst the successor states, at each step, that leads to a final accepting state.
The FA module below provides data structures for modeling both DFAs and NFAs. An FA is a DFA if the successor states, as listed in the transitions field of a state, are unique for every state and input. Technical note: Haskell's laziness and declarative equality allow us to reference states assigned to variables in other states, in any order. However, equality testing needs a unique identifier amongst the states that make up a machine, hence the name field. (Without this, FAs that contain cycles cannot be determined to be equal by the derived == operator.)
module FA where
data FA = FA {start :: FAState, accept:: AcceptFAStates}
data FAState = FAState {name :: Int, transitions :: [Transition]}
type AcceptFAStates = [FAState]
instance Eq FAState where
s1 == s2 = name s1 == name s2
type Transition = (Char, FAState)
{- dfa1: accept strings in {'0', '1'}* that end with '1' -}
d0 = FAState {name=0, transitions=[('0', d0), ('1', d1)]}
d1 = FAState {name=1, transitions=[('1', d1), ('0', d0)]}
dfa1 = FA {start=d0, accept=[d1]}
{- nfa1: accept strings in {'0', '1'}* that contain consecutive 0s or consecutive 1s -}
ns = FAState {name=0, transitions=[('0',ns), ('1',ns), ('0',n01), ('1',n11)]}
n01 = FAState {name=1, transitions=[('0',na)]}
n11 = FAState {name=2, transitions=[('1',na)]}
na = FAState {name=3, transitions=[('0',na), ('1',na)]}
nfa1 = FA {start=ns, accept=[na]}
Now let's define a function, acceptDFA, that implements acceptance testing for DFAs and input strings. acceptDFA uses acceptD to recursively process the input string. In acceptD We take advantage of Maybe values to represent the current state, while processing the string, and whether or not the final state is an accepting state. (Just s) corresponds to being in state s while Nothing represents a failure, which can occur during processing if a character is processed in a state that has no transition for that character, or if the final state is not an accepting state.
The Transition type is an association list. The lookup function (from Data.List and implicitly imported in the Prelude) allows us to find the next state given a character. Conveniently, for an association list having type [Transition], the result type of lookup is Maybe FAState which is just what acceptDFA takes as its first argument.
nextStateD :: FAState -> Char -> Maybe FAState
nextStateD s c = lookup c (transitions s)
Note the initial state passed to acceptD is wrapped in Just; it could equally well be wrapped in return since return is just Just for the Maybe monad.
The AcceptFAStates argument of acceptD allows the function to determine whether the final state is an accepting state.
import Control.Monad
acceptDFA :: FA -> String -> Bool
acceptDFA dfa str = case acceptD (Just (start dfa)) (accept dfa) str of
Nothing -> False
_ -> True
acceptD :: Maybe FAState -> AcceptFAStates -> String -> Maybe FAState
acceptD st accept "" = do
s <- st -- s :: FAstate; if st is Nothing overall value of the do is Nothing
guard $ s `elem` accept -- guard, from Monad.Control, forces the monadic do expression to the unit value, Nothing
-- if it's argument, s `elem` accept, is False
return s -- but if the guard succeeds, the result is Maybe s
acceptD st accept (c:cs) = do
s <- st -- again if st is Nothing, the overall value of the do is Nothing
acceptD (nextStateD s c) accept cs -- otherwise recursively process the remainder of the input after computing the next state
In acceptD we take advantage of the monadic nature of Maybe values to maintain the Nothing value once reached and to report Nothing as the result if the final state is not an accepting state.
show $ map (acceptDFA dfa1) ["", "0", "1", "00", "10", "01", "11"]
We can follow the same general scheme used for DFAs to implement NFA processing. To represent the idea of a non-deterministic state, we use the list monad. Our nextStateN function works in the list monad to compute all of the successor states for a given input state. See the LYAH section on the list monad, but notice how nextStateN returns a list of FAState.
nextStateN :: FAState -> Char -> [FAState]
nextStateN s c = do
(c', s') <- transitions s
guard (c' == c)
return s'
The functions acceptNFA and acceptN now closely parallel their deterministic counterparts.
acceptNFA :: FA -> String -> Bool
acceptNFA nfa str = case acceptN (return (start nfa)) (accept nfa) str of
[] -> False
_ -> True
acceptN :: [FAState] -> AcceptFAStates -> String -> [FAState]
acceptN sts accept "" = do
st <- sts
guard (st `elem` accept)
return st
acceptN sts accept (c:cs) = do
s <- sts
acceptN (nextStateN s c) accept cs
print $ show $ map (acceptNFA dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFA nfa1) ["", "0", "1", "00", "10", "01", "11"]
Notice how acceptNFA has no problem processing the DFA, dfa1: a DFA is just a special case of an NFA.
I promised that this page would be about the Reader and State monads but haven't said anything about them yet. I wanted to illustrate the solution of the problem without using them, and then show how the solution was transformed by their use.
To show the use of the Reader monad, observe that AcceptFAStates argument of acceptN and acceptD is not modified as it is passed along through the recursive calls. (In fact it is only even used in the invocation that ends the recursion, suggesting that a better design would be to move its use outside of the acceptD or acceptN functions entirely. However, this is also a nice, simple example, of using Reader (actually ReaderT), so we'll go ahead with it. Why ReaderT instead of Reader -- well we actually want to continue being able to treat the Maybe values monadically, and by transforming Maybe with ReaderT we get that capability.
(Maybe I should do a version with Reader to see how that goes?)
The plan is to write versions of acceptDFA, acceptNFA, acceptD, and acceptN that use the Reader pattern. I'll put an R at the end of each function name to indicate this. Notice that the type of acceptDFAR is the same as that of acceptDFA, but the type of acceptDR is different (so the implementation of acceptDFAR will also be different).
import Monad.Control.Trans.Reader
acceptDFAR :: FA -> String -> Bool
acceptDR :: Maybe FAState -> String -> ReaderT AcceptFAStates Maybe FAStateThe AcceptFAStates argument of acceptD is gone; instead the result type of of acceptDR has the type (Reader AcceptFAStates) Maybe FAState type. Note that the first set of parens in this type are unnecessary but I include them to emphasize that the monad here is (Reader AcceptFAStates). Going back to the newtype definition of Reader monads, we are reminded that this result type is really Reader { runReader :: AcceptFAStates -> Maybe FAState }, so the function contained in the result of a call to acceptDR must be extracted with runReaderT and applied to a value of type AcceptFAStates in order to get the final answer.
acceptDFAR dfa = case runReaderT (acceptDR (return (start dfa)) str) $ accept dfa of
Nothing -> False
_ -> Trueimport Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
acceptDFAR :: FA -> String -> Bool
acceptDFAR dfa str = case runReaderT (acceptDR (return (start dfa)) str) $ accept dfa of
Nothing -> False
_ -> True
acceptDR :: Maybe FAState -> String -> (ReaderT AcceptFAStates) Maybe FAState
acceptDR st "" = do
s <- lift st -- s :: FAstate; if st is Nothing overall value of the do is Nothing
-- we're operating "in the ReaderT AcceptFAStates Maybe FAState monad"
-- but st is a Maybe value; lift, from Control.Monad.Trans.Class,
-- converts the Maybe value to the ReaderT value.
accept <- ask -- now the accept states are acquired from the Reader monad instead of an argument
guard $ s `elem` accept -- guard, from Monad.Control, forces the monadic do expression to the unit value, Nothing
-- if it's argument, s `elem` accept, is False
return s -- but if the guard succeeds, the result state can be returned to the ReaderT monad.
acceptDR st (c:cs) = do
s <- lift st -- again if st is Nothing, the overall value of the do is Nothing
acceptDR (nextStateD s c) cs -- otherwise recursively process the remainder of the input after computing the next state
Things are not much different for the NFA case, except now the underlying Monad passed to ReaderT is [].
acceptNFAR :: FA -> String -> Bool
acceptNFAR nfa str = case (runReaderT $ acceptNR (return (start nfa)) str) (accept nfa) of
[] -> False
_ -> True
acceptNR :: [FAState] -> String -> (ReaderT AcceptFAStates) [] FAState
acceptNR sts "" = do
st <- lift sts
accept <- ask
guard (st `elem` accept)
return st
acceptNR sts (c:cs) = do
s <- lift sts
acceptNR (nextStateN s c) cs
print $ show $ map (acceptDFAR dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFAR dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFAR nfa1) ["", "0", "1", "00", "10", "01", "11"]
Unlike Reader, State gives us the ability to change the value that is being carried through the monadic computation at each step along the way. (Recall that Reader gave us a single value that was passed along from step to step.) The natural thing to ask is whether we can use this instead of the first argument of the accept* functions we've been writing. In this section we'll see that it is possible, but will probably not be convinced that it is desirable!
Again we'll use the Transformer version, since we want to add the State behavior to the Reader behavior. Interestingly, we'll stop using ReaderT because it turns out that the State that we modify along the way is also the desired result of the computation: we no longer need a separate return type.
Following the previous convention, we'll add an S to the end of each function name to indicate that we're now using State as well as Reader monads. The implementation of acceptDFARS is kind of interesting. Note how (runStateT $ acceptDRS str ) gives a function that is applied to (return (start dfa)) -- the initial state. runReader applied to that result gives a function that is applied to the list of accept states to give an answer consisting of a pair, in which the second element represents the final accept state (or Nothing).
acceptDFARS :: FA -> String -> Bool
acceptDFARS dfa str = case snd $ runReader ((runStateT $ acceptDRS str ) (return (start dfa))) (accept dfa) of
Nothing -> False
_ -> Trueimport Control.Monad.Trans.State
import Control.Monad.Reader.Class as CMRC
acceptDFARS :: FA -> String -> Bool
acceptDFARS dfa str = case snd $ runReader ((runStateT $ acceptDRS str ) (return (start dfa))) (accept dfa) of
Nothing -> False
_ -> True
acceptDRS :: String -> (StateT (Maybe FAState)) (Reader AcceptFAStates) ()
acceptDRS "" = do
ms <- get -- ms :: Maybe FAState. We need to get the state inside, hence the nested do below
accept <- CMRC.ask
let ns = do
s <- ms
guard $ s `elem` accept
return s -- note the return here of s :: FAState to the Maybe monad
put ns -- the new state, ns :: MaybeFAState
return () -- the result value is uninteresting -- everything is in the State
acceptDRS (c:cs) = do
ms <- get
let ns = do
s <- ms
nextStateD s c
put ns
acceptDRS cs
In comparing the above code with the previous version, we again see the disappearance of an argument to acceptDRS: the state is now carried in the monadic value that is the result of the function. That's a little mind warping, I think. The bodies of acceptDRS are a little less nice, with an extra, nested, do in each. Why? Because the value obtained with <- from the State is itself a Maybe FAState. The <- operation at the analogous position above extracted an FAState from a Maybe FAState.
acceptNFARS :: FA -> String -> Bool
acceptNFARS nfa str = case snd $ runReader ((runStateT $ acceptNRS str) (return (start nfa))) (accept nfa) of
[] -> False
_ -> True
acceptNRS :: String -> (StateT [FAState]) (Reader AcceptFAStates) ()
acceptNRS "" = do
sts <- get
accept <- CMRC.ask
let ns = do
s <- sts
guard (s `elem` accept)
return s
put ns
acceptNRS (c:cs) = do
sts <- get
let ns = do
s <- sts
(nextStateN s c)
put ns
acceptNRS cs
The code above for NFAs using State and Reader should contain no surprises at this point!
print $ show $ map (acceptDFARS dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFARS dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFARS nfa1) ["", "0", "1", "00", "10", "01", "11"]
In my opinion this State - based version is not an improvement on the earlier designs, but it does show how State works and emphasizes the idea that Reader and State both replace the need to pass an argument down through multiple levels of calls with computing a value (function) that can be applied to an initial environment or state, propagating those values implicitly through the computation.
As hinted at above, passing the accept states list into the recursive accept functions is probably not ideal. How about letting the recursive functions just compute the final state(s) and let the function that calls them determine whether it is an accepting state or not. We'll use foldl' (from Data.List) because there is no call for laziness! And to name the functions, we'll append an F to the original names.
Note we can still take advantage of the Monadic nature of both Maybe and [] inside the step functions. This is the version that I like best.
import Data.List (foldl')
acceptDFAF :: FA -> String -> Bool
acceptDFAF dfa str = acceptState finalState
where finalState = foldl' acceptDStep (Just $ start dfa) str
acceptState Nothing = False
acceptState (Just s) = s `elem` (accept dfa)
acceptDStep :: Maybe FAState -> Char -> Maybe FAState
acceptDStep st c = do
s <- st -- s :: FAstate; if st is Nothing overall value of the do is Nothing
nextStateD s c
And for NFAs
acceptNFAF :: FA -> String -> Bool
acceptNFAF nfa str = acceptStates /= []
where finalStates = foldl' acceptNStep [start nfa] str
acceptStates = do
st <- finalStates
guard $ st `elem` (accept nfa)
return st
acceptNStep :: [FAState] -> Char -> [FAState]
acceptNStep st c = do
s <- st -- s :: FAstate; if st is [] overall value of the do is []
nextStateN s c
print $ show $ map (acceptDFAF dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFAF dfa1) ["", "0", "1", "00", "10", "01", "11"]
print $ show $ map (acceptNFAF nfa1) ["", "0", "1", "00", "10", "01", "11"]