A place to discuss the implementation and style of computer programs.

Moderators: phlip, Moderators General, Prelates

bieber
Posts: 223
Joined: Thu Mar 13, 2008 12:13 am UTC

I've started learning Haskell, and I feel like I'm beginning to get the concepts behind functional programming, so I decided to play around with it a little before I moved on (right now I know the basics of defining functions with pattern matching, list comprehensions, and working with basic data types, lists and tuples). I figured a good exercise would be trying to implement Kruskal's algorithm with it, since we were just going over how to implement it (in an imperative language, of course) in Comp Sci today.

So I set about doing it, and at first I figured there should be a way to do it all with a single elegant list comprehension...but I couldn't quite make that work, so I just went for a straight-forward recursive definition that I think should work, except that it's dependent on a function that determines whether or not adding an edge to the MST will form a circuit, which is in turn dependent on a function that determines the parent of a node in a tree graph, that I can't quite seem to make work right. In class we were told to use disjoint sets to keep track of the parents of all the nodes as we went along, which works great, but I can't seem to reconcile it with the functional paradigm, since it's a strictly imperative technique that uses arrays.

Rambling aside, I was wondering if anyone has any suggestion as to how I could most efficiently implement the parent and loop functions, or just replace them altogether with some more clever technique. Do I just need to break down and make the whole thing iterative? Do most algorithms just not adapt well? Here's the mess of code I've thrown together so far, if anyone feels like figuring out how I could fix it (I realize at the moment that my parent implementation isn't working because the graph is undirected, but I haven't quite figured out how to make it work)

Code: Select all

`--A QuickSort implementation to sort the edges used initiallyqs :: Ord b => (a -> b) -> [a] -> [a]qs _ [] = []qs eval (pivot: rest) = qs eval left ++ (pivot : qs eval right)    where    left = [x | x <- rest, (eval x) < (eval pivot)]    right = [x | x <- rest, (eval x) >= (eval pivot)]    --A graph is a list of three-tuples, formatted as:--(begin, end, weight) :: (Char, Char, Int)--Here's a simple graph to test the algorithm withtestGraph :: [(Char, Char, Int)]testGraph = [('a', 'b', 8), ('a', 'c', 1), ('a', 'd', 6),             ('b', 'c', 4), ('b', 'd', 2),             ('c', 'd', 3), ('c', 'e', 1),             ('d', 'e', 9)]--Kruskal's MST algorithm--The base function calls the recursive function with the graph's edges sorted--in descending order by edge weight, so the first recursive calls that actually--get considered are those with the lowest edge weightsmst :: [(Char, Char, Int)] -> [(Char, Char, Int)]mst x = mstRec (qs (\(x, y, z) -> -z) x)mstRec :: [(Char, Char, Int)] -> [(Char, Char, Int)]--MST for an empty graph is an empty graphmstRec [] = []--The head of the list will always be the worst-case weighted edge.  If adding--the worst possible edge wouldn't produce a loop in the graph when added to the --MST one iteration before, then we add it to the end of the MST one iteration--before this onemstRec (worst: rest)    | not(loops worst (mstRec rest)) = mstRec rest ++ [worst]    | otherwise = mstRec rest--Determines whether adding an edge to a graph will produce a looploops :: (Char, Char, Int) -> [(Char, Char, Int)] -> Boolloops _ [] = False--Determines the ultimate parent of a graph node on an MSTparent :: Char -> [(Char, Char, Int)] -> Charparent node graph    | length findParent == 0 = node    | otherwise = parent (findParent !! 0) graph    where     bySource=[y | (x, y, z) <- graph, x==node]    byDest=[x | (x, y, z) <- graph, y==node]        findParent        | not(length bySource == 0) = bySource        | not(length byDest == 0) = byDest        | otherwise = []`

dosboot
Posts: 143
Joined: Sun Jul 01, 2007 5:26 am UTC

If this is correct then I'm pleased:

Code: Select all

