packages feed

edges 0.4.1 → 0.5

raw patch · 18 files changed

+298/−267 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Edges.Edges: data Edges source target
- Edges.Edges: genBipartiteWithLimits :: Int -> Int -> Gen (Edges a b, Edges b a)
- Edges.Edges: instance GHC.Classes.Eq (Edges.Types.Edges a b)
- Edges.Edges: instance GHC.Show.Show (Edges.Types.Edges a b)
- Edges.Edges: list :: [(Node a, Node b)] -> Edges a b
- Edges.Edges: listBipartite :: [(Node a, Node b)] -> (Edges a b, Edges b a)
- Edges.Edges: primListBipartite :: [(Int, Int)] -> (Edges a b, Edges b a)
- Edges.Edges: toAssocList :: Edges a b -> [(Node a, Node b)]
- Edges.Edges: toAssocUnfoldM :: Monad m => Edges a b -> UnfoldM m (Node a, Node b)
- Edges.Fold: edgeCounts :: Amount a -> Fold (Edge a b) (EdgeCounts a b)
- Edges.Fold: edges :: EdgeCounts a b -> Amount b -> Fold (Edge a b) (Edges a b)
- Edges.Node: Node :: Int -> Node entity
- Edges.Node: genWithLimit :: Int -> Gen (Node a)
- Edges.Node: instance GHC.Classes.Eq (Edges.Types.Node a)
- Edges.Node: instance GHC.Classes.Ord (Edges.Types.Node a)
- Edges.Node: instance GHC.Show.Show (Edges.Types.Node a)
- Edges.Node: newtype Node entity
- Edges.NodeCounts: data NodeCounts entity
- Edges.NodeCounts: instance GHC.Show.Show (Edges.Types.NodeCounts a)
- Edges.NodeCounts: node :: Edges entity anyEntity -> Node entity -> NodeCounts entity
- Edges.NodeCounts: nodeTargets :: Edges source target -> Node source -> NodeCounts target
- Edges.NodeCounts: targets :: Edges source target -> NodeCounts source -> NodeCounts target
- Edges.NodeCounts: toList :: NodeCounts entity -> [Word32]
- Edges.NodeCounts: toUnboxedVector :: NodeCounts entity -> Vector Word32
- Edges.Potoki.Produce: nodeCounts :: Edges a x -> (Node a -> NodeCounts b) -> Produce (Node a, NodeCounts b)
- Edges.Potoki.Produce: nodeCountsFromFile :: FilePath -> Produce (Either IOException (Either Text (Node a, NodeCounts b)))
- Edges.Potoki.Produce: nodes :: Edges a x -> Produce (Node a)
+ Edges.Data: Amount :: Int -> Amount entity
+ Edges.Data: Edge :: Int -> Word32 -> Edge source target
+ Edges.Data: Node :: Int -> Node entity
+ Edges.Data: data Edge source target
+ Edges.Data: data EdgeCounts source target
+ Edges.Data: data Edges source target
+ Edges.Data: data NodeCounts entity
+ Edges.Data: edgesList :: Edges a b -> [(Node a, Node b)]
+ Edges.Data: edgesSourceAmount :: Edges source x -> Amount source
+ Edges.Data: edgesTargetAmount :: Edges x target -> Amount target
+ Edges.Data: edgesUnfoldM :: Monad m => Edges a b -> UnfoldM m (Node a, Node b)
+ Edges.Data: listBipartiteEdges :: [(Node a, Node b)] -> (Edges a b, Edges b a)
+ Edges.Data: listEdges :: [(Node a, Node b)] -> Edges a b
+ Edges.Data: newtype Amount entity
+ Edges.Data: newtype Node entity
+ Edges.Data: nodeCountsList :: NodeCounts entity -> [Word32]
+ Edges.Data: nodeCountsUnboxedVector :: NodeCounts entity -> Vector Word32
+ Edges.Data: primFoldableWithAmountsEdges :: Foldable f => Int -> Int -> f (Int, Word32) -> Edges a b
+ Edges.Data: primListBipartiteEdges :: [(Int, Int)] -> (Edges a b, Edges b a)
+ Edges.Folds: edgeCounts :: Amount a -> Fold (Edge a b) (EdgeCounts a b)
+ Edges.Folds: edges :: EdgeCounts a b -> Amount b -> Fold (Edge a b) (Edges a b)
+ Edges.Gens: bipartiteEdgesWithLimits :: Int -> Int -> Gen (Edges a b, Edges b a)
+ Edges.Gens: nodeWithLimit :: Int -> Gen (Node a)
+ Edges.NodeCounting: data Amount entity
+ Edges.NodeCounting: data Edges source target
+ Edges.NodeCounting: data Node entity
+ Edges.NodeCounting: data NodeCounts entity
+ Edges.NodeCounting: node :: Edges source target -> Node source -> NodeCounts source
+ Edges.NodeCounting: nodeTargets :: Edges source target -> Node source -> NodeCounts target
+ Edges.NodeCounting: targets :: Edges source target -> NodeCounts source -> NodeCounts target
+ Edges.Potoki.Produces: nodeCounts :: Amount a -> (Node a -> NodeCounts b) -> Produce (Node a, NodeCounts b)
+ Edges.Potoki.Produces: readNodeCountsFromFile :: FilePath -> Produce (Either IOException (Either Text (Node a, NodeCounts b)))
+ Edges.Potoki.Produces: sourceNodes :: Amount a -> Produce (Node a)
+ Edges.Potoki.Transforms: executeNodeCountQuery :: (Node a -> NodeCounts b) -> Transform (Node a) (Node a, NodeCounts b)
- Edges.IO: encodeNodeCountsToFile :: FilePath -> Edges a x -> (Node a -> NodeCounts z) -> IO (Either IOException ())
+ Edges.IO: encodeNodeCountsToFile :: FilePath -> Amount a -> (Node a -> NodeCounts z) -> IO (Either IOException ())

