Calculating Journeys

-- WARNING: contains recursive programming


-- For example data, pick some imaginary flight network:

data Node = Paris | London | Shanghai | NewYork | Tokyo deriving (Eq, Show)

flights Paris = [London]
flights London = [Paris,Shanghai,NewYork]
flights Shanghai = [Tokyo,NewYork]
flights NewYork = [London]
flights Tokyo = [Paris,London,Shanghai]


-- and a convenient data representation of the transitive closure

data Graph a = {- DeadEnd | -} a :-->: [Graph a] deriving Show

transitiveClosure location = location :-->: map transitiveClosure (flights location)

{-- define the truncation of any cyclical journeys

finite visited DeadEnd = DeadEnd
finite visited (location :-->: destinations)
 | already visited location = DeadEnd
 |         otherwise        = location :-->: map (finite (location : visited)) destinations

already = flip elem
-}

{-- remove any 'DeadEnd's left over

simplify DeadEnd = DeadEnd
simplify (location :-->: destinations) = location :-->: purge (map simplify destinations)

purge = foldr cons []
 where cons DeadEnd ys = ys
       cons x       ys = x : ys
-}

-- holidays = simplify . finite [] . transitiveClosure

-- but fusing the truncation and simplification into one allows the 'DeadEnd' construtor to be erased!

simplifyFinite visited (location :-->: destinations) =
 location :-->: filter (not . already visited) (map (simplifyFinite (location : visited)) destinations)

already visited (location :-->: _) = elem location visited

holidays = simplifyFinite [] . transitiveClosure


-- > holidays Paris
-- Paris :-->: [London :-->: [Shanghai :-->: [Tokyo :-->: [],
--                                            NewYork :-->: []],
--                            NewYork :-->: []]]
-- > holidays London 
-- London :-->: [Paris :-->: [],
--               Shanghai :-->: [Tokyo :-->: [Paris :-->: []],
--                               NewYork :-->: []],
--               NewYork :-->: []]