`{-http://en.wikipedia.org/wiki/Kruskal%27s_algorithm    * create a forest F (a set of trees), where each vertex in the graph is a separate tree    * create a set S containing all the edges in the graph    * while S is nonempty          o remove an edge with minimum weight from S          o if that edge connects two different trees, then add it to the forest, combining two trees into a single tree          o otherwise discard that edge.-}import Data.Listadjacent :: e -> e -> Booladjacent = undefined--adds edge 'e' to forest 'ts' ("trees") as per descriptionf :: [[e]] -> e -> [[e]]f ts e =     let (ts1,ts2) = partition (any \$ adjacent e) ts        forms_cycle es = (==2) . length \$ filter (adjacent e) es    in case ts1 of         [t1,t2] -> (e:t1 ++ t2) : ts2             --e bridges two non-singleton trees         [] -> [e] : ts2                           --e bridges two singleton trees          [t] -> if (forms_cycle t) then t : ts2 else (e:t) : ts2  --e adjacent to exactly one tree--takes a list of all edges sorted by weight, minimum weight first, and returns a minimum spanning forestkruskal :: [e] -> [e]kruskal [] = []kruskal es = head \$ foldl' f [] es`

You are better off using the Data.List sort over writing your own. Anything that can be done imperatively can be done in Haskell to several possible degrees of imperativeness, and you'd want to implement it however would be most elegant first.

bieber
Posts: 223
Joined: Thu Mar 13, 2008 12:13 am UTC

`module Mainwhereimport IOimport Data.List-- An edge is a three-tuple, source followed by dest followed by weightdata Edge = Edge String String Int-- Functions for edgesedgeSrc :: Edge -> StringedgeSrc (Edge a _ _) = aedgeDest :: Edge -> StringedgeDest (Edge _ b _) = bedgeWeight :: Edge -> IntedgeWeight (Edge _ _ c) = cshowEdge :: Edge -> StringshowEdge (Edge a b c) = "Edge from " ++ (show  a) ++ " to " ++ (show b) ++                         " with weight " ++ (show  c)                        ordEdge :: Edge -> Edge -> OrderingordEdge (Edge _ _ a) (Edge _ _ b)    | a == b = EQ    | a < b = LT    | a > b = GT-- A graph is just a list of edgestype Graph = [Edge]showGraph :: Graph -> StringshowGraph g = "Graph\n-----\n" ++ (foldl (++) "" [showEdge x ++ "\n" | x <- g])-- The MST functionmst :: Graph -> Graphmst g = mstRec g [] [ (x, x) | x <- (points g)]mstRec :: Graph -> Graph -> [(String, String)] -> GraphmstRec [] progress sets = progressmstRec (e:es) progress sets    | joined (edgeSrc e) (edgeDest e) sets = mstRec es progress sets    | otherwise = mstRec es (e : progress) (join (edgeSrc e) (edgeDest e) sets)-- Functions to operate on disjoint sets-- A disjoint set is given as a list of pairs of Strings, the first string being-- the point, the second string being its parentparent :: String -> [(String, String)] -> Stringparent elem sets    |fst match == snd match = fst match    |otherwise = parent (snd match) sets    where        match = head ([ (x, y) |(x, y) <- sets, x == elem]) joined :: String -> String -> [(String, String)] -> Booljoined x y sets = (parent x sets) == (parent y sets)join :: String -> String -> [(String, String)] -> [(String, String)]join x y sets    | joined x y sets = sets    | otherwise = newY : rest    where        newY = (fst oldY, x)        oldY = head [(a, b) | (a, b) <- sets, a==(parent y sets)]        rest = [(a, b) | (a, b) <- sets, a /= (parent y sets)]    -- Finds all the points in a graphpoints :: Graph -> [String]points g = pointsRec g []pointsRec :: Graph -> [String] -> [String]pointsRec [] s = spointsRec (e:es) s = pointsRec es (first ++ second ++ s) where    first        | not(elem (edgeSrc e) s ) = [edgeSrc e]        | otherwise = []    second        | edgeSrc e == edgeDest e = []        | not(elem (edgeDest e) s) = [edgeDest e]        | otherwise = []main = do    putStrLn "Enter the initial graph, by its edges"    startGraph <- getUserGraph 'y'    let ordGraph = Data.List.sortBy ordEdge startGraph    putStrLn ""    putStrLn (showGraph ordGraph)    putStrLn "Calculating MST...\n\n"    let finalGraph = mst ordGraph    putStrLn (showGraph finalGraph)        -- Gets a graph from the usergetUserGraph :: Char -> IO GraphgetUserGraph cont = if cont=='y' then    do        putStrLn "Source: "        src <- getLine        putStrLn "Destination: "        dest <- getLine        putStrLn "Weight: "        weight <- getLine        putStrLn "Enter another edge? (y/n)"        response <- getLine        rest <- getUserGraph (head response)        return ( [Edge src dest (read weight)] ++ rest )    else        return []`