Files

edges.cabal view
@@ -1,7 +1,7 @@ name:   edges version:-  0.4.1+  0.5 category:   Graphs synopsis:@@ -41,14 +41,17 @@   default-language:     Haskell2010   exposed-modules:-    Edges.Edges-    Edges.NodeCounts-    Edges.Node-    Edges.Potoki.Produce+    Edges.Data+    Edges.Folds+    Edges.NodeCounting+    Edges.Potoki.Produces+    Edges.Potoki.Transforms     Edges.IO-    Edges.Fold+    Edges.Gens   other-modules:-    Edges.Cereal.Instances+    Edges.Functions+    Edges.Instances+    Edges.Instances.Cereal     Edges.Cereal.Get     Edges.Cereal.Put     Edges.Prelude
− library/Edges/Cereal/Instances.hs 
@@ -1,21 +0,0 @@-module Edges.Cereal.Instances-where--import Edges.Prelude-import Edges.Types-import Data.Serialize-import qualified Edges.Cereal.Get as A-import qualified Edges.Cereal.Put as B---instance Serialize (Node a) where-  get = A.node-  put = B.node--instance Serialize (NodeCounts a) where-  get = A.nodeCounts-  put = B.nodeCounts--instance Serialize (Edges a b) where-  get = A.edges-  put = B.edges
+ library/Edges/Data.hs view
@@ -0,0 +1,16 @@+module Edges.Data+(+  Edges,+  Node(..),+  NodeCounts,+  Edge(..),+  EdgeCounts,+  Amount(..),+  module Functions,+)+where++import Edges.Prelude+import Edges.Types+import Edges.Instances+import Edges.Functions as Functions
− library/Edges/Edges.hs 
@@ -1,79 +0,0 @@-module Edges.Edges-(-  Edges,-  list,-  listBipartite,-  primListBipartite,-  toAssocUnfoldM,-  toAssocList,-  genBipartiteWithLimits,-)-where--import Edges.Prelude-import Edges.Types-import Edges.Cereal.Instances ()-import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray-import qualified Control.Foldl as Foldl-import qualified Control.Monad.Par as Par-import qualified DeferredFolds.UnfoldM as UnfoldM-import qualified Test.QuickCheck.Gen as Gen--deriving instance Eq (Edges a b)--deriving instance Show (Edges a b)--list :: [(Node a, Node b)] -> Edges a b-list list =-  Par.runPar $ do-    aSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum $ \ (Node x, _) -> x-    bSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum $ \ (_, Node x) -> x-    aToBPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (Node aInt, Node bInt) -> (aInt, fromIntegral bInt)-    aSize <- Par.get aSizeFuture-    bSize <- Par.get bSizeFuture-    aToBEdges <- primFoldableWithAmounts aSize bSize <$> Par.get aToBPrimFoldableFuture-    return aToBEdges--listBipartite :: [(Node a, Node b)] -> (Edges a b, Edges b a)-listBipartite = coerce primListBipartite--primListBipartite :: [(Int, Int)] -> (Edges a b, Edges b a)-primListBipartite list =-  Par.runPar $ do-    aSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum fst-    bSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum snd-    aToBPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (aInt, bInt) -> (aInt, fromIntegral bInt)-    bToAPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (aInt, bInt) -> (bInt, fromIntegral aInt)-    aSize <- Par.get aSizeFuture-    bSize <- Par.get bSizeFuture-    aToBEdgesFuture <- Par.spawn_ $ primFoldableWithAmounts aSize bSize <$> Par.get aToBPrimFoldableFuture-    bToAEdgesFuture <- Par.spawn_ $ primFoldableWithAmounts bSize aSize <$> Par.get bToAPrimFoldableFuture-    aToBEdges <- Par.get aToBEdgesFuture-    bToAEdges <- Par.get bToAEdgesFuture-    return (aToBEdges, bToAEdges)--primFoldableWithAmounts :: Foldable f => Int -> Int -> f (Int, Word32) -> Edges a b-primFoldableWithAmounts aAmount bAmount foldable =-  Edges bAmount $ runIdentity $ PrimMultiArray.create aAmount $ \ fold ->-  Identity $ Foldl.fold fold foldable--toAssocUnfoldM :: Monad m => Edges a b -> UnfoldM m (Node a, Node b)-toAssocUnfoldM (Edges _ mpa) =-  fmap (\ (aInt, bWord32) -> (Node aInt, Node (fromIntegral bWord32))) $-  PrimMultiArray.toAssocsUnfoldM mpa--toAssocList :: Edges a b -> [(Node a, Node b)]-toAssocList edges =-  UnfoldM.fold Foldl.list (toAssocUnfoldM edges)--genBipartiteWithLimits :: Int -> Int -> Gen.Gen (Edges a b, Edges b a)-genBipartiteWithLimits nodeLimit edgeLimit =-  do-    aMaxIndex <- Gen.choose (0, pred nodeLimit)-    bMaxIndex <- Gen.choose (0, pred nodeLimit)-    edgesAmount <- Gen.choose (0, edgeLimit)-    if aMaxIndex == 0 || bMaxIndex == 0-      then return (primListBipartite [])-      else do-        edges <- replicateM edgesAmount $ (,) <$> Gen.choose (0, aMaxIndex) <*> Gen.choose (0, bMaxIndex)-        return (primListBipartite edges)
− library/Edges/Fold.hs 
@@ -1,22 +0,0 @@-module Edges.Fold-where--import Edges.Prelude-import Edges.Types-import Edges.Node ()-import Edges.NodeCounts ()-import qualified PrimitiveExtras.PrimArray as PrimArray-import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray---edgeCounts :: Amount a -> Fold (Edge a b) (EdgeCounts a b)-edgeCounts (Amount amountInt) =-  dimap edgeSourceIndex EdgeCounts (PrimArray.indexCountsFold amountInt)-  where-    edgeSourceIndex (Edge sourceIndex _) = sourceIndex--edges :: EdgeCounts a b -> Amount b -> Fold (Edge a b) (Edges a b)-edges (EdgeCounts edgeCountsPrimArray) (Amount bAmountInt) =-  dimap edgePair (Edges bAmountInt) (PrimMultiArray.fold edgeCountsPrimArray)-  where-    edgePair (Edge sourceIndex targetIndex) = (sourceIndex, targetIndex)
+ library/Edges/Folds.hs view
@@ -0,0 +1,21 @@+module Edges.Folds+where++import Edges.Prelude+import Edges.Types+import Edges.Data+import qualified PrimitiveExtras.PrimArray as PrimArray+import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray+++edgeCounts :: Amount a -> Fold (Edge a b) (EdgeCounts a b)+edgeCounts (Amount amountInt) =+  dimap edgeSourceIndex EdgeCounts (PrimArray.indexCountsFold amountInt)+  where+    edgeSourceIndex (Edge sourceIndex _) = sourceIndex++edges :: EdgeCounts a b -> Amount b -> Fold (Edge a b) (Edges a b)+edges (EdgeCounts edgeCountsPrimArray) (Amount bAmountInt) =+  dimap edgePair (Edges bAmountInt) (PrimMultiArray.fold edgeCountsPrimArray)+  where+    edgePair (Edge sourceIndex targetIndex) = (sourceIndex, targetIndex)
+ library/Edges/Functions.hs view
@@ -0,0 +1,67 @@+module Edges.Functions+where++import Edges.Prelude+import Edges.Types+import qualified Data.Vector.Unboxed as UnboxedVector+import qualified DeferredFolds.UnfoldM as UnfoldM+import qualified Control.Foldl as Foldl+import qualified Control.Monad.Par as Par+import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray+import qualified PrimitiveExtras.PrimArray as PrimArray+++edgesSourceAmount :: Edges source x -> Amount source+edgesSourceAmount (Edges _ pma) = Amount (PrimMultiArray.outerLength pma)++edgesTargetAmount :: Edges x target -> Amount target+edgesTargetAmount (Edges amount _) = Amount amount++edgesUnfoldM :: Monad m => Edges a b -> UnfoldM m (Node a, Node b)+edgesUnfoldM (Edges _ mpa) =+  fmap (\ (aInt, bWord32) -> (Node aInt, Node (fromIntegral bWord32))) $+  PrimMultiArray.toAssocsUnfoldM mpa++edgesList :: Edges a b -> [(Node a, Node b)]+edgesList edges =+  UnfoldM.fold Foldl.list (edgesUnfoldM edges)++listEdges :: [(Node a, Node b)] -> Edges a b+listEdges list =+  Par.runPar $ do+    aSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum $ \ (Node x, _) -> x+    bSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum $ \ (_, Node x) -> x+    aToBPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (Node aInt, Node bInt) -> (aInt, fromIntegral bInt)+    aSize <- Par.get aSizeFuture+    bSize <- Par.get bSizeFuture+    aToBEdges <- primFoldableWithAmountsEdges aSize bSize <$> Par.get aToBPrimFoldableFuture+    return aToBEdges++listBipartiteEdges :: [(Node a, Node b)] -> (Edges a b, Edges b a)+listBipartiteEdges = coerce primListBipartiteEdges++primListBipartiteEdges :: [(Int, Int)] -> (Edges a b, Edges b a)+primListBipartiteEdges list =+  Par.runPar $ do+    aSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum fst+    bSizeFuture <- Par.spawnP $ succ $ fromMaybe 0 $ flip Foldl.fold list $ flip lmap Foldl.maximum snd+    aToBPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (aInt, bInt) -> (aInt, fromIntegral bInt)+    bToAPrimFoldableFuture <- Par.spawnP $ flip fmap list $ \ (aInt, bInt) -> (bInt, fromIntegral aInt)+    aSize <- Par.get aSizeFuture+    bSize <- Par.get bSizeFuture+    aToBEdgesFuture <- Par.spawn_ $ primFoldableWithAmountsEdges aSize bSize <$> Par.get aToBPrimFoldableFuture+    bToAEdgesFuture <- Par.spawn_ $ primFoldableWithAmountsEdges bSize aSize <$> Par.get bToAPrimFoldableFuture+    aToBEdges <- Par.get aToBEdgesFuture+    bToAEdges <- Par.get bToAEdgesFuture+    return (aToBEdges, bToAEdges)++primFoldableWithAmountsEdges :: Foldable f => Int -> Int -> f (Int, Word32) -> Edges a b+primFoldableWithAmountsEdges aAmount bAmount foldable =+  Edges bAmount $ runIdentity $ PrimMultiArray.create aAmount $ \ fold ->+  Identity $ Foldl.fold fold foldable++nodeCountsList :: NodeCounts entity -> [Word32]+nodeCountsList (NodeCounts pa) = foldrPrimArray' (:) [] pa++nodeCountsUnboxedVector :: NodeCounts entity -> UnboxedVector.Vector Word32+nodeCountsUnboxedVector (NodeCounts pa) = PrimArray.toUnboxedVector pa
+ library/Edges/Gens.hs view
@@ -0,0 +1,22 @@+module Edges.Gens+where++import Edges.Prelude hiding (choose)+import Edges.Data+import Test.QuickCheck.Gen+++nodeWithLimit :: Int -> Gen (Node a)+nodeWithLimit max = Node <$> choose (0, max)++bipartiteEdgesWithLimits :: Int -> Int -> Gen (Edges a b, Edges b a)+bipartiteEdgesWithLimits nodeLimit edgeLimit =+  do+    aMaxIndex <- choose (0, pred nodeLimit)+    bMaxIndex <- choose (0, pred nodeLimit)+    edgesAmount <- choose (0, edgeLimit)+    if aMaxIndex == 0 || bMaxIndex == 0+      then return (primListBipartiteEdges [])+      else do+        edges <- replicateM edgesAmount $ (,) <$> choose (0, aMaxIndex) <*> choose (0, bMaxIndex)+        return (primListBipartiteEdges edges)
library/Edges/IO.hs view
@@ -2,17 +2,14 @@ where  import Edges.Prelude-import Edges.Types-import Edges.Node ()-import Edges.NodeCounts ()+import Edges.Data import Potoki.IO-import qualified Edges.Potoki.Produce as A-import qualified Potoki.Transform as B+import qualified Edges.Potoki.Produces as A import qualified Potoki.Cereal.Consume as C  -encodeNodeCountsToFile :: FilePath -> Edges a x -> (Node a -> NodeCounts z) -> IO (Either IOException ())-encodeNodeCountsToFile file edges nodeCounts =+encodeNodeCountsToFile :: FilePath -> Amount a -> (Node a -> NodeCounts z) -> IO (Either IOException ())+encodeNodeCountsToFile file amount nodeCounts =   produceAndConsume-    (A.nodeCounts edges nodeCounts)+    (A.nodeCounts amount nodeCounts)     (C.encodeToFile file)
+ library/Edges/Instances.hs view
@@ -0,0 +1,17 @@+module Edges.Instances+where++import Edges.Prelude+import Edges.Types+import Edges.Functions+import Edges.Instances.Cereal ()+++deriving instance Eq (Node a)+deriving instance Eq (Edges a b)++deriving instance Ord (Node a)++instance Show (Node a) where show (Node int) = show int+instance Show (NodeCounts a) where show = show . nodeCountsList+deriving instance Show (Edges a b)
+ library/Edges/Instances/Cereal.hs view
@@ -0,0 +1,21 @@+module Edges.Instances.Cereal+where++import Edges.Prelude+import Edges.Types+import Data.Serialize+import qualified Edges.Cereal.Get as A+import qualified Edges.Cereal.Put as B+++instance Serialize (Node a) where+  get = A.node+  put = B.node++instance Serialize (NodeCounts a) where+  get = A.nodeCounts+  put = B.nodeCounts++instance Serialize (Edges a b) where+  get = A.edges+  put = B.edges
− library/Edges/Node.hs 
@@ -1,21 +0,0 @@-module Edges.Node-(-  Node(..),-  genWithLimit,-)-where--import Edges.Prelude-import Edges.Types-import Edges.Cereal.Instances ()-import qualified Test.QuickCheck.Gen as Gen--instance Show (Node a) where-  show (Node int) = show int--deriving instance Eq (Node a)--deriving instance Ord (Node a)--genWithLimit :: Int -> Gen.Gen (Node a)-genWithLimit max = Node <$> Gen.choose (0, max)
+ library/Edges/NodeCounting.hs view
@@ -0,0 +1,58 @@+module Edges.NodeCounting+(+  NodeCounts,+  Node,+  Amount,+  Edges,+  node,+  nodeTargets,+  targets,+)+where++import Edges.Prelude hiding (index, toList)+import Edges.Types+import Edges.Functions+import Edges.Instances ()+import qualified PrimitiveExtras.PrimArray as PrimArray+import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray+import qualified PrimitiveExtras.TVarArray as TVarArray+import qualified DeferredFolds.UnfoldM as UnfoldM+import qualified Data.Vector.Unboxed as UnboxedVector+import qualified Control.Monad.Par.IO as Par+import qualified Control.Monad.Par as Par hiding (runParIO)+++node :: Edges source target -> Node source -> NodeCounts source+node edges = +  nodeWithAmount (edgesSourceAmount edges)++nodeWithAmount :: Amount entity -> Node entity -> NodeCounts entity+nodeWithAmount (Amount size) (Node index) =+  NodeCounts (PrimArray.oneHot size index 1)++nodeTargets :: Edges source target -> Node source -> NodeCounts target+nodeTargets (Edges targetAmount edgesPma) (Node sourceIndex) =+  let indexUnfold = fmap fromIntegral (PrimMultiArray.toUnfoldAtM edgesPma sourceIndex)+      indexFold = PrimArray.indexCountsFold targetAmount+      countPa = UnfoldM.fold indexFold indexUnfold+      in NodeCounts countPa++{-|+Count the occurrences of targets based on the occurrences of sources.++Utilizes concurrency.+-}+targets :: Edges source target -> NodeCounts source -> NodeCounts target+targets (Edges targetAmount edgesPma) (NodeCounts sourceCountsPa) =+  unsafePerformIO $ Par.runParIO $ do+    targetCountVarTable <- liftIO (TVarArray.new 0 targetAmount)+    Par.parFor (Par.InclusiveRange 0 (pred (sizeofPrimArray sourceCountsPa))) $ \ sourceIndex ->+      case indexPrimArray sourceCountsPa sourceIndex of+        0 -> return ()+        sourceCount ->+          liftIO $+          UnfoldM.forM_ (PrimMultiArray.toUnfoldAtM edgesPma sourceIndex) $ \ targetIndex ->+          TVarArray.modifyAt targetCountVarTable (fromIntegral targetIndex) (+ sourceCount)+    targetCountsPa <- liftIO (TVarArray.freezeAsPrimArray targetCountVarTable)+    return (NodeCounts targetCountsPa)
− library/Edges/NodeCounts.hs 
@@ -1,66 +0,0 @@-module Edges.NodeCounts-(-  NodeCounts,-  node,-  nodeTargets,-  targets,-  toList,-  toUnboxedVector,-)-where--import Edges.Prelude hiding (index, toList)-import Edges.Types-import Edges.Cereal.Instances ()-import qualified PrimitiveExtras.PrimArray as PrimArray-import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray-import qualified PrimitiveExtras.TVarArray as TVarArray-import qualified DeferredFolds.UnfoldM as UnfoldM-import qualified Data.Vector.Unboxed as UnboxedVector-import qualified Control.Monad.Par.IO as Par-import qualified Control.Monad.Par as Par hiding (runParIO)---instance Show (NodeCounts a) where-  show = show . toList--node :: Edges entity anyEntity -> Node entity -> NodeCounts entity-node (Edges _ edgesPma) =-  let size = PrimMultiArray.outerLength edgesPma-      in nodeWithSize size--nodeWithSize :: Int -> Node entity -> NodeCounts entity-nodeWithSize size (Node index) =-  NodeCounts (PrimArray.oneHot size index 1)--nodeTargets :: Edges source target -> Node source -> NodeCounts target-nodeTargets (Edges targetAmount edgesPma) (Node sourceIndex) =-  let indexUnfold = fmap fromIntegral (PrimMultiArray.toUnfoldAtM edgesPma sourceIndex)-      indexFold = PrimArray.indexCountsFold targetAmount-      countPa = UnfoldM.fold indexFold indexUnfold-      in NodeCounts countPa--{-|-Count the occurrences of targets based on the occurrences of sources.--Utilizes concurrency.--}-targets :: Edges source target -> NodeCounts source -> NodeCounts target-targets (Edges targetAmount edgesPma) (NodeCounts sourceCountsPa) =-  unsafePerformIO $ Par.runParIO $ do-    targetCountVarTable <- liftIO (TVarArray.new 0 targetAmount)-    Par.parFor (Par.InclusiveRange 0 (pred (sizeofPrimArray sourceCountsPa))) $ \ sourceIndex ->-      case indexPrimArray sourceCountsPa sourceIndex of-        0 -> return ()-        sourceCount ->-          liftIO $-          UnfoldM.forM_ (PrimMultiArray.toUnfoldAtM edgesPma sourceIndex) $ \ targetIndex ->-          TVarArray.modifyAt targetCountVarTable (fromIntegral targetIndex) (+ sourceCount)-    targetCountsPa <- liftIO (TVarArray.freezeAsPrimArray targetCountVarTable)-    return (NodeCounts targetCountsPa)--toList :: NodeCounts entity -> [Word32]-toList (NodeCounts pa) = foldrPrimArray' (:) [] pa--toUnboxedVector :: NodeCounts entity -> UnboxedVector.Vector Word32-toUnboxedVector (NodeCounts pa) = PrimArray.toUnboxedVector pa
− library/Edges/Potoki/Produce.hs 
@@ -1,25 +0,0 @@-module Edges.Potoki.Produce-where--import Edges.Prelude-import Edges.Types-import Edges.NodeCounts ()-import Potoki.Produce-import qualified PrimitiveExtras.PrimMultiArray as PrimMultiArray-import qualified Potoki.Transform as B-import qualified Potoki.Cereal.Produce as C---nodes :: Edges a x -> Produce (Node a)-nodes (Edges _ pma) =-  coerce $-  enumInRange 0 (pred (PrimMultiArray.outerLength pma))--nodeCounts :: Edges a x -> (Node a -> NodeCounts b) -> Produce (Node a, NodeCounts b)-nodeCounts edges nodeCounts =-  transform (B.concurrently numCapabilities (arr (\ node -> case nodeCounts node of x -> (node, x)))) $-  nodes edges--nodeCountsFromFile :: FilePath -> Produce (Either IOException (Either Text (Node a, NodeCounts b)))-nodeCountsFromFile file =-  C.fileDecoded file
+ library/Edges/Potoki/Produces.hs view
@@ -0,0 +1,27 @@+module Edges.Potoki.Produces+where++import Edges.Prelude+import Edges.Types+import Edges.Instances+import Potoki.Produce+import qualified Potoki.Cereal.Produce as Produce+import qualified Edges.Potoki.Transforms as Transforms+++{-|+Enumerate nodes.+-}+sourceNodes :: Amount a -> Produce (Node a)+sourceNodes (Amount amountInt) = coerce (enumInRange 0 (pred amountInt))++{-|+Node counts paired with the source nodes.+-}+nodeCounts :: Amount a -> (Node a -> NodeCounts b) -> Produce (Node a, NodeCounts b)+nodeCounts amount nodeCounts =+  transform (Transforms.executeNodeCountQuery nodeCounts) (sourceNodes amount)++readNodeCountsFromFile :: FilePath -> Produce (Either IOException (Either Text (Node a, NodeCounts b)))+readNodeCountsFromFile file =+  Produce.fileDecoded file
+ library/Edges/Potoki/Transforms.hs view
@@ -0,0 +1,15 @@+module Edges.Potoki.Transforms+where++import Edges.Prelude+import Edges.Types+import Edges.Instances+import Potoki.Transform+++{-|+Node counts paired with the source nodes.+-}+executeNodeCountQuery :: (Node a -> NodeCounts b) -> Transform (Node a) (Node a, NodeCounts b)+executeNodeCountQuery nodeCounts =+  concurrently numCapabilities (arr (\ node -> case nodeCounts node of x -> (node, x)))
test/Main.hs view
@@ -7,10 +7,11 @@ import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck-import qualified Edges.Edges as A-import qualified Edges.NodeCounts as B-import qualified Edges.Node as C-import qualified Data.Serialize as D+import Edges.Data+import qualified Edges.NodeCounting as NodeCounting+import qualified Edges.Data as Data+import qualified Edges.Gens as Gens+import qualified Data.Serialize as Cereal   main =@@ -18,9 +19,9 @@   testGroup "All tests" $   [     testGroup "Predefined bipartite" $ let-      edgeList :: [(C.Node (Proxy 1), C.Node (Proxy 2))]+      edgeList :: [(Node (Proxy 1), Node (Proxy 2))]       edgeList =-        fmap (bimap C.Node C.Node) $+        fmap (bimap Node Node) $         [           (0, 0),           (0, 1),@@ -29,40 +30,40 @@           (1, 1),           (2, 0)         ]-      (edges1, edges2) = A.listBipartite edgeList+      (edges1, edges2) = Data.listBipartiteEdges edgeList       in         [           testCase "Constructs the forward edges correctly" $ let-            reconstructedEdgeList = A.toAssocList edges1+            reconstructedEdgeList = Data.edgesList edges1             in assertEqual (show reconstructedEdgeList) edgeList reconstructedEdgeList           ,           testCase "Constructs the backward edges correctly" $ let-            reconstructedEdgeList = sort $ A.toAssocList edges2+            reconstructedEdgeList = sort $ Data.edgesList edges2             expectedEdgeList = sort $ fmap swap edgeList             in assertEqual (show reconstructedEdgeList) expectedEdgeList reconstructedEdgeList           ,           testGroup "Counting at depth" $ let-            node = C.Node 1 :: C.Node (Proxy 1)+            node = Node 1 :: Node (Proxy 1)             in               [-                testCase "0" $ let-                  nodeCountsList = B.node edges1 node & B.toList+                testCase "0, unoptimized" $ let+                  nodeCountsList = NodeCounting.node edges1 node & Data.nodeCountsList                   in assertEqual (show nodeCountsList) [0, 1, 0] nodeCountsList                 ,                 testCase "1, unoptimized" $ let-                  nodeCountsList = B.node edges1 node & B.targets edges1 & B.toList+                  nodeCountsList = NodeCounting.node edges1 node & NodeCounting.targets edges1 & Data.nodeCountsList                   in assertEqual (show nodeCountsList) [1, 1, 0] nodeCountsList                 ,                 testCase "1" $ let-                  nodeCountsList = B.nodeTargets edges1 node & B.toList+                  nodeCountsList = NodeCounting.nodeTargets edges1 node & Data.nodeCountsList                   in assertEqual (show nodeCountsList) [1, 1, 0] nodeCountsList                 ,                 testCase "2" $ let-                  nodeCountsList = B.nodeTargets edges1 node & B.targets edges2 & B.toList+                  nodeCountsList = NodeCounting.nodeTargets edges1 node & NodeCounting.targets edges2 & Data.nodeCountsList                   in assertEqual (show nodeCountsList) [2, 2, 1] nodeCountsList                 ,                 testCase "3" $ let-                  nodeCountsList = B.nodeTargets edges1 node & B.targets edges2 & B.targets edges1 & B.toList+                  nodeCountsList = NodeCounting.nodeTargets edges1 node & NodeCounting.targets edges2 & NodeCounting.targets edges1 & Data.nodeCountsList                   in                     {-                     [0, 1]@@ -74,6 +75,6 @@               ]         ]     ,-    testProperty "Encoding/decoding with Cereal" $ forAll (A.genBipartiteWithLimits 10 20) $ \ (edges1, edges2) ->-    D.decode (D.encode edges1) === Right edges1+    testProperty "Encoding/decoding with Cereal" $ forAll (Gens.bipartiteEdgesWithLimits 10 20) $ \ (edges1, edges2) ->+    Cereal.decode (Cereal.encode edges1) === Right edges1   ]