The program below results in <<loop>> in GHC.
...Obviously. In hindsight.
It happens because walk is computing a fixed point, but there are multiple possible fixed points. When the list comprehension reaches the end of the graph-walk, it "asks" for the next element of answer; but that is exactly what it's already trying to compute. I guess I figured the program would get to the, er, end of the list, and stop.
I have to admit, I'm a bit sentimental about this nice code, and wish I could make it work.
What should I do instead?
How can I predict when "tying the knot" (referring to the value inside the expression that says how to compute the value) is a bad idea?
import Data.Set(Set)
import qualified Data.Set
-- Like `Data.List.nub`, remove duplicate elements from a list,
-- but treat some values as already having been seen.
nub :: Set Integer -> [Integer] -> [Integer]
nub _ [] = []
nub seen (x:xs) =
if Data.Set.member x seen
then nub seen xs
else x : nub (Data.Set.insert x seen) xs
-- A directed graph where the vertices are integers.
successors :: Integer -> [Integer]
successors x = [(x + 2) `mod` 7, (x + 3) `mod` 7]
-- Breadth first search of a directed graph. Returns a list of every integer
-- reachable from a root set in the `successors` graph.
walk :: [Integer] -> [Integer]
walk roots =
let rootSet = Data.Set.fromList roots
answer = roots ++ nub rootSet [y | x <- answer, y <- successors x]
in answer
main = putStrLn $ show $ walk [0]
Here's one idea of how to fix it: well, we need a termination condition, right? So let's keep enough structure to know when we should terminate. Specifically, instead of producing a stream of nodes, we'll produce a stream of frontiers, and stop when the current frontier is empty.
import Data.Set(Set)
import qualified Data.Set as S
-- Like `Data.List.nub`, but for nested lists. Order in inner lists is not
-- preserved. (A variant that does preserve the order is not too hard to write,
-- if that seems important.)
nestedNub :: Set Integer -> [[Integer]] -> [[Integer]]
nestedNub _ [] = []
nestedNub seen (xs_:xss) = S.toList xs : nestedNub (seen `S.union` xs) xss where
xs = S.fromList xs_ `S.difference` seen
-- A directed graph where the vertices are integers.
successors :: Integer -> [Integer]
successors x = [(x + 2) `mod` 7, (x + 3) `mod` 7]
walk :: [Integer] -> [Integer]
walk roots =
let answer = nestedNub S.empty
$ roots
: [[y | x <- frontier, y <- successors x] | frontier <- answer]
in concat $ takeWhile (not . null) answer
main = print $ walk [0]
There is almost certainly no general algorithm for knowing when tying the knot is a bad idea -- my gut says that's a halting problem thing, though I admit I didn't try to work out the details!