From c42c2115a38520d29e0644e3263af257d5006a10 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 1 Jul 2022 12:34:31 +0100 Subject: [PATCH] Commit before attempting to stream room generation --- src/Dodge/Path.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index 46adda775..3e247db67 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -22,7 +22,7 @@ import Data.List import Data.Graph.Inductive hiding ((&)) import Data.Set (Set) import qualified Data.Set as Set -import Data.Map (Map) +import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Streaming.Prelude as S import StreamingHelp @@ -109,19 +109,24 @@ pairsToGraph :: Set.Set (Point2,Point2) -> PathGraph pairsToGraph pairset = PathGraph gr' nodemap ncount edgemap where (gr,nodemap,ncount) = insertNodes pairset - (gr',edgemap) = insertEdges toPathEdge pairset gr nodemap + (gr',edgemap) = insertEdges toPathEdge gr nodemap pairset toPathEdge :: Point2 -> Point2 -> PathEdge toPathEdge sp' ep = PathEdge sp' ep mempty insertEdges :: (Point2 -> Point2 -> b) - -> Set (Point2,Point2) -> Gr Point2 b -> Map Point2 Int + -> Gr Point2 b -> Map Point2 Int + -> Set (Point2,Point2) -> (Gr Point2 b, Map (V2 Point2) (Int,Int,b)) -insertEdges efunc pairset gr nm = runIdentity $ S.fold_ insertedge (gr,mempty) id $ S.each pairset - where - insertedge (gr',em) (a,b) = (insEdge (f a,f b,efunc a b) gr' - , M.insert (V2 a b) (f a,f b,efunc a b) em) - f a = nm M.! a +insertEdges efunc gr nm = runIdentity . S.fold_ (insertEdge efunc nm) (gr,mempty) id . S.each + +insertEdge :: Ord a => (a -> a -> c) -> Map a Int -> (Gr b c,Map (V2 a) (Int,Int,c)) + -> (a,a) + -> (Gr b c,Map (V2 a) (Int,Int,c)) +insertEdge efunc nm (gr',em) (a,b) = (insEdge (f a,f b,efunc a b) gr' + , M.insert (V2 a b) (f a,f b,efunc a b) em) + where + f x = nm M.! x insertNodes :: Set (Point2,Point2) -> (Gr Point2 b, Map Point2 Int, Int) insertNodes pairset = runIdentity $ S.fold_ insertnode (Data.Graph.Inductive.empty,mempty,0) id nodestream