bfs.hs

import Data.List (elemIndices,(\\))

----------------------------------------------------------------------
-- main: some io and organisational stuff

main :: IO ()
main = do
    -- read adjacency matrix file to matrix :: [[Int]]
    matrixfile  <- readFile "RandomGraph.txt"
    let matrix  = map (map (read :: String -> Int) . words) $ lines matrixfile

    let path1 = breathFirstSafe matrix (0,4)
    print path1


----------------------------------------------------------------------
-- some types (and helpers) we'll use

type Vertex = Int                   -- a vertex is represented by its number
type Walk   = [Vertex]              -- a walk is a sequence of vertices (simple graph)
type Graph  = [[Vertex]]            -- a graph is its adjacency matrix
type ChiPar = (Vertex, Vertex)      -- a child and its parent (oh, isn't this so cute?)
type QueVis = ([ChiPar], [ChiPar])  -- a queue and visited list

child :: ChiPar -> Vertex
child (c,_) = c
parent :: ChiPar -> Vertex
parent (_,p) = p

----------------------------------------------------------------------
-- actual algorithm

breathFirstSafe :: Graph -> (Vertex, Vertex) -> Walk
breathFirstSafe g (s,e)
    | last w == e   = w
    | otherwise     = []
    where w = breathFirst g (s,e) 

breathFirst :: Graph -> (Vertex, Vertex) -> Walk
breathFirst graph (start, end) =  genWalk cps
    where cps = takeNextVert graph end ([(start,-1)],[])

takeNextVert :: Graph -> Vertex -> QueVis -> QueVis
takeNextVert _ _ ([],vs) = ([],vs) 
takeNextVert g e (v:qs,vs) 
    | e == child v  = ([],v:vs)
    | otherwise     = takeNextVert g e (qs ++ cs,v:vs)
    where cs  = childrenNV g (child v) (qs,vs)

childrenNV :: Graph -> Vertex -> QueVis -> [ChiPar]
childrenNV g p (qs,vs) = map (\c -> (c,p)) $ elemIndices 1 (g!!p) \\ visitedOrQueued
    where visitedOrQueued = map child vs ++ map child qs

genWalk :: QueVis -> Walk 
genWalk (_,[])        = []
genWalk (_,(e,e'):vs) = foldl backprop [e',e] vs 
    where
        backprop w (c,p) 
            | c == head w && p /= -1    = p:w
            | otherwise                 = w