============================================ DFA.lhs Author: Joseph Fredette This implements Deterministic Finite Automata, and associated algorithms, along with anything else I found useful. Included here: DFA as a instance of the Automata class from HFA.lhs reduceDFA, which reduces a DFA to a minimal form ============================================ > {-# OPTIONS -fglasgow-exts #-} > {-# OPTIONS -fallow-undecidable-instances #-} > module DFA.DFA (DFA(..), fromSymbols, toSymbols, > fromStates, toStates, printDFA, > printDFAtoIO, createDeltafromMap, > createAssocListfromDFA, createDeltafromAssocList, > createMapfromDFA > ) where > import HFABase > import qualified Data.Map as M > import Data.List > import Text.PrettyPrint The DFA datatype is simple, it is just a union type of an alphabet, a start state, and a set of final states > data (Ord a, Ord b) => DFA a b = > Union { states :: States a > , sigma :: Alphabet b > , delta :: State a -> Symbol b -> State a > , start :: StartState a > , final :: FinalStates a} The Record Syntax gives use the forced transition function we need. ------------------------------------------------------------------------------- > -- trace DFA will take, as input, an arbitrary DFA, a string of symbols for > -- that DFA, and return a string of States for that DFA, it will fail with > -- error if we go out of state. > traceDFA :: (Ord a, Ord b) > => (DFA a b) -> Symbols b -> (TraceOut a b) > traceDFA dfa input > | illegalSymbol_flag = IllegalSymbol (head remainingSymbols) > | illegalState_flag = IllegalState (last stateTrace) > | reject_flag = Reject input stateTrace > | accept_flag = Accept input stateTrace > where > (stateTrace,remainingSymbols) = tracer dfa input [] (start dfa) > allInputConsumed = null remainingSymbols > endOnFinalState = (last stateTrace) `elem` (final dfa) > validFinalState = (last stateTrace) `elem` (states dfa) > accept_flag = endOnFinalState && (allInputConsumed) > reject_flag = (not endOnFinalState) && (allInputConsumed) > illegalSymbol_flag = (not allInputConsumed) > illegalState_flag = (not validFinalState) && (not allInputConsumed) This little bit traces the output of a DFA, and returns a pair consisting of the symbols left in the States visited, and the symbols left in the input. In the non-error case, it should return a pair of the form (ls,[]) where ls is an arbitrary list of symbols, in the degenerate case, it should return a list of type (ls1, ls2), where both are lists. DFA's assume _no_ lambda transitions (though technically possible within a DFA, they would have to be isolated and as such the _only_ transition from the state (not hard to prove, see extraneous/HFAProofs, Proof 2) > tracer :: (Ord a, Ord b) > => (DFA a b) -> Symbols b -> States a -> State a -> (States a, Symbols b) > tracer _ [] stTrace _ = (stTrace,[]) > tracer dfa (sym:syms) stateTrace curSt > | (sym == Lambda) = (tracer dfa syms stateTrace curSt) > | not (sym `elem` (sigma dfa)) && (sym /= Lambda) = (stateTrace, (sym:syms)) > | otherwise = if (not (nextState `elem` (states dfa))) > then (stateTrace, (sym:syms)) > else nextStep > where > nextStep = tracer dfa > syms > (stateTrace ++ [nextState]) > nextState > nextState = ((delta dfa) curSt sym) ------------------------------------------------------------------------------- Now it's easy enough to create an instance of automata for DFA > instance (Ord a, Ord b) => Automata (DFA b a) a b where > trace = traceDFA > -- the rest is taken care of by the Automata class. Now we want to create some helper functions for DFA's This generates a table of the form: a b . . . z 0 x y . . . 1 z 2 . . . . . n . . It marks the State Row Markers with the following legend (x) if x is a start state [x] if x is a final state if x is a both -- Not quite up to where it was before, but it works with any size string now. > printDFA :: (Show a, Show b, Ord a, Ord b) > => (DFA a b) -> Doc > printDFA dfa = vcat $ map hsep $ stateTable > where > stateTable = zipAllTogether $ [dfaStates] ++ symbolTable > dfaStates = [buffer] ++ dfaStates' > dfaStates' = map markStates > $ map textify > $ fromStates (states dfa) > dfaSymbols = map textify' > $ fromSymbols (sigma dfa) > createSymbolColumns sym = fromStates [ ((delta dfa) st sym) > | st <- (states dfa)] > symbolTable :: [[Doc]] > symbolTable = zipAllTogether ([dfaSymbols] ++ (transpose symbolTable')) > symbolTable' :: [[Doc]] > symbolTable' = [ map textify' $ createSymbolColumns syms > | syms <- (sigma dfa)] > textify :: Show a => a -> Doc > textify = (text . adjustshow longestState) > textify' :: Show a => a -> Doc > textify' = (text . adjustshow longestSymbol) > markStates :: Doc -> Doc > markStates x > | isStart && isFinal = (angles x) > | isStart = (parens x) > | isFinal = (brackets x) > | otherwise = (spaces x) > where > isStart = (render x) == (adjust (fromState (start dfa))) > isFinal = (render x) `elem` (map adjust > (fromStates (final dfa))) > wrap c c' x = c <> x <> c' > angles = (wrap (char '<') (char '>')) > spaces = (wrap space space) > fromState x = head $ fromStates [x] > adjust = (adjustshow longestState) > longestSymbol = maximum > $ map (length . squishandfilter) > $ fromSymbols (sigma dfa) > longestState = maximum > $ map (length . squishandfilter) > $ fromStates (states dfa) > extraBuffer = 2 > buffer = hcat > $ take (longestState + extraBuffer) > $ repeat space > -- makes show x at least a fixed length, centering as we go > adjustshow len x > | (length shown) >= len = squishandfilter x > | (length shown) <= (len - 2) = " " ++ (adjustshow (len-2) x) ++ " " > | (length shown) < len = (adjustshow (len-1) x) ++ " " > where shown = show x > squishandfilter :: (Show a) => a -> String > squishandfilter x = if ((head "'") `elem` (show x)) > then squish (show x) > else (show x) > squish = (tail . reverse . tail . reverse) Interesting Bit, this is really just Matrix Transposition, so zipAllTogether are their own inverses. > zipAllTogether :: [[a]] -> [[a]] > zipAllTogether [] = [] > zipAllTogether xs > | any null xs = [] > | otherwise = (map head xs) > : (zipAllTogether $ map tail xs) > transpose = zipAllTogether This just dumps the printed DFA to IO > printDFAtoIO :: (Show a, Show b, Ord a, Ord b) > => (DFA a b) -> IO () > printDFAtoIO = (putStrLn . render . printDFA) This takes a (Map ((State a), (Symbol b)) State a) and returns a transition functions of type: State a -> Symbol b -> State a > createDeltafromMap :: (Ord a, Ord b) > => (M.Map (State a, Symbol b) (State a)) -> (State a -> Symbol b -> State a) > createDeltafromMap mp = mkTrans > where > mkTrans st sym = mp M.! (st, sym) This takes an Assoc list of the form [((State a, Symbol b), State a)] and creates a delta from it > createDeltafromAssocList :: (Ord a, Ord b) > => [(((State a), (Symbol b)), State a)] -> (State a -> Symbol b -> State a) > createDeltafromAssocList ls = createDeltafromMap > $ M.fromList ls This takes a DFA and returns a State/Symbol map, eg a Map representation of the transition table. > createMapfromDFA :: (Ord a, Ord b) > => (DFA a b) -> (M.Map ((State a), (Symbol b)) (State a)) > createMapfromDFA dfa = M.fromList > $ [((fromSt, inputSym), ((delta dfa) fromSt inputSym)) > | fromSt <- (states dfa) > , inputSym <- (sigma dfa) ] This creates a Association list of States X Inputs -> States from a DFA > createAssocListfromDFA :: (Ord a, Ord b) > => (DFA a b) -> [(((State a), (Symbol b)), State a)] > createAssocListfromDFA dfa = M.assocs > $ (createMapfromDFA dfa) ======== This is a minimizer, which uses the partitioning method, which is described by the following: 1 ) Divide the set of states into final and nonfinal sets in each set find all states which go to states contained in the same partition. 2 ) Place all these sets into there own partitions (per partition, so states meeting the condition in the final-state set go into one set, and the states in the nonfinal goes into another set) 3 ) repeat step 2 until there are no states in any partition meeting the condition 4 ) now turn each partition into a state, those paritions that were subpartitions of the final-state partition are now final states Heres the plan, first, partition into final and nonfinal states, now for each, generate a list of 5-tuples of the form (aSt, [onSym1], [yieldStA], isStart, isFinal) now we find those elements of the list with the same tuple-signature, eg we do a groupBy (\(_,_,x),(_,_,y) -> x == y), and replace all occurences of aSt in each resultant list with "newStX" where x is some kind of marker. After this, delete the grouped state and replace with: (aSt, [onSym1], [yieldStA], isStart, isFinal) repeat until the only groups are singletons next we'll need to reconstruct a delta function from this list of 5-tuples, luckily, we can easily map it into an assoc list. by simply doing: \(aSt, syms, yields, _ , _) -> [((aSt, syms'),yields') | syms' <- syms, yields' <- yields] we then have a list of form [((state, symbol),state)], which we can use to create a delta. Finally, we need to grab which states are final/nonfinal and which states are initial, this is where isStart and isFinal come in, we now just filter out and take the first element of all those 5-tuples with either flag set. head $ map fst $ filter (\(_,_,_,P,_) -> P) and map fst $ filter (\(_,_,_,_,Q) -> Q) should create the start state and the list of final states, resp. we now can reconstruct our DFA relatively easily all thats left is to get the list of States from it: map fst will do dfaMinimize :: (Show a, Show b, Ord a, Ord b) => (DFA a b) -> (DFA a b) dfaMinimize dfa = > > createParitionList ::(Show a, Show b, Ord a, Ord b) > => (DFA a b) -> [((State a), (Symbols b), (States a), Bool, Bool)] > createParitionList (Union states symbols delta start finals) = >