[Moved to Haskell-Cafe] Hello! Cycles sure make it difficult to transform graphs in a pure non-strict language. Cycles in a source graph require us to devise a way to mark traversed nodes -- however we cannot mutate nodes and cannot even compare nodes with a generic ('derived') equality operator. Cycles in a destination graph require us to keep track of the already built nodes so we can complete a cycle. An obvious solution is to use a state monad and IORefs. There is also a monad-less solution, which is less obvious: we can't add a node to the dictionary of constructed nodes until we have built the node, then means we can't use the updated dictionary when building descendants -- which need the dictionary when linking back. The problem can be overcome however with a credit card transform (a.k.a. "buy now, pay later" transform). To avoid hitting the bottom, we just have to "pay" by the "due date". The will use as an example the NFA->DFA transformation considered earlier. Perhaps we should first attempt a few obvious optimizations of a NFA/DFA recognizer. It seems that performance matters. finAuAcceptStringQ startStates string = or [faStateAcceptStringQ s string | s <- startStates] where faStateAcceptStringQ (FaState _ acceptQ _) [] = acceptQ faStateAcceptStringQ (FaState _ _ trans) (a:as) | null followerStates = False | otherwise = or [ faStateAcceptStringQ s as | s <- followerStates ] where followerStates = if a > (length trans) - 1 then [] else trans!!a Computing (length trans) when determining the followerStates is inefficient: even if 'a' is zero, we still have to traverse the whole list 'trans'. If our alphabet is binary, perhaps its better to specialize the FaState correspondingly and write: -- Automata over a binary alphabet data (Ord l,Show l) => FaState l = FaState {label :: l, acceptQ :: Bool, trans0:: [FaState l], trans1:: [FaState l]} -- Then a finite automaton is merely a list of starting FaStates: type FinAu l = [FaState l] --So, for example, an automaton equivalent to the regular expression --0*(0(0+1)*)* could be defined as: dom18 = [one] where one = FaState 1 True [one,two] [] two = FaState 2 True [two,one] [one,two] The acceptance function can be written as finAuAcceptStringQ start_states str = foldr (\l seed -> acceptP l str || seed) False start_states where acceptP (FaState _ acceptQ _ _) [] = acceptQ acceptP (FaState _ _ t0 t1) (s:rest) = finAuAcceptStringQ (if s then t1 else t0) rest We have simplified the original expression, and manually deforested it. test1= finAuAcceptStringQ dom18 $ map (>0) [0,1,0,1] test2= finAuAcceptStringQ dom18 $ map (>0) [1,1,0,1] test3= finAuAcceptStringQ dom18 [True] test4= finAuAcceptStringQ dom18 [False] It would be great to be able to compare and print the nodes: instance (Ord l,Show l) => Eq (FaState l) where (FaState l1 _ _ _) == (FaState l2 _ _ _) = l1 == l2 but printing a node is already a slight problem. We need to keep track of the already printed nodes to avoid looping. -- a data class for an occurrence check class OCC occ where empty:: occ a seenp:: (Eq a) => a -> occ a -> Bool put:: a -> occ a -> occ a -- Currently, it's just a list. -- In the future, we can pull in something fancier from the Edison instance OCC [] where empty = [] seenp = elem put = (:) -- Depth-first, pre-order traversal of the graph, keeping track of -- already printed nodes instance (Ord l,Show l) => Show (FaState l) where show state = "{@" ++ showstates [state] (empty::[FaState l]) "@}" where -- showstates worklist seen_states suffix showstates [] states_seen suffix = suffix showstates (st:rest) states_seen suffix | st `seenp` states_seen = showstates rest states_seen suffix showstates (st@(FaState l accept t0 t1):rest) states_seen suffix = showstate st $ showstates (t0++t1++rest) (st `put` states_seen) suffix showstate (FaState l accept t0 t1) suffix = "{State " ++ (show l) ++ " " ++ (show accept) ++ " " ++ (show $ map label t0) ++ " " ++ (show $ map label t1) ++ "}" ++ suffix Now, "print dom18" prints as [{@{State 1 True [1,2] []}{State 2 True [2,1] [1,2]}@}] For the NFA->DFA conversion, we need to keep track of already built states. -- A dictionary of states class StateDict sd where emptyd :: sd (l,FaState l) locate :: (Eq l) => l -> sd (l,FaState l) -> Maybe (FaState l) putd :: (l,FaState l) -> sd (l,FaState l) -> sd (l,FaState l) -- if performance matters, we can use a fancier dictionary from the Edison instance StateDict [] where emptyd = [] locate = lookup putd = (:) -- [nfa_state] -> dictionary_of_seen_states -> ([dfa_state],updated_dictionary) -- [dfa_state] is a singleton list determinize_cc states converted_states = -- first, check the cache case dfa_label `locate` converted_states of Nothing -> build_state Just dfa_state -> ([dfa_state],converted_states) where -- [NFA_labels] -> DFA_labels det_labels = sort . nub . (map label) dfa_label = det_labels states -- find out NFA-followers for [nfa_state] upon ingestion of 0 and 1 (t0_followers,t1_followers) = foldr (\st (f0,f1) -> (trans0 st ++ f0, trans1 st ++ f1)) ([],[]) states acceptQ' = or (map acceptQ states) -- really build the dfa state and return ([dfa_state],updated_cache) build_state = let -- node, dfa_state is computed _below_ converted_states1 = (dfa_label,dfa_state) `putd` converted_states (t0', converted_states2) = (determinize_cc t0_followers converted_states1) (t1', converted_states3) = (determinize_cc t1_followers converted_states2) dfa_state = (FaState dfa_label acceptQ' t0' t1') in ([dfa_state],converted_states3) finAuDeterminize states = fst $ determinize_cc states [] At the heart of the credit card transform is the phrase converted_states1 = (dfa_label,dfa_state) `putd` converted_states we added to the dictionary of the computed states the state that we haven't built yet. Because (,) is non-strict in its arguments and `locate` is non-strict in its result, we can get away with a mere promise to "pay". We can print the DFA for dom18 to see what we've got: finAuDeterminize dom18 -- shows [{@{State [1] True [[1,2]] [[]] } {State [1,2] True [[1,2]] [[1,2]]} {State [] False [[]] [[]] }@}] which is a DFA (which happens to be minimal) recognizing (0+1)* - 1(0+1)* An example from the original message: dom19 = [one,two] where one = FaState 1 True [two] [] two = FaState 2 True [one] [one] finAuDeterminize dom19 -- shows [{@{State [1,2] True [[1,2]] [[1]] } {State [1] True [[2]] [[]] } {State [2] True [[1]] [[1]] } {State [] False [[]] [[]] }@}] which recognizes (0+1)* - (0+1)*11(0+1)*