DFA and NFA in Haskell

I've written a determinstic & non-deterministic finite state machine. I've scrubbed the code quite a bit but I wonder if it could perhaps be scrubbed even more.

Suggestions for code clarity, formatting, API design and test suites (I can't think of any for my NFA) would be welcome.

Also, can the code be modified to support sets without obscuring code clarity? That way would prevent needless iteration of duplicate states.

dfa.hs:

module DFA (DFA(..), evalDFA) where

import Data.Maybe (Maybe(..))

data DFA s i = DFA {
    startState :: s,
    delta :: s -> i -> Maybe s,
    isFinal :: s -> Bool
}

evalDFA (DFA startState delta isFinal) xs =
    case endState of
        Nothing -> False
        Just s -> isFinal s
    where
        endState = foldl (\ m i -> m >>= (\ s -> delta s i)) (Just startState) xs

dfa_test.hs:

```
import Data.Maybe (Maybe(..))

import Test.QuickCheck (quickCheck, quickCheckWith)

import DFA (DFA(..), evalDFA)

alwaysPass :: DFA Int ()
alwaysPass = DFA 0 moves isFinal
where
moves :: Int -> () -> Maybe Int
moves 0 () = Just 0
moves _ _ = Nothing
isFinal :: Int -> Bool
isFinal _ = True

test_alwaysPass :: IO ()
test_alwaysPass = quickCheck (\ xs -> evalDFA alwaysPass xs)

alwaysFail :: DFA Int ()
alwaysFail = DFA 0 moves isFinal
where
moves :: Int -> () -> Maybe Int
moves 0 () = Just 0
moves _ _ = Nothing
isFinal :: Int -> Bool
isFinal _ = False

test_alwaysFail :: IO ()
test_alwaysFail = quickCheck (\ xs -> not $ evalDFA alwaysFail xs)

onlyTrue :: DFA Int Bool
onlyTrue = DFA 1 moves isFinal
where
moves :: Int -> Bool -> Maybe Int
moves 0 False = Just 0
moves 0 True = Just 0
moves 1 False = Just 0
moves 1 True = Just 1
moves _ _ = Nothing
isFinal :: Int -> Bool
isFinal 1 = True
isFinal _ = False

test_onlyTrue :: IO ()
test_onlyTrue =
quickCheck (\ xs -> isAccept xs $ evalDFA onlyTrue

One thing that could be changed is making the DFA delta function fully defined:

delta :: s -> i -> s

because delta should be defined over the entire alphabet for any state.

If you wanted to use a state with a Maybe, you could just extract the Nothing portion into the isFinal function.

It would also simplify evalDFA to

evalDFA (DFA startState delta isFinal) xs = isFinal $ foldl delta startState xs

The Set representation for an NFA could be

data NFA s i = NFA {
    startState :: s,
    delta :: s -> i -> S.Set s,
    epsilon :: s -> S.Set s,
    isFinal :: s -> Bool
}

I wasn't trying to get a lot of speed out of this but this is an implementation with set might be

step :: Ord s => NFA s i -> s -> i -> S.Set s
step nfa@(NFA _ deltaF epsilonF _) s i = foldl applyInsert S.empty newStates
    where newStates = epsilonMoves nfa s
          applyInsert states state = S.union states $ deltaF state i

Here we find all of the epsilon moves for the nfa state and then we fold across
the new states and apply the delta function to each state and add the results together

The epsilonMoves function

epsilonMoves :: Ord s => NFA s i -> s -> S.Set s
epsilonMoves (NFA _ _ epsilonF _) s = epsilonMoves' $ S.singleton s
    where epsilonMoves' lastStates = if S.null newStates 
                                        then lastStates 
                                        else S.union lastStates $ epsilonMoves'  newStates 
            where newStates = foldl (\states' state -> S.union states' $ epsilonF state) S.empty lastStates

This just finds the next moves from the given state and then finds the moves of all of the given states children. If there are new states found after new states have been found, then nothing else is calculated.

A move to calculate the epsilon moves for a Set could then be

epsilonMovesSet :: Ord s => NFA s i -> S.Set s -> S.Set s 
epsilonMovesSet nfa states = foldl (\xs s -> S.union xs $ epsilonMoves nfa s) S.empty states

To step across multiple states you just fold across the given states and accumulate the results given by step on i

stepStates :: Ord s => NFA s i -> S.Set s -> i -> S.Set s
stepStates nfa states i = foldl (\states' state -> S.union states' $ step nfa state i) S.empty states

A function to step through multiple states on multiple inputs could be

multipleSteps :: (Foldable f, Ord s) => NFA s i -> f i -> S.Set s
multipleSteps nfa@(NFA aState _ _ _) xs = foldl (stepStates nfa) (S.singleton aState) xs

Here you have to only use the states from stepStates to go back into stepStates because they're intermediary steps.

To evaluate the nfa

evalNFA :: Ord s => NFA s i -> [i] -> Bool
evalNFA nfa@(NFA sState _ _ isFinalF) xs = any isFinalF endStates
    where
        endStates = epsilonMovesSet nfa $ multipleSteps nfa xs

Here you step through the given nfa with multipleSteps and then calculate all of the possible epsilon moves from the final result.

I don't think the implementation is incredibly fast but it should work.

Some NFA tests could be some regular expression tests. If you don't know how to make an NFA from a regular expression you could use something to generate it for you but a simple case is a*(b|c).

The not-so-correct implementation for this with the NFA above would be:

testNFA :: NFA Int Char
testNFA = NFA 0 deltaF epsilonF isFinalF
    where
        startState = 0 :: Int
        deltaF 1 'a' = S.fromList [2]
        deltaF 4 'b' = S.fromList [5]
        deltaF 6 'd' = S.fromList [7]
        deltaF n _ = S.singleton n
        epsilonF 0 = S.fromList [1,3]
        epsilonF 2 = S.fromList [1,3]
        epsilonF 3 = S.fromList [4,6]
        epsilonF 5 = S.fromList [8]
        epsilonF 7 = S.fromList [8]
        epsilonF _ = S.empty
        isFinalF 8 = True
        isFinalF _ = False

and some text cases could be:

evalNFA testNFA "aaaaab" == True
evalNFA testNFA "ab" == True
evalNFA testNFA "b" == False
evalNFA testNFA "ad" == True
evalNFA testNFA "aaaaaad" == True
evalNFA testNFA "d" == False
evalNFA testNFA "" == False

StackExchange Code Review Q#69396, answer score: 10