hasPath.hs

hasPath.hs

module Main where

type Point = Int
type From = Point
type To = Point
type Segment = (From, To)
type Graph = [Segment]

hasPath :: Graph -> From -> To -> Bool
hasPath [] _ _ = False
hasPath graph from to =
  any (\(f, t) -> (f,t) == (from, to)) graph
  ||
  let tos = graph `continueFrom` from in
    or $ fmap (\newFrom -> hasPath (graph `withoutFrom` from) newFrom to) tos

withoutFrom :: Graph -> From -> Graph
withoutFrom graph from = filter (\(f,_) -> f /= from) graph

continueFrom :: Graph -> From -> [To]
graph `continueFrom` node = 
  map snd $ filter (\(f, t) -> f == node) graph

main = do
   putStrLn $ show (hasPath [(1,2), (2,3), (3,4)] 1 4)

which can be made shorter with

hasPath :: Graph -> From -> To -> Bool
hasPath [] _ _ = False
hasPath graph from to =
  any (\(f, t) -> (f,t) == (from, to)) graph
  ||
  any ((\newFrom -> hasPath graph newFrom to) . snd) (filter (\(f, _) -> f == from) graph)

Alternative:

hasPath' :: Graph -> From -> To -> Bool
hasPath' graph from to
    | from == to = True
    | otherwise = or $ fmap (\next -> hasPath' graph next to) ((map snd (filter (\(f, _) -> f == from) graph)))