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)] [] [] |
By the way, I always tend to think of appending as O(n^2) but pre-pending short lists is O(n) in the length of the short list. It's always post-pending that is O(n^2). And; if it's postage-pending then it's even slower. :)
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
You can also instrument your code, to see the intermediate data structures using the Hackage package hood.
{-# LANGUAGE NoMonomorphismRestriction #-}
-- Fold Behaviour Observed
module Folding where