Commit before attempting to stream room generation

This commit is contained in:
2022-07-01 12:34:31 +01:00
parent 73e3353ba9
commit c42c2115a3
+13 -8
View File
@@ -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