Skip to content

Instantly share code, notes, and snippets.

@jagbolanos
Created March 5, 2011 23:37
Show Gist options
  • Save jagbolanos/856828 to your computer and use it in GitHub Desktop.
Save jagbolanos/856828 to your computer and use it in GitHub Desktop.
Some DFS based graph algorithms in Haskell
--Proposed solutions to problems 87,88 and 89 of "99 Haskell Problems"
--Not optimal but they work
--If you know haskell and want to solve some problems there are some missing at:
--http://www.haskell.org/haskellwiki/99_questions/80_to_89
import Data.List
type Node = Int
type Edge = (Node,Node)
type Graph = ([Node],[Edge])
depthfirst :: Graph -> Node -> [Node]
depthfirst (v,e) n
| [x|x<-v,x==n] == [] = []
| otherwise = dfrecursive (v,e) [n]
dfrecursive :: Graph -> [Node] -> [Node]
dfrecursive ([],_) _ = []
dfrecursive (_,_) [] = []
dfrecursive (v,e) (top:stack)
| [x|x<-v,x==top] == [] = dfrecursive (newv, e) stack
| otherwise = top : dfrecursive (newv, e) (adjacent ++ stack)
where
adjacent = [x | (x,y)<-e,y==top] ++ [x | (y,x)<-e,y==top]
newv = [x|x<-v,x/=top]
connectedcomponents :: Graph -> [[Node]]
connectedcomponents ([],_) = []
connectedcomponents (top:v,e)
| remaining == [] = [connected]
| otherwise = connected : connectedcomponents (remaining, e)
where
connected = depthfirst (top:v,e) top
remaining = (top:v) \\ connected
dfsbipartite :: Graph -> [(Node, Int)] -> [Node] -> [Node] -> Bool
dfsbipartite ([],_) _ _ _ = True
dfsbipartite (_,_) [] _ _ = True
dfsbipartite (v,e) ((nv, 0):stack) odd even
| [x|x<-v,x==nv] == [] = dfsbipartite (v, e) stack odd even
| [] == intersect adjacent even = dfsbipartite (newv, e) ([(x,1)|x<-adjacent] ++ stack) odd (nv : even)
| otherwise = False
where
adjacent = [x | (x,y)<-e,y==nv] ++ [x | (y,x)<-e,y==nv]
newv = [x|x<-v,x/=nv]
dfsbipartite (v,e) ((nv, 1):stack) odd even
| [x|x<-v,x==nv] == [] = dfsbipartite (v, e) stack odd even
| [] == intersect adjacent odd = dfsbipartite (newv, e) ([(x,0)|x<-adjacent] ++ stack) (nv : odd) even
| otherwise = False
where
adjacent = [x | (x,y)<-e,y==nv] ++ [x | (y,x)<-e,y==nv]
newv = [x|x<-v,x/=nv]
bipartite :: Graph -> Bool
bipartite ([],_) = True
bipartite (top:v,e) = dfsbipartite (top:v, e) [(top,0)] [] []
@KC3000
Copy link

KC3000 commented Mar 6, 2011

As Randy Pausch would have said, "That was pretty good but I know you can do better." :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment