Created
March 5, 2011 23:37
-
-
Save jagbolanos/856828 to your computer and use it in GitHub Desktop.
Some DFS based graph algorithms in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
--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)] [] [] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
As Randy Pausch would have said, "That was pretty good but I know you can do better." :)