Etage-Graph (empty) → 0.1
raw patch · 5 files changed
+603/−0 lines, 5 filesdep +Etagedep +Etage-Graphdep +arraysetup-changed
Dependencies added: Etage, Etage-Graph, array, base, containers, deepseq, fgl, mtl, random, time
Files
- Etage-Graph.cabal +47/−0
- LICENSE +165/−0
- Setup.hs +2/−0
- lib/Data/Graph/Etage.hs +186/−0
- src/Test.hs +203/−0
+ Etage-Graph.cabal view
@@ -0,0 +1,47 @@+Name: Etage-Graph+Version: 0.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+ these algorithms take as an input.+ .+ Currently only the shortest paths computation is implemented (from all to all nodes).+ .+ Also a benchmarking @test@ program is provided, comparing the performance with algorithms found in the+ "Data.Graph.Inductive" package.+License: LGPL-3+License-file: LICENSE+Author: Mitar Milutinovic+Maintainer: mitar.haskell@tnode.com+Copyright: (c) 2011 Mitar Milutinovic+Category: Data Structures+Build-type: Simple+Cabal-version: >= 1.8+Stability: experimental+Homepage: http://mitar.tnode.com++Library+ Exposed-modules: Data.Graph.Etage+ Build-depends: base >= 4.3 && < 5,+ Etage >= 0.1.8 && < 0.2,+ fgl >= 5.4.2 && < 5.5,+ mtl >= 2.0 && < 3,+ containers >= 0.4 && < 1+ HS-source-dirs: lib+ GHC-options: -Wall+ GHC-prof-options: -Wall+ GHC-shared-options: -Wall++Executable test+ Main-is: Test.hs+ HS-source-dirs: src+ Build-depends: base >= 4.3 && < 5,+ fgl >= 5.4.2 && < 5.5,+ random >= 1.0 && < 2,+ containers >= 0.4 && < 1,+ deepseq >= 1.1 && < 2,+ array >= 0.3 && < 1,+ time >= 1.1 && < 2,+ Etage == 0.1.8,+ Etage-Graph == 0.1+ GHC-options: -Wall -rtsopts -threaded
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions. ++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version. ++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/Data/Graph/Etage.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, TypeSynonymInstances, StandaloneDeriving, DeriveDataTypeable, NamedFieldPuns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|+Please read the "Control.Etage" framework documentation for general information how it works. Also check included @test@ program for+an example of how to work with the algorithms bellow.+-}++module Data.Graph.Etage (+ shortestPaths,+ sendTopologyChange,+ GraphImpulse(..)+) where++import Control.Exception+import Control.Monad.State+import Data.Data+import Data.Graph.Inductive hiding (inn, inn', out, out', node', nodes, run)+import qualified Data.Map as M+import Data.Map hiding (filter, map, empty, null, lookup)+import Data.Tuple+import Control.Etage+import System.IO++type SPath b = (LPath b, b)+type SPaths a b = M.Map Node (a, SPath b) -- node is destination, last element of SPath++{-|+Shortest paths algorithm (from all to all nodes) using message ('Impulse's in the "Control.Etage" terminology) passing between the+nodes along the edges of the graph to compute shortest paths. Loosely based on the algorithm used in the Babel routing+protocol, <http://www.pps.jussieu.fr/~jch/software/babel/>.++It takes a "Data.Graph.Inductive" graph as an input and produces a map between source nodes and its corresponding 'Nerve's, over which+'Impulse's about shortest paths search will be send. To trigger the search 'sendTopologyChange' should be used on returned 'Nerve's.++One way how to collect this 'Impulse's into an array for querying about shortest paths can be found in the @test@ program found in+this package.++While shortest paths search is lasting, information about suboptimal paths is already available. This algorithm also allows effective+incremental search after graph topology changes (new nodes are added or removed, weights are changed) but this is not yet implemented.+-}+shortestPaths :: (DynGraph gr, Show a, Data a, Data b, Real b, Bounded b) => gr a b -> Incubation (M.Map Node (Nerve (GraphImpulse a b) AxonConductive (GraphImpulse a b) AxonConductive))+shortestPaths = ufoldM' growGraph M.empty++growGraph :: forall a b. (Show a, Data a, Data b, Real b, Bounded b) => Context a b -> M.Map Node (Nerve (GraphImpulse a b) AxonConductive (GraphImpulse a b) AxonConductive) -> Incubation (M.Map Node (Nerve (GraphImpulse a b) AxonConductive (GraphImpulse a b) AxonConductive))+growGraph (inn, node, label, out) nodes = do+ -- TODO: Sometimes nerve is not connected in both directions, how to fix memory leak then?+ liftIO $ do+ assertIO $ node `notMember` nodes+ assertIO $ all ((`member` nodes) . snd) inn'+ assertIO $ all ((`member` nodes) . snd) out'+ nodeNerve <- (growNeuron :: NerveBoth (NodeNeuron a b)) (\o -> o { lnode = (node, label) })+ mapM_ ((`attachTo` [TranslatableFor nodeNerve]) . (nodes !) . snd) out'+ nodeNerve `attachTo` map (TranslatableFor . (nodes !) . snd) inn'+ liftIO $ do+ time <- getCurrentImpulseTime+ unless (null out') $ sendForNeuron nodeNerve $ AddOutEdges time out'+ mapM_ (\(l, n) -> sendForNeuron (nodes ! n) $ AddOutEdges time [(l, node)]) inn'+ return $ insert node nodeNerve nodes+ where inn' = filter ((node /=) . snd) inn -- we ignore loopbacks+ out' = filter ((node /=) . snd) out -- we ignore loopbacks++-- TODO: Also make functions to manipulate graph+-- TODO: We have to send TopologyChange to all nodes because currently it is not propagated correctly around (just along inbound edges, but it should along all)+{-|+Inform nodes that topology has changed (new nodes have been added or removed, weights changed).++Currently it should only be invoked after the data-flow graph structure has been built (for example with 'shortestPaths'). As+graph topology changing interface (and thus incremental nature of algorithms) is not yet implemented.+-}+sendTopologyChange :: M.Map Node (Nerve (GraphImpulse a b) AxonConductive (GraphImpulse a b) AxonConductive) -> Incubation ()+sendTopologyChange nodes = liftIO $ do+ time <- getCurrentImpulseTime+ forM_ (elems nodes) $ \n ->+ sendForNeuron n $ TopologyChange time++data NodeState a b = NodeState {+ lastTopologyChangeTimestamp :: ImpulseTime,+ currentPaths :: SPaths a b,+ outedges :: M.Map Node b+ }++type NodeIO a b = StateT (NodeState a b) IO++data NodeNeuron a b = NodeNeuron Node a deriving (Typeable, Data)++deriving instance Typeable1 LPath+deriving instance Data a => Data (LPath a)++data GraphImpulse a b = TopologyUpdate {+ impulseTimestamp :: ImpulseTime,+ originator :: LNode a,+ destination :: LNode a,+ path :: SPath b+ } -- ^ Informs nodes about possible improvement in the topology information, like a newly discovered shortest path.+ | TopologyChange {+ impulseTimestamp :: ImpulseTime+ } -- ^ Informs nodes that topology has changed and the algorithm should be triggered (again).+ | AddOutEdges {+ impulseTimestamp :: ImpulseTime,+ newOutEdges :: Adj b+ } -- ^ Inform the node that new outbound edges have been 'attach'ed to it, giving the node their weights.+ deriving (Eq, Ord, Show, Typeable, Data)++instance (Show a, Typeable a, Show b, Typeable b, Real b, Bounded b) => Impulse (GraphImpulse a b) where+ 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 TopologyChange {} = []+ impulseValue AddOutEdges { newOutEdges } = concatMap (\(l, n) -> [toRational l, toRational n]) newOutEdges++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+ type NeuronForImpulse (NodeNeuron a b) = GraphImpulse a b+ data NeuronOptions (NodeNeuron a b) = NodeOptions {+ lnode :: LNode a+ } deriving (Eq, Ord, Read, Show) -- TODO: Derive Data when it will work++ mkDefaultOptions = return NodeOptions {+ lnode = undefined+ }++ grow NodeOptions { lnode = (node, label) } = return $ NodeNeuron node label+ + live nerve neuron@(NodeNeuron node label) = evalStateT (run nerve neuron) (NodeState 0 (singleton node (label, (LP [(node, 0)], 0))) M.empty)++run :: (Data b, Real b, Bounded b) => Nerve (GraphImpulse a b) fromConductivity (GraphImpulse a b) forConductivity -> NodeNeuron a b -> NodeIO a b ()+run nerve (NodeNeuron node label) = forever $ do+ -- TODO: We could process multiple impulses at the same time, so that we do not send out updates for paths where better paths are already queued for us+ impulse <- liftIO $ getForNeuron nerve+ case impulse of+ TopologyChange { impulseTimestamp } -> do+ lastTimestamp <- gets lastTopologyChangeTimestamp+ when (impulseTimestamp > lastTimestamp) $ do+ modify (\s -> s { lastTopologyChangeTimestamp = impulseTimestamp })+ paths <- gets currentPaths+ liftIO $ do+ sendFromNeuron nerve impulse+ t <- liftIO getCurrentImpulseTime+ -- TODO: TopologyChange should be propagated correctly (along all edges and not just along inbound edges, as it is now)+ forM_ (toList paths) $ \(n, (l, p)) ->+ sendFromNeuron nerve TopologyUpdate { impulseTimestamp = t, originator = (node, label), destination = (n, l), path = p }+ TopologyUpdate { impulseTimestamp, originator = (o, _), destination = (d, l), path = (LP path, cost) } -> do+ liftIO $ do+ assertIO $ abs (cost - (sum . map snd $ path)) * 100000 < 1 -- we have to do compare it like that to account for approximate nature of float values+ assertIO $ (fst . last $ path) == d+ out <- gets outedges+ case M.lookup o out of+ Nothing -> liftIO $ hPutStrLn stderr "Warning: TopologyUpdate message arrived before AddOutEdges message."+ Just ocost -> do+ paths <- gets currentPaths+ let (_, (_, c)) = findWithDefault (undefined, (undefined, maxBound)) d paths+ cost' = cost + ocost+ when (cost' < c) $ do+ let path' = LP $ (node, ocost) : path+ paths' = insert d (l, (path', cost')) paths+ modify (\s -> s { currentPaths = paths' })+ liftIO $ sendFromNeuron nerve TopologyUpdate { impulseTimestamp, originator = (node, label), destination = (d, l), path = (path', cost') }+ AddOutEdges { newOutEdges } -> do+ out <- gets outedges+ let out' = foldl (\i (l, n) -> insert n l i) out newOutEdges+ modify (\s -> s { outedges = out' })++ufoldM' :: (Graph gr, Monad m) => (Context a b -> c -> m c) -> c -> gr a b -> m c+ufoldM' f u g | isEmpty g = return u+ | otherwise = ufoldM' f u g' >>= \u' -> f c u'+ where (c, g') = matchAny g++{-+gmapM' :: (DynGraph gr, Monad m) => (Context a b -> m (Context c d)) -> gr a b -> m (gr c d)+gmapM' f = ufoldM' (\c u -> f c >>= \c' -> return $ c' & u) empty+-}++instance Bounded Float where+ minBound = -1/0+ maxBound = 1/0++instance Bounded Double where+ minBound = -1/0+ maxBound = 1/0++assertIO :: Bool -> IO ()+assertIO cond = evaluate (assert cond ())
+ src/Test.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE TypeFamilies, ScopedTypeVariables, DeriveDataTypeable, NamedFieldPuns, BangPatterns #-}++module Main (+ main+) where++import Control.Applicative+import Control.DeepSeq+import Control.Exception+import Control.Monad+import Control.Monad.ST+import Data.Array hiding (elems)+import Data.Array.ST+import Data.Data+import Data.Graph.Etage+import Data.Graph.Inductive hiding (edges, defaultGraphSize)+import qualified Data.Map as M+import Data.List+import Data.Maybe+import Data.Ratio+import Data.Time.Clock.POSIX+import GHC.Arr+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO+import System.Random+import System.Timeout+import Text.Printf++import Control.Etage++defaultGraphSize :: Int+defaultGraphSize = 6++minCollectTimeout :: Int+minCollectTimeout = 500000 -- microseconds++initialCollectTimeout :: Int+initialCollectTimeout = 5000000 -- microseconds++data Option = InputGraph String | OutputGraph String | OutputDot String | GraphSize Int | Help deriving (Eq, Show)++options :: [OptDescr Option]+options = [+ Option "g" ["graph"] (ReqArg InputGraph "filename") "read graph grom a file, default is to generate one randomly",+ Option "o" ["output"] (ReqArg OutputGraph "filename") "save graph to a file",+ Option "d" ["dot"] (ReqArg OutputDot "filename") "save graph to a file in a GraphViz format",+ Option "s" ["size"] (ReqArg (GraphSize . readParam) "number") ("size of the randomly generated graph, default is " ++ show defaultGraphSize),+ Option "h" ["help"] (NoArg Help) "show this help"+ ]+ where readParam param = case reads param of+ [(p,[])] -> if p < 1+ then error $ "invalid parameter `" ++ param ++ "'"+ else p+ _ -> error $ "invalid parameter `" ++ param ++ "'"++isInputGraph :: Option -> Bool+isInputGraph (InputGraph _) = True+isInputGraph _ = False++isGraphSize :: Option -> Bool+isGraphSize (GraphSize _) = True+isGraphSize _ = False++isOutputGraph :: Option -> Bool+isOutputGraph (OutputGraph _) = True+isOutputGraph _ = False++isOutputDot :: Option -> Bool+isOutputDot (OutputDot _) = True+isOutputDot _ = False++generateGraph :: Int -> IO (Gr String Double)+generateGraph graphSize = do+ when (graphSize < 1) $ throwIO $ AssertionFailed $ "Graph size out of bounds " ++ show graphSize+ let ns = map (\n -> (n, show n)) [1..graphSize]+ edges <- fmap concat $ forM [1..graphSize] $ \node -> do+ nedges <- randomRIO (0, graphSize)+ others <- fmap (filter (node /=) . nub) $ forM [1..nedges] $ \_ -> randomRIO (1, graphSize)+ gen <- getStdGen+ let weights = randomRs (1, 10) gen+ return $ zip3 (repeat node) others weights+ return $ mkGraph ns edges++data TestNeuron a b = TestNeuron Int (Array (Node, Node) (b, [Node])) deriving (Typeable)++instance (Show a, Data a, Show b, Data b, Real b, Bounded b, NFData b) => Neuron (TestNeuron a b) where+ type NeuronFromImpulse (TestNeuron a b) = NoImpulse+ type NeuronForImpulse (TestNeuron a b) = GraphImpulse a b+ data NeuronOptions (TestNeuron a b) = NodeOptions {+ graphSize :: Int,+ knownPaths :: Array (Node, Node) (b, [Node])+ }++ mkDefaultOptions = return NodeOptions {+ graphSize = undefined,+ knownPaths = undefined+ }++ grow NodeOptions { graphSize, knownPaths } = return $ TestNeuron graphSize knownPaths+ + live nerve (TestNeuron graphSize knownPaths) = do+ before <- getPOSIXTime+ pathsLazy <- stToIO $ newArray ((1, 1), (graphSize, graphSize)) (maxBound, [])+ collectTimeout <- collectPaths initialCollectTimeout pathsLazy+ pathsLazy' <- stToIO $ unsafeFreezeSTArray pathsLazy+ let !paths = pathsLazy' `deepseq` pathsLazy'+ 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+ knownPaths' = M.fromList $ assocs knownPaths+ shortest = (fromIntegral . sum . map fromEnum . M.elems $ M.intersectionWith (\(l, p) (l', p') -> l == l' && p == p') knownPaths' paths') / fromIntegral (M.size knownPaths') :: Float+ putStrLn $ "Found " ++ printf "%.2f %%" (shortest * 100) ++ " shortest paths."+ dissolving ()+ where collectPaths :: Int -> STArray RealWorld (Node, Node) (b, [Node]) -> IO Int+ collectPaths collectTimeout arr = do+ before <- getPOSIXTime+ impulse <- timeout collectTimeout $ getForNeuron nerve+ case impulse of+ Nothing -> return collectTimeout+ Just i -> do+ let timestamp = impulseTimestamp i+ -- TODO: Improve timeout handling. Timeout only after the first TopologyChange?+ collectTimeout' = max ((collectTimeout + round ((timestamp - before) * 2 * 1000000)) `div` 2) minCollectTimeout+ case i of+ TopologyChange {} -> collectPaths collectTimeout' arr+ AddOutEdges {} -> collectPaths collectTimeout' arr+ TopologyUpdate { destination = (node, _), path = (LP path, len) } -> do+ let sourceNode = fst . head $ path+ stToIO $ writeArray arr (sourceNode, node) (len, map fst path)+ collectPaths collectTimeout' arr++main :: IO ()+main = do+ prepareEnvironment+ + args <- getArgs+ opts <- case getOpt Permute options args of+ (o, [], []) -> return o+ (_, p:_, []) -> throwIO $ ErrorCall $ "unrecognized option `" ++ p ++ "'"+ (_, _, errs) -> throwIO $ ErrorCall $ head $ lines $ head errs++ when (Help `elem` opts) $ do+ programName <- getProgName+ putStrLn $ "Usage:\n" ++ usageInfo (programName ++ " [option ...]" ++ "\n\nOptions:") options+ exitWith ExitSuccess+ + (graph, graphSize) <- case find isInputGraph opts of+ Just (InputGraph inputGraph) -> do+ when (any isGraphSize opts) $ throwIO $ ErrorCall $ "conflicting options `" ++ "--graph" ++ "' and `" ++ "--size" ++ "'"+ putStrLn $ "Reading graph from \"" ++ inputGraph ++ "\"."+ [line1, line2] <- lines <$> readFile inputGraph+ let g = mkGraph (read line1) (read line2)+ forceStrictGraph g+ return (g, noNodes g)+ _ -> do+ let GraphSize s = fromMaybe (GraphSize defaultGraphSize) $ find isGraphSize opts+ putStrLn $ "Generating a random graph of size " ++ show s ++ "."+ g <- generateGraph s+ forceStrictGraph g+ return (g, s)++ case find isOutputGraph opts of+ Just (OutputGraph outputGraph) -> do+ putStrLn $ "Writing graph to \"" ++ outputGraph ++ "\"."+ writeFile outputGraph $ (show . labNodes $ graph) ++ "\n" ++ (show . labEdges $ graph) ++ "\n"+ _ -> return ()++ case find isOutputDot opts of+ Just (OutputDot outputDot) -> do+ putStrLn $ "Writing graph in dot format to \"" ++ outputDot ++ "\"."+ writeFile outputDot $ graphviz graph "Etage" (8.27, 11.69) (1, 1) Landscape+ _ -> return ()+ + putStrLn $ "Graph contains " ++ show graphSize ++ " nodes."+ + before <- getPOSIXTime+ let lazyPaths = dijkstraShortestPaths graph graphSize+ !paths = lazyPaths `deepseq` lazyPaths+ 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 })+ pathsNerves <- shortestPaths graph+ + mapM_ (`attachTo` [TranslatableFor nerveTest]) $ M.elems pathsNerves+ + sendTopologyChange pathsNerves++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