[Haskell-cafe] "Tying the knot" with unknown keys

[Bertram Felgenhauer]

David Ritchie MacIver wrote:
> I was playing with some code for compiling regular expressions to finite 
> state machines and I ran into the following problem. I've solved it, but 
> I'm not terribly happy with my solution and was wondering if someone could 
> come up with a better one. :-)
>
> Essentially I have
>
> data FSM = State { transitions :: (Map Char FSM) }
>
> and
>
> transitions' :: Regexp -> Map Char Regexp
>
> I want to lift this so that the Regexps become states of the finite state 
> machine (while making sure I set up a loop in the data structure). Tying 
> the knot is the traditional way of doing such things, but we couldn't 
> figure out a way to make it work without the set of keys known in advance 
> because of the strictness of Map in its keys (an association list was 
> suggested, and that would probably work, but it seemed a bit ugly and would 
> be fairly inefficient).
>
> In the end what I did was just work out the set of reachable regexps in 
> advance and use a standard tying the knot trick, but it felt vaguely 
> unsatisfactory (and does some repeat work which I felt should be 
> unneccessary). Anyone have a more elegant suggestion?

Hmm. I tried and came up with this:

> import Data.Maybe
> import Data.Map (Map)

> data Graph b = Graph (Map b (Graph b))

> buildTransitionGraph :: (Ord a, Ord b) => (a -> Map b a) -> a -> Graph b
> buildTransitionGraph f i = fromJust $ i `M.lookup` build M.empty [i] where
>     -- build :: Map a (Graph b) -> [a] -> Map a (Graph b)
>     build g []     = g
>     build g (a:as) = g'' where
>         -- g'' :: Map a (Graph b)
>         g'' = build g' as'
>         (as', g') = foldr step (as, g) (M.toList (f a))
>         step (l, n) (as, g)
>              | M.member n g = (as, g)
>              | otherwise    = (n:as, M.insert n (f' n) g)
>         -- f' :: a -> Graph b
>         f' = Graph . M.map (fromJust . (`M.lookup` g'')) . f

which couples the knot tying with finding the reachable states.

'build' takes a map of states seen so far to their corresponding
'Graph' node, and a working stack of states not processed yet
and processes a single state.

'step' processes a single transition. If it leads to an unknown
state, the state is added to the seen state map. The knot is tied
between the final result of the calculation, g'', and the map
that is being built - this happens in f'.

Test:

> t :: Int -> Map Int Int
> t 1 = M.fromList [(1,2),(2,1)]
> t 2 = M.fromList [(1,2),(3,1),(4,3)]
> t _ = M.empty

> traces :: Ord b => Int -> Graph b -> [[b]]
> traces 0 g         = [[]]
> traces d (Graph g) = concat
>     [map (n:) (trace (d-1) g') | (n, g') <- M.toList g]

*Main> trace 1 $ buildTransitionGraph t 1
[[1],[2]]
*Main> trace 1 $ buildTransitionGraph t 2
[[1],[3],[4]]
*Main> trace 2 $ buildTransitionGraph t 1
[[1,1],[1,3],[1,4],[2,1],[2,2]]

It's still not lazy though. The potential lookups of states that
haven't been seen yet makes this hard to accomplish, although it
should be possible with an unbalanced search tree and some clever
use of irrefutable patterns.

enjoy,

Bertram