Etage-Graph 0.1 → 0.1.1

raw patch · 3 files changed

+18/−19 lines, 3 filesdep +paralleldep ~Etage-Graphnew-component:exe:etage-graph-test

Dependencies added: parallel

Dependency ranges changed: Etage-Graph

Files

• Etage-Graph.cabal +4/−3
• lib/Data/Graph/Etage.hs +4/−4
• src/Test.hs +10/−12

@@ -1,5 +1,5 @@ Name:                Etage-Graph-Version:             0.1+Version:             0.1.1 Synopsis:            Data-flow based graph algorithms Description:         Data-flow based graph algorithms using the "Control.Etage" framework, showcasing its use for data-flow                      computations. It is meant to be used with the "Data.Graph.Inductive" package which provides graph structures@@ -32,7 +32,7 @@   GHC-prof-options:    -Wall   GHC-shared-options:  -Wall -Executable test+Executable etage-graph-test   Main-is:             Test.hs   HS-source-dirs:      src   Build-depends:       base >= 4.3 && < 5,@@ -42,6 +42,7 @@                        deepseq >= 1.1 && < 2,                        array >= 0.3 && < 1,                        time >= 1.1 && < 2,+                       parallel >= 3.1 && < 4,                        Etage == 0.1.8,-                       Etage-Graph == 0.1+                       Etage-Graph == 0.1.1   GHC-options:         -Wall -rtsopts -threaded

@@ -106,11 +106,11 @@   impulseTime TopologyUpdate { impulseTimestamp } = impulseTimestamp   impulseTime TopologyChange { impulseTimestamp } = impulseTimestamp   impulseTime AddOutEdges { impulseTimestamp } = impulseTimestamp-  impulseValue TopologyUpdate { originator, path } = toRational o : (value . fst $ path)-    where (o, _) = originator-          value (LP p) = concatMap (\(n, l) -> [toRational n, toRational l]) p+  impulseValue TopologyUpdate { originator = (o, _), path } = toRational o : (value . fst $ path)+    where value (LP p) = concatMap (\(n, l) -> [toRational n, toRational l]) p   impulseValue TopologyChange {} = []-  impulseValue AddOutEdges { newOutEdges } = concatMap (\(l, n) -> [toRational l, toRational n]) newOutEdges+  impulseValue AddOutEdges { newOutEdges } = concatMap value newOutEdges+    where value (l, n) = [toRational l, toRational n]  instance (Show a, Data a, Show b, Data b, Real b, Bounded b) => Neuron (NodeNeuron a b) where   type NeuronFromImpulse (NodeNeuron a b) = GraphImpulse a b

@@ -9,6 +9,7 @@ import Control.Exception import Control.Monad import Control.Monad.ST+import Control.Parallel.Strategies import Data.Array hiding (elems) import Data.Array.ST import Data.Data@@ -20,6 +21,7 @@ import Data.Ratio import Data.Time.Clock.POSIX import GHC.Arr+import GHC.Conc import System.Console.GetOpt import System.Environment import System.Exit@@ -105,7 +107,7 @@     pathsLazy <- stToIO $ newArray ((1, 1), (graphSize, graphSize)) (maxBound, [])     collectTimeout <- collectPaths initialCollectTimeout pathsLazy     pathsLazy' <- stToIO $ unsafeFreezeSTArray pathsLazy-    let !paths = pathsLazy' `deepseq` pathsLazy'+    let !paths = pathsLazy' `using` evalTraversable rdeepseq     after <- getPOSIXTime     putStrLn $ "Etage search time for shortest paths: " ++ show (after - before - fromRational (fromIntegral collectTimeout % 1000000)) ++ " (" ++ printf "%fs" ((fromIntegral collectTimeout :: Double) / 1000000) ++ " timeout)" -- we correct for the last timeout     let paths'      = M.fromList $ assocs paths@@ -176,13 +178,13 @@   putStrLn $ "Graph contains " ++ show graphSize ++ " nodes."      before <- getPOSIXTime-  let lazyPaths = dijkstraShortestPaths graph graphSize-      !paths    = lazyPaths `deepseq` lazyPaths+  let !paths = dijkstraShortestPaths graph graphSize `using` evalTraversable rdeepseq   after <- getPOSIXTime   putStrLn $ "Dijkstra search time for shortest paths: " ++ show (after - before)    incubate $ do     nerveTest <- (growNeuron :: NerveOnlyFor (TestNeuron String Double)) (\o -> o { graphSize, knownPaths = paths })+    -- TODO: Also measure network growing time     pathsNerves <- shortestPaths graph          mapM_ (`attachTo` [TranslatableFor nerveTest]) $ M.elems pathsNerves@@ -192,12 +194,8 @@ forceStrictGraph :: (NFData a, NFData b, Graph gr) => gr a b -> IO () forceStrictGraph g = labNodes g `deepseq` labEdges g `deepseq` return () -dijkstraShortestPaths :: forall gr a b. (Graph gr, Bounded b, Real b) => gr a b -> Int -> Array (Node, Node) (b, [Node])-dijkstraShortestPaths graph graphSize = runSTArray buildPaths-  where buildPaths :: ST s (STArray s (Node, Node) (b, [Node]))-        buildPaths = do-          arr <- newArray ((1, 1), (graphSize, graphSize)) (maxBound, [])-          forM_ (nodes graph) $ \sourceNode ->-            forM_ (spTree sourceNode graph) $ \(LP (n@(node, len):ns)) ->-              writeArray arr (sourceNode, node) (len, reverse . map fst $ n:ns)-          return arr+dijkstraShortestPaths :: (Graph gr, Bounded b, Real b, NFData b) => gr a b -> Int -> Array (Node, Node) (b, [Node])+dijkstraShortestPaths graph graphSize = array ((1, 1), (graphSize, graphSize)) $ initialValues ++ concat pathsValues+  where initialValues           = [ ((i, j), (maxBound, [])) | i <- [1..graphSize], j <- [1..graphSize] ]+        pathsValues             = map spFromSource (nodes graph) `using` parListChunk (noNodes graph `div` (numCapabilities * 10)) rdeepseq+        spFromSource sourceNode = map (\(LP (n@(node, len):ns)) -> ((sourceNode, node), (len, reverse . map fst $ n:ns))) $ spTree sourceNode graph