Created
May 8, 2012 12:13
-
-
Save jason2506/2634508 to your computer and use it in GitHub Desktop.
[Haskell Practice] finite automata
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module DFA | |
( DFA (..) | |
, trans | |
, run | |
, accept | |
) where | |
import qualified Data.Map as Map | |
import qualified Data.Set as Set | |
import Data.Maybe | |
import Control.Monad | |
type Delta s a = Map.Map (s, a) s | |
data DFA s a = DFA | |
{ states :: Set.Set s | |
, sigma :: Set.Set a | |
, delta :: Delta s a | |
, startState :: s | |
, acceptStates :: Set.Set s | |
} deriving (Show) | |
trans :: (Ord s, Ord a) => s -> a -> DFA s a -> Maybe s | |
trans state alpha dfa = Map.lookup (state, alpha) $ delta dfa | |
run :: (Ord s, Ord a) => [a] -> DFA s a -> Maybe s | |
run input dfa = (foldM trans' $ startState dfa) input | |
where trans' state alpha = trans state alpha dfa | |
accept :: (Ord s, Ord a) => [a] -> DFA s a -> Bool | |
accept input dfa = | |
if isNothing $ final | |
then False | |
else Set.member (fromJust final) (acceptStates dfa) | |
where final = run input dfa |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import qualified Data.Map as Map | |
import qualified Data.Set as Set | |
import Test.HUnit | |
import qualified DFA | |
import qualified NFA | |
dfa = DFA.DFA | |
{ DFA.states = Set.fromList ['x', 'y'] | |
, DFA.sigma = Set.fromList [0, 1] | |
, DFA.delta = Map.fromList | |
[ (('x', 0), 'x') | |
, (('y', 0), 'y') | |
, (('x', 1), 'y') | |
, (('y', 1), 'x') ] | |
, DFA.startState = 'x' | |
, DFA.acceptStates = Set.fromList ['y'] } | |
nfa = NFA.NFA | |
{ NFA.states = Set.fromList [1, 2, 3] | |
, NFA.sigma = Set.fromList ['a', 'b'] | |
, NFA.delta = Map.fromList | |
[ ((1, Just 'b'), Set.fromList [2]) | |
, ((1, Nothing), Set.fromList [3]) | |
, ((2, Just 'a'), Set.fromList [2, 3]) | |
, ((2, Just 'b'), Set.fromList [3]) | |
, ((3, Just 'a'), Set.fromList [1]) ] | |
, NFA.startState = 1 | |
, NFA.acceptStates = Set.fromList [1] } | |
nfa' = NFA.toDFA nfa | |
dfaTestCase = TestCase (do | |
assertEqual "[]" (DFA.accept [] dfa) False | |
assertEqual "[1]" (DFA.accept [1] dfa) True | |
assertEqual "[0]" (DFA.accept [0] dfa) False | |
assertEqual "[0, 1, 1, 0, 1, 1]" | |
(DFA.accept [0, 1, 1, 0, 1, 1] dfa) False | |
assertEqual "[0, 1, 1, 0, 1, 1, 1]" | |
(DFA.accept [0, 1, 1, 0, 1, 1, 1] dfa) True | |
assertEqual "[0, 1, 1, 0, 1, 1, 1, 0]" | |
(DFA.accept [0, 1, 1, 0, 1, 1, 1, 0] dfa) True) | |
nfaTestCase = TestCase (do | |
assertEqual "[]" (NFA.accept [] nfa) True | |
assertEqual "['a']" (NFA.accept ['a'] nfa) True | |
assertEqual "['b']" (NFA.accept ['b'] nfa) False | |
assertEqual "['b', 'a', 'b']" | |
(NFA.accept ['b', 'a', 'b'] nfa) False | |
assertEqual "['b', 'a', 'b', 'a']" | |
(NFA.accept ['b', 'a', 'b', 'a'] nfa) True | |
assertEqual "['b', 'a', 'b', 'a', 'a']" | |
(NFA.accept ['b', 'a', 'b', 'a', 'a'] nfa) True) | |
convertTestCase = TestCase (do | |
assertEqual "[]" (DFA.accept [] nfa') True | |
assertEqual "['a']" (DFA.accept ['a'] nfa') True | |
assertEqual "['b']" (DFA.accept ['b'] nfa') False | |
assertEqual "['b', 'a', 'b']" | |
(DFA.accept ['b', 'a', 'b'] nfa') False | |
assertEqual "['b', 'a', 'b', 'a']" | |
(DFA.accept ['b', 'a', 'b', 'a'] nfa') True | |
assertEqual "['b', 'a', 'b', 'a', 'a']" | |
(DFA.accept ['b', 'a', 'b', 'a', 'a'] nfa') True) | |
main = runTestTT $ TestList [dfaTestCase, nfaTestCase, convertTestCase] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module NFA | |
( NFA (..) | |
, trans | |
, run | |
, accept | |
, toDFA | |
) where | |
import qualified Data.Map as Map | |
import qualified Data.Set as Set | |
import Data.Maybe (isNothing, fromJust) | |
import qualified DFA | |
type Delta s a = Map.Map (s, Maybe a) (Set.Set s) | |
data NFA s a = NFA | |
{ states :: Set.Set s | |
, sigma :: Set.Set a | |
, delta :: Delta s a | |
, startState :: s | |
, acceptStates :: Set.Set s | |
} deriving Show | |
move :: (Ord s, Ord a) => s -> Maybe a -> NFA s a -> Set.Set s | |
move state alpha nfa = | |
if isNothing result | |
then Set.empty | |
else fromJust result | |
where result = Map.lookup (state, alpha) $ delta nfa | |
moveWithAlpha :: (Ord s, Ord a) => s -> a -> NFA s a -> Set.Set s | |
moveWithAlpha state alpha = move state (Just alpha) | |
moveWithNothing :: (Ord s, Ord a) => s -> NFA s a -> Set.Set s | |
moveWithNothing state = move state Nothing | |
epsilonClosure :: (Ord s, Ord a) => Set.Set s -> NFA s a -> Set.Set s | |
epsilonClosure states nfa = Set.fold appendStates states states | |
where appendStates = \s acc -> Set.union acc $ moveWithNothing s nfa | |
trans :: (Ord s, Ord a) => Set.Set s -> a -> NFA s a -> Set.Set s | |
trans states alpha nfa = Set.fold appendStates Set.empty states | |
where appendStates = \s acc -> Set.union acc $ move s | |
move s = epsilonClosure (moveWithAlpha s alpha nfa) nfa | |
run :: (Ord s, Ord a) => [a] -> NFA s a -> Set.Set s | |
run input nfa = foldl trans' startStates input | |
where trans' states alpha = trans states alpha nfa | |
startStates = epsilonClosure (Set.singleton $ startState nfa) nfa | |
accept :: (Ord s, Ord a) => [a] -> NFA s a -> Bool | |
accept input nfa = not $ Set.null $ Set.intersection final $ acceptStates nfa | |
where final = run input nfa | |
powerset :: (Ord s) => Set.Set s -> Set.Set (Set.Set s) | |
powerset set = Set.fold union emptySet set | |
where union = \s acc -> Set.union acc $ Set.map (Set.insert s) acc | |
emptySet = Set.singleton Set.empty | |
toDFA :: (Ord s, Ord a) => NFA s a -> DFA.DFA (Set.Set s) a | |
toDFA nfa = DFA.DFA | |
{ DFA.states = states' | |
, DFA.sigma = sigma' | |
, DFA.delta = delta' | |
, DFA.startState = starts | |
, DFA.acceptStates = Set.filter isAccept states' } | |
where states' = powerset $ states nfa | |
sigma' = sigma nfa | |
delta' = Map.fromList $ foldl run' [] stateList | |
where run' = \acc s -> foldl (\acc' a -> trans' s a : acc') acc sigmaList | |
trans' = \state alpha -> ((state, alpha), trans state alpha nfa) | |
sigmaList = Set.toList sigma' | |
stateList = Set.toList states' | |
starts = epsilonClosure (Set.singleton $ startState nfa) nfa | |
isAccept = not . Set.null . Set.intersection (acceptStates nfa) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment