Skip to content

Commit

Permalink
Updated dependencies, remove old Int import
Browse files Browse the repository at this point in the history
  • Loading branch information
garyb committed Aug 13, 2015
1 parent c3ec864 commit ba0c4a9
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 23 deletions.
7 changes: 1 addition & 6 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -24,11 +24,6 @@
"package.json"
],
"dependencies": {
"purescript-maybe": "^0.3.0",
"purescript-arrays": "^0.4.0",
"purescript-foldable-traversable": "^0.4.0",
"purescript-maps": "^0.4.0",
"purescript-sets": "^0.4.0",
"purescript-lists": "^0.7.0"
"purescript-sets": "^0.5.0"
}
}
33 changes: 16 additions & 17 deletions src/Data/Graph.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,19 +4,18 @@ module Data.Graph (
Edge(..),
Graph(..),
SCC(..),

vertices,

scc,
scc',

topSort,
topSort'
) where

import Prelude

import Data.Int
import Data.Maybe
import Data.List
import Data.Foldable
Expand All @@ -37,7 +36,7 @@ data Edge k = Edge k k
-- | Edges refer to vertices using keys of type `k`.
data Graph k v = Graph (List v) (List (Edge k))

type Index = Int
type Index = Int

-- | A strongly-connected component of a graph.
-- |
Expand All @@ -47,7 +46,7 @@ type Index = Int
data SCC v = AcyclicSCC v | CyclicSCC (List v)

instance showSCC :: (Show v) => Show (SCC v) where
show (AcyclicSCC v) = "AcyclicSCC (" ++ show v ++ ")"
show (AcyclicSCC v) = "AcyclicSCC (" ++ show v ++ ")"
show (CyclicSCC vs) = "CyclicSCC " ++ show vs

instance eqSCC :: (Eq v) => Eq (SCC v) where
Expand All @@ -65,26 +64,26 @@ scc :: forall v. (Eq v, Ord v) => Graph v v -> List (SCC v)
scc = scc' id id

-- | Compute the strongly connected components of a graph.
-- |
-- |
-- | This function is a slight generalization of `scc` which allows key and value types
-- | to differ.
scc' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> List (SCC v)
scc' makeKey makeVert (Graph vs es) = runPure (runST (do
index <- newSTRef zero
index <- newSTRef zero
path <- newSTRef Nil
indexMap <- newSTRef M.empty
lowlinkMap <- newSTRef M.empty
components <- newSTRef Nil

(let
(let
indexOf v = indexOfKey (makeKey v)

indexOfKey k = do
m <- readSTRef indexMap
return $ M.lookup k m

lowlinkOf v = lowlinkOfKey (makeKey v)

lowlinkOfKey k = do
m <- readSTRef lowlinkMap
return $ M.lookup k m
Expand All @@ -97,7 +96,7 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do

strongConnect k = do
let v = makeVert k

i <- readSTRef index

modifySTRef indexMap $ M.insert k i
Expand All @@ -123,23 +122,23 @@ scc' makeKey makeVert (Graph vs es) = runPure (runST (do
modifySTRef lowlinkMap $ M.alter (maybeMin index) k

vIndex <- indexOfKey k
vLowlink <- lowlinkOfKey k
vLowlink <- lowlinkOfKey k

when (vIndex == vLowlink) $ do
currentPath <- readSTRef path
let newPath = popUntil makeKey v currentPath Nil
modifySTRef components $ flip (++) (singleton (makeComponent newPath.component))
writeSTRef path newPath.path
return unit

makeComponent (Cons v Nil) | not (isCycle (makeKey v)) = AcyclicSCC v
makeComponent vs = CyclicSCC vs

isCycle k = any (\(Edge k1 k2) -> k1 == k && k2 == k) es
in go vs)))

popUntil :: forall k v. (Eq k) => (v -> k) -> v -> List v -> List v -> { path :: List v, component :: List v }
popUntil _ _ Nil popped = { path: Nil, component: popped }
popUntil _ _ Nil popped = { path: Nil, component: popped }
popUntil makeKey v (Cons w path) popped | makeKey v == makeKey w = { path: path, component: Cons w popped }
popUntil makeKey v (Cons w ws) popped = popUntil makeKey v ws (Cons w popped)

Expand All @@ -154,7 +153,7 @@ topSort :: forall v. (Eq v, Ord v) => Graph v v -> List v
topSort = topSort' id id

-- | Topologically sort the vertices of a graph
-- |
-- |
-- | This function is a slight generalization of `scc` which allows key and value types
-- | to differ.
topSort' :: forall k v. (Eq k, Ord k) => (v -> k) -> (k -> v) -> Graph k v -> List v
Expand Down

0 comments on commit ba0c4a9

Please sign in to comment.