Represent Nondeterministic Finite State Machine Simulator in Haskell

Question

I am following "programming languages" on Udacity and trying to represent the problem sets in Haskell. The answers are written in Python:

edges = {(1,"a") : [2,3]
        ,(2,"a") : [2]
        ,(3,"b") : [3,4]
        ,(4,"c") : [5]}

accepting = [2,5]

def nfsmSim(string, current, edges, accepting):
    if string == "":
        return current in accepting
    else:
        letter = string[0]
        key = (current, letter)
        if key in edges:
            rest = string[1:]
            states = edges[key]
            for state in states:
                if nfsmSim(rest, state, edges, accepting):
                    return True
         return False

The starting state is always the first state i.e. current = 1.

Strings such as "aaa" or "abc" are accepted whilst "abb" or "aabc" or rejected.

My attempt at rewriting using Haskell:

nfsmSim [] c _  = [c]
nfsmSim xs c es = [concat $ nfsmSim (tail xs) s es | (k,ss) <- es, s <- ss, x <- xs, k==(c,x)]

I want to return a list of integers which represent the last state at the end of the input string and then filter these against the accepting states and use any to get a final True or False.

I realise this is not probably the Haskell way to do this and that there is probably a better wholemeal solution. However as a beginner I am struggling with mondadic mechanism and most likely the recursive nature of this problem.

Please point me in the right direction possibly using the do notation rather than the list comprehension.

Answer 1

Let us think about the type first. Your Python function has the following type, more or less:

type State   = Int
type Map k v = [(k,v)]

nfsmSim :: String -> State -> Map (Int, Char) [State] -> [State] -> Bool
nfsmSim string current edges accepting = …

We can use pattern matching for the empty string case:

nfsmSim :: String -> State -> Map (Int, Char) [State] -> [State] -> Bool
nfsmSim "" current _ accepting = current `elem` accepting

For the non-empty case, we do the same as your Python code:

nfsmSim (x:xs) current edges accepting =
    let rest   = xs
        states = [s | (k,v) <- edges, k == (current,x), s <- v]
    in or [nfsmSim rest state edges accepting | state <- states]

However, that's not really easy to work with. Instead, let us write nfsmSim as higher order function and change the order of arguments:

nfsmSim :: (State -> Char -> [State])
        -> (State -> Bool)
        -> String
        -> State
        -> Bool

Now, instead of a list of edges, we have to provide a function that returns a (possible empty) list of states for a given state and character, and instead of a list of accepting states, we provide a function that returns True on those states.

For the empty string case, not too much changes:

nfsmSim advance accept "" current = accept current

We simply use our State -> Bool to check whether our current state is acceptable.

However, now that our State is the last parameter of nfsmSim, we can use currying to use your any approach:

nfsmSim advance accept (x:xs) current = 
    any (nfsmSim advance accept xs) (advance current x)

Note that it's kind of clunky to carry all arguments along. You would usually write a worker for that:

nfsmSim :: (a -> b -> [a]) -> (a -> Bool) -> [b] -> a -> Bool
nfsmSim advance accept string current = go string current
  where
    go []     c = accept c
    go (x:xs) c = any (go xs) (advance c x)

By the way, you can still use "edges" and "accepting" with the last variant,

nfsmSimAccept string current edges accepting =
   let accept  c   = c `elem` accepting
       advance c x = [s | (k,v) <- edges, k == (c,x), s <- v]
   in nfsmSim advance accept string current

which shows that the higher order function is more flexible.

Answer 2

First of all, as I know, no such thing as "Non Finite State Machine". Judging from what you wrote, I realized that it is about "Nondeterministic finite automaton (NFA)".

First variant.

nfa :: String -> Int -> [((Int, Char), [Int])] -> [Int] -> Bool
nfa       [] cur     _ acc = cur `elem` acc
nfa (c:rest) cur edges acc
    | Just states <- lookup (cur, c) edges = any (\state -> nfa rest state edges acc) states
    | otherwise                            = False

edges =
    [ ((1, 'a'), [2, 3])
    , ((2, 'a'), [2])
    , ((3, 'b'), [3, 4])
    , ((4, 'c'), [5])
    ]

accepting = [2, 5]

main = do
    print $ nfa "aaa" 1 edges accepting
    print $ nfa "abc" 1 edges accepting
    print $ nfa "abb" 1 edges accepting
    print $ nfa "aabc" 1 edges accepting

Output will be:

True
True
False
False

Second variant:

import Control.Monad
import Data.Maybe

nfa2 :: String -> Int -> [((Int, Char), [Int])] -> [Int] -> [Int]
nfa2       [] cur     _ acc = guard (cur `elem` acc) >> return cur
nfa2 (c:rest) cur edges acc = do
    state <- fromMaybe mzero $ lookup (cur, c) edges
    nfa2 rest state edges acc

edges =
    [ ((1, 'a'), [2, 3])
    , ((2, 'a'), [2])
    , ((3, 'b'), [3, 4])
    , ((4, 'c'), [5])
    ]

accepting = [2, 5]

main = do
    print $ nfa2 "aaa" 1 edges accepting
    print $ nfa2 "abc" 1 edges accepting
    print $ nfa2 "abb" 1 edges accepting
    print $ nfa2 "aabc" 1 edges accepting

Output will be:

[2]
[5]
[]
[]

Answer 3

Here's my Haskell-ish method:

We can use haskell's Data.Set and Data.Map libraries to represent our state machine.

import qualified Data.Map as M
import qualified Data.Set as S

Let's define some datatypes for our state machine:

type State = Int
type Edge = (State, Char)
type Machine = (M.Map Edge (S.Set State), S.Set State)

We define the machine thusly:

myMachine :: Machine
myMachine = (M.fromList
    [ ((1, 'a'), S.fromList [2, 3])
    , ((2, 'a'), S.fromList [2   ])
    , ((3, 'b'), S.fromList [3, 4])
    , ((4, 'c'), S.fromList [5   ])
    ] , S.fromList [2, 5])

we can run the machine like this:

runMachine :: String -> Machine -> State -> Bool
runMachine "" (_, acceptingStates) currentState =
    S.member currentState acceptingStates
runMachine (ch:rest) machine@(edges, _) currentState =
    case M.lookup (currentState, ch) edges of
        Nothing -> False
        Just nextStates ->
            or $ S.map (runMachine rest machine) nextStates

Since the function returns a Bool, there is no great reason to use a monad or do-notation. However such a solution is possible if we use the type Maybe () in place of Bool, where Just () represents True and Nothing represents False.