Week 13: Notes

graph representations

Here's a adjacency-list representation for graphs in Haskell:

type Graph a = [(a, [a])]

adjacent :: Eq a => Graph a -> a -> [a]
adjacent graph v = fromJust (lookup v graph)

For example, here's an undirected graph and its representation:

graph :: Graph Char
graph = [ ('a', "ce"), ('b', "de"), ('c', "adf"), ('d', "bcef"),
          ('e', "bdf"), ('f', "cdeg"), ('g', "f") ]

depth-first search using a fold

-- Return a list of visited vertices in the order they were visited.
dfs :: Eq a => Graph a -> a -> [a]
dfs graph start = reverse (visit [start] start)
    where visit visited v =
            let ns = adjacent graph v \\ visited
            in foldl visit (ns ++ visited) ns

depth-first search with a stack

-- Return a list of visited vertices in the order they were visited.
dfs1 :: Eq a => Graph a -> a -> [a]
dfs1 graph start = reverse (loop [start] [start])
    where loop visited [] = visited
          loop visited (v : vs) =
              let ns = adjacent graph v \\ visited
              in loop (ns ++ visited) (ns ++ vs)

breadth-first search with a queue

This function is very similar to the depth-first search function in the previous section. The only code difference is highlighted below.

-- return list of vertices visited, in order
bfs :: Eq a => Graph a -> a -> [a]
bfs graph start = reverse (loop [start] [start])
    where loop visited [] = visited
          loop visited (v : vs) =
              let ns = adjacent graph v \\ visited
              in loop (ns ++ visited) (vs ++ ns)

breadth-first search, returning the shortest path between two vertices

In the function below, the queue holds a list of paths. Each path is a list of vertices from the start vertex to a vertex v, in reverse order.

-- return a list of vertices along the shortest path from start to end
bfs1 :: Eq a => Graph a -> a -> a -> Maybe [a]
bfs1 graph start end = loop [start] [[start]]
    where loop visited [] = Nothing
          loop visited ((v : vs) : ps)
              | v == end = Just (reverse (v : vs))
              | otherwise =
                let ns = adjacent graph v \\ visited
                in loop (ns ++ visited) (ps ++ [n : v : vs | n <- ns])

fox and hounds game

We worked on implementing the fox and hounds game, which is exercise #7 on this page. We solved parts (a) - (e) in the tutorial, and will continue with the rest of the exercise next week.

-- (x, y) position, indexed from 0
type Pos = (Int, Int)

data Player = Fox | Hounds

type Game = (Player, Pos, [Pos])  -- turn, fox pos, hounds pos

start :: Game
start = (Fox, (0, 7), [(x, 0) | x <- [1, 3, 5, 7]])

show_game :: Game -> String
show_game (_, fox, hounds) =
    let str (x, y)
          | (x, y) == fox = "F "
          | elem (x, y) hounds = "H "
          | odd (x + y) = ". "
          | otherwise = "  "
        line y = concat [str (x, y) | x <- [0 .. 7]]
    in unlines (map line [0 .. 7])

type Move = (Pos, Pos)

validPos :: Pos -> Bool
validPos (x, y) = 0 <= x && x < 8 && 0 <= y && y < 8

possible :: Game -> [Move]
possible (Fox, (x, y), hounds) =
    [((x, y), (x1, y1)) | x1 <- [x + 1, x - 1], y1 <- [y + 1, y - 1],
                          validPos (x1, y1), notElem (x1, y1) hounds]
possible (Hounds, fox, hounds) =
    [((x, y), (x1, y1)) | (x, y) <- hounds, 
                          x1 <- [x + 1, x - 1], let y1 = y + 1,
                          validPos (x1, y1), notElem (x1, y1) (fox : hounds)]

move :: Game -> Move -> Game
move (Fox, fox, hounds) (from, to) = (Hounds, to, hounds)
move (Hounds, fox, hounds) (from, to) =
    (Fox, fox, to : delete from hounds)