packages feed

indexation 0.4.9 → 0.5

raw patch · 20 files changed

+114/−329 lines, 20 filesdep +hashtablesdep −bitvecdep −cereal-vectordep −contravariantdep ~basedep ~deferred-foldsdep ~potoki

Dependencies added: hashtables

Dependencies removed: bitvec, cereal-vector, contravariant, foldl, list-t, stm-containers, vector-algorithms

Dependency ranges changed: base, deferred-folds, potoki

Files

indexation.cabal view
@@ -1,5 +1,5 @@ name: indexation-version: 0.4.9+version: 0.5 category: Data synopsis: Tools for entity indexation description: A set of tools for indexing entities@@ -20,10 +20,7 @@   exposed-modules:     Indexation.Data     Indexation.IO-    Indexation.Predicate-    Indexation.Potoki.Produce     Indexation.Potoki.Transform-    Indexation.FoldM.Index   other-modules:     Indexation.Cereal.Get     Indexation.Cereal.Put@@ -32,30 +29,20 @@     Indexation.Instances.Cereal     Indexation.Prelude     Indexation.Types-    Indexation.Functions-    Indexation.FoldM.Basic-    Indexation.Utils.Vector-    Indexation.Utils.BitVector-    Indexation.Utils.Unfoldr+    Indexation.Vector   build-depends:-    base >=4.11 && <5,-    bitvec >=0.1.0.2 && <0.2,+    base >=4.7 && <5,     bytestring >=0.10.8 && <0.11,     cereal >=0.5.5 && <0.6,-    cereal-vector >=0.2.0.1 && <0.3,-    contravariant >=1.4 && <2,-    deferred-folds >=0.9 && <0.10,+    deferred-folds >=0.6 && <0.7,     focus >=1.0.1 && <1.1,-    foldl >=1 && <2,     hashable >=1 && <2,-    list-t >=1 && <1.1,+    hashtables >=1.2.3.1 && <1.3,     mmorph >=1 && <2,-    potoki >=2.0.15 && <2.1,+    potoki >=2 && <2.1,     potoki-cereal >=0.3 && <0.4,     profunctors >=5.2 && <6,-    stm-containers >=1.1 && <1.2,     text >=1 && <2,     transformers >=0.5 && <0.6,     unordered-containers >=0.2.9 && <0.3,-    vector >=0.12 && <0.13,-    vector-algorithms >=0.7.0.4 && <0.8+    vector >=0.12 && <0.13
library/Indexation/Cereal/Get.hs view
@@ -5,7 +5,7 @@ import Indexation.Types import Data.Serialize.Get import qualified Data.HashMap.Strict as A-import qualified Data.Vector.Generic as B+import qualified Data.Vector as B   getIndexHashMap :: (Eq k, Hashable k) => Get k -> Get (HashMap k Int)@@ -33,8 +33,7 @@           entity <- getEntity           return (A.insert entity index hashMap) -{-# INLINE getVector #-}-getVector :: B.Vector vector element => Get element -> Get (vector element)+getVector :: Get element -> Get (Vector element) getVector getElement =   getSize >>= getElements   where
library/Indexation/Cereal/Put.hs view
@@ -4,16 +4,15 @@ import Indexation.Prelude import Indexation.Types import Data.Serialize.Put-import qualified Data.Vector.Generic as B+import qualified Data.Vector as B  -{-# INLINE putVector #-}-putVector :: (B.Vector vector element) => Putter element -> Putter (vector element)+putVector :: Putter element -> Putter (Vector element) putVector putElement vector =   putSize *> putElements   where     putSize = putInt64le (fromIntegral (B.length vector))-    putElements = B.foldM'_ (const putElement) () vector+    putElements = traverse_ putElement vector  putEntityTable :: Putter entity -> Putter (EntityTable entity) putEntityTable putEntity (EntityTable vector) =
library/Indexation/Constructors/EntityTable.hs view
@@ -3,7 +3,7 @@  import Indexation.Prelude hiding (lookup) import Indexation.Types-import qualified Indexation.Utils.Vector as A+import qualified Indexation.Vector as A   indexTable :: IndexTable entity -> EntityTable entity
library/Indexation/Data.hs view
@@ -1,9 +1,25 @@ module Indexation.Data (-  module Exports,+  Index(..),+  EntityTable,+  IndexTable,+  Indexer,+  lookupEntity,+  lookupIndex, ) where -import Indexation.Types as Exports (Index(..), EntityTable, IndexTable, Indexer, IndexSet, IndexCounts)+import Indexation.Prelude+import Indexation.Types import Indexation.Instances ()-import Indexation.Functions as Exports+import qualified Data.Vector as Vector+import qualified Data.HashMap.Strict as HashMap+++lookupEntity :: Index entity -> EntityTable entity -> Maybe entity+lookupEntity (Index indexPrim) (EntityTable vector) =+  vector Vector.!? indexPrim++lookupIndex :: (Eq entity, Hashable entity) => entity -> IndexTable entity -> Maybe (Index entity)+lookupIndex entity (IndexTable _ hashMap) =+  fmap Index (HashMap.lookup entity hashMap)
− library/Indexation/FoldM/Basic.hs 
@@ -1,14 +0,0 @@-module Indexation.FoldM.Basic-where--import Indexation.Prelude-import Control.Foldl-import qualified Data.Vector.Unboxed as UnboxedVector-import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector---countIndices :: Int -> FoldM IO Int (UnboxedVector.Vector Word32)-countIndices amount = FoldM step init extract where-  init = MutableUnboxedVector.new amount-  step mv index = MutableUnboxedVector.modify mv succ index $> mv-  extract = UnboxedVector.unsafeFreeze
− library/Indexation/FoldM/Index.hs 
@@ -1,12 +0,0 @@-module Indexation.FoldM.Index-where--import Indexation.Prelude-import Indexation.Types-import Indexation.Data-import Control.Foldl-import qualified Indexation.FoldM.Basic as Basic---indexCounts :: Int -> FoldM IO (Index a) (IndexCounts a)-indexCounts amount = dimap (\ (Index x) -> x) IndexCounts (Basic.countIndices amount)
− library/Indexation/Functions.hs 
@@ -1,55 +0,0 @@-module Indexation.Functions-where--import Indexation.Prelude-import Indexation.Types-import qualified Data.Vector as Vector-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Vector.Unboxed as UnboxedVector-import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector-import qualified Data.Vector.Algorithms.Intro as IntroVectorAlgorithm-import qualified Data.Bit as Bit-import qualified Data.Vector.Unboxed.Bit as BitVec-import qualified Indexation.Utils.BitVector as UnboxedVector-import qualified Indexation.Utils.Unfoldr as Unfoldr---lookupEntity :: Index entity -> EntityTable entity -> Maybe entity-lookupEntity (Index indexPrim) (EntityTable vector) =-  vector Vector.!? indexPrim--lookupIndex :: (Eq entity, Hashable entity) => entity -> IndexTable entity -> Maybe (Index entity)-lookupIndex entity (IndexTable _ hashMap) =-  fmap Index (HashMap.lookup entity hashMap)--createIndexSet :: (Eq entity, Hashable entity, Foldable foldable) => IndexTable entity -> foldable entity -> IndexSet entity-createIndexSet (IndexTable size map) entities =-  IndexSet (UnboxedVector.filledIndicesFoldable size (Unfoldr.hashMapValuesByKeys entities map))--lookupInIndexSet :: Index entity -> IndexSet entity -> Bool-lookupInIndexSet (Index indexInt) (IndexSet vec) = vec UnboxedVector.!? indexInt & maybe False Bit.toBool--mergeIndexSets :: IndexSet entity -> IndexSet entity -> IndexSet entity-mergeIndexSets (IndexSet a) (IndexSet b) = IndexSet (BitVec.intersection a b)--topCountedIndexSet :: Int -> IndexCounts a -> IndexSet a-topCountedIndexSet amount (IndexCounts countVec) = let-  countVecLength = UnboxedVector.length countVec-  limitedAmount = min amount countVecLength-  in runST $ do-    pairMVec <- UnboxedVector.unsafeThaw (UnboxedVector.imap (\ index count -> (count, index)) countVec)-    IntroVectorAlgorithm.selectBy (\ a b -> compare (fst b) (fst a)) pairMVec limitedAmount-    indexSetMVec <- MutableUnboxedVector.new countVecLength-    forM_ [0..(pred limitedAmount)] $ \ pairIndex -> do-      (_, index) <- MutableUnboxedVector.unsafeRead pairMVec pairIndex-      MutableUnboxedVector.write indexSetMVec index (Bit.fromBool True)-    IndexSet <$> UnboxedVector.unsafeFreeze indexSetMVec--indexSetByMinCount :: Word32 -> IndexCounts a -> IndexSet a-indexSetByMinCount min (IndexCounts countVec) = IndexSet (UnboxedVector.map (Bit.fromBool . (>= min)) countVec)--countIndexSet :: IndexSet a -> Int-countIndexSet (IndexSet vec) = BitVec.countBits vec--invertIndexSet :: IndexSet a -> IndexSet a-invertIndexSet (IndexSet vec) = IndexSet (BitVec.invert vec)
library/Indexation/IO.hs view
@@ -22,26 +22,26 @@ import qualified Potoki.Cereal.Consume as PotokiConsume import qualified Potoki.Cereal.Produce as PotokiProduce import qualified Indexation.Potoki.Transform as PotokiTransform-import qualified Indexation.Utils.Vector as Vector-import qualified StmContainers.Map as StmMap+import qualified Indexation.Vector as Vector+import qualified Data.HashTable.IO as HashtablesIO import qualified Data.Serialize as Cereal import qualified Data.ByteString as ByteString   createIndexer :: IO (Indexer entity) createIndexer = do-  sizeVar <- newTVarIO 0-  map <- StmMap.newIO-  return (Indexer sizeVar map)+  sizeRef <- newIORef 0+  map <- HashtablesIO.new+  return (Indexer sizeRef map)  getIndexerSize :: Indexer entity -> IO Int-getIndexerSize (Indexer sizeVar _) = atomically (readTVar sizeVar)+getIndexerSize (Indexer sizeRef _) = readIORef sizeRef  freezeIndexerAsVector :: Indexer entity -> IO (Vector entity)-freezeIndexerAsVector (Indexer sizeVar map) =+freezeIndexerAsVector (Indexer sizeRef map) =   do-    size <- atomically (readTVar sizeVar)-    Vector.listTInIO size (hoist atomically (fmap swap (StmMap.listT map)))+    size <- readIORef sizeRef+    Vector.hashTable size map  freezeIndexerAsEntityTable :: Indexer entity -> IO (EntityTable entity) freezeIndexerAsEntityTable = fmap EntityTable . freezeIndexerAsVector
library/Indexation/Instances.hs view
@@ -4,14 +4,9 @@ import Indexation.Prelude import Indexation.Types import Indexation.Instances.Cereal ()-import Indexation.Functions-import qualified Data.Vector.Unboxed.Bit as BitVec   instance Show (Index a) where show (Index int) = show int deriving instance Eq (Index a) deriving instance Ord (Index a) deriving instance Hashable (Index a)--instance Show (IndexSet a) where-  show = show . BitVec.listBits . (\ (IndexSet x) -> x)
library/Indexation/Instances/Cereal.hs view
@@ -7,7 +7,6 @@ import qualified Indexation.Cereal.Get as Get import qualified Indexation.Cereal.Put as Put import qualified Indexation.Constructors.EntityTable as EntityTable-import qualified Data.Bit as Bit   instance Serialize (Index a) where@@ -21,9 +20,3 @@ instance (Serialize entity, Eq entity, Hashable entity) => Serialize (IndexTable entity) where   get = Get.getIndexTableAsEntityTable get   put = Put.putEntityTable put . EntityTable.indexTable--instance Serialize (IndexSet a) where-  get = IndexSet <$> Get.getVector (Bit.fromBool <$> get)-  put (IndexSet vector) = Put.putVector (put . Bit.toBool) vector--deriving instance Serialize (IndexCounts a)
− library/Indexation/Potoki/Produce.hs 
@@ -1,28 +0,0 @@-module Indexation.Potoki.Produce-(-  entities,-  counts,-  indexedCounts,-)-where--import Indexation.Prelude-import Indexation.Types-import qualified Potoki.Produce as Produce-import qualified Data.Vector.Generic as GenericVector---entities :: EntityTable a -> Produce a-entities (EntityTable vector) = Produce.vector vector--{-|-Counts in the index-order.--}-counts :: IndexCounts a -> Produce Word32-counts (IndexCounts vector) = Produce.vector vector--{-|-Counts in the index-order paired with their indices.--}-indexedCounts :: IndexCounts a -> Produce (Int, Word32)-indexedCounts (IndexCounts vector) = Produce.vectorWithIndices vector
library/Indexation/Potoki/Transform.hs view
@@ -14,25 +14,23 @@ import Indexation.Instances () import Potoki.Transform import qualified Focus-import qualified StmContainers.Map as StmMap+import qualified Data.HashTable.IO as HashtablesIO import qualified Data.Vector as Vector   index :: (Eq entity, Hashable entity) => Indexer entity -> Transform entity (Index entity)-index (Indexer sizeVar map) =-  {-# SCC "index" #-} -  mapInIO $ \ entity -> atomically $ StmMap.focus focus entity map+index (Indexer sizeRef map) =+  mapInIO $ \ entity -> HashtablesIO.mutateIO map entity mutation   where-    focus = Focus.Focus conceal reveal where-      conceal = do-        size <- readTVar sizeVar-        writeTVar sizeVar $! succ size-        return (Index size, Focus.Set size)-      reveal indexInt = return (Index indexInt, Focus.Leave)+    mutation = \ case+      Just indexInt -> return (Just indexInt, Index indexInt) +      Nothing -> do+        size <- readIORef sizeRef+        writeIORef sizeRef $! succ size+        return (Just size, Index size)  lookup :: EntityTable entity -> Transform (Index entity) (Maybe entity) lookup (EntityTable entityTableVector) =-  {-# SCC "lookup" #-}    arr $ \ (Index indexInt) -> if Vector.length entityTableVector > indexInt     then Just $! Vector.unsafeIndex entityTableVector indexInt     else Nothing
− library/Indexation/Predicate.hs 
@@ -1,16 +0,0 @@-module Indexation.Predicate-where--import Indexation.Prelude hiding (not)-import Indexation.Types-import Indexation.Instances ()-import qualified Indexation.Prelude as Prelude-import qualified Indexation.Utils.BitVector as UnboxedVector-import qualified Indexation.Functions as Functions---negated :: Predicate a -> Predicate a-negated (Predicate fn) = Predicate (Prelude.not . fn)--inIndexSet :: IndexSet a -> Predicate (Index a)-inIndexSet indexSet = Predicate (\ index -> Functions.lookupInIndexSet index indexSet)
library/Indexation/Prelude.hs view
@@ -1,8 +1,6 @@ module Indexation.Prelude (   module Exports,-  UnboxedVector,-  BitVector, ) where @@ -84,14 +82,8 @@  -- deferred-folds --------------------------import DeferredFolds.Unfoldl as Exports (Unfoldl(..))-import DeferredFolds.UnfoldlM as Exports (UnfoldlM(..))-import DeferredFolds.Unfoldr as Exports (Unfoldr(..))---- contravariant---------------------------import Data.Functor.Contravariant as Exports-import Data.Functor.Contravariant.Divisible as Exports+import DeferredFolds.Unfold as Exports (Unfold(..))+import DeferredFolds.UnfoldM as Exports (UnfoldM(..))  -- hashable -------------------------@@ -109,10 +101,6 @@ ------------------------- import Data.Serialize as Exports (Serialize) --- cereal-vector---------------------------import Data.Vector.Serialize ()- -- bytestring ------------------------- import Data.ByteString as Exports (ByteString)@@ -134,21 +122,3 @@ -- mmorph ------------------------- import Control.Monad.Morph as Exports hiding (MonadTrans(..))---- list-t---------------------------import ListT as Exports (ListT(..))---- bitvec---------------------------import Data.Bit as Exports (Bit)---- ---------------------------import qualified Data.Vector.Unboxed.Bit as BitVec-import qualified Data.Vector.Unboxed as UnboxedVector---type UnboxedVector = UnboxedVector.Vector--type BitVector = UnboxedVector Bit
library/Indexation/Types.hs view
@@ -2,23 +2,13 @@ where  import Indexation.Prelude-import qualified StmContainers.Map as StmMap-import qualified Data.Vector.Unboxed as UnboxedVector-import qualified Data.Vector.Unboxed.Bit as BitVec+import qualified Data.HashTable.IO as HashtablesIO  -data Indexer entity = Indexer {-# UNPACK #-} !(TVar Int) {-# UNPACK #-} !(StmMap.Map entity Int)+data Indexer entity = Indexer {-# UNPACK #-} !(IORef Int) {-# UNPACK #-} !(HashtablesIO.CuckooHashTable entity Int)  data IndexTable entity = IndexTable {-# UNPACK #-} !Int {-# UNPACK #-} !(HashMap entity Int)  newtype EntityTable entity = EntityTable (Vector entity)  newtype Index entity = Index Int--{-|-Set of indices.-A more efficient alternative to @HashSet (Index entity)@.--}-newtype IndexSet entity = IndexSet (BitVec.Vector BitVec.Bit)--newtype IndexCounts entity = IndexCounts (UnboxedVector.Vector Word32)
− library/Indexation/Utils/BitVector.hs 
@@ -1,15 +0,0 @@-module Indexation.Utils.BitVector-where--import Indexation.Prelude hiding (Vector)-import Data.Vector.Unboxed hiding (forM_)-import qualified Data.Vector.Unboxed.Mutable as MutableUnboxedVector-import qualified Data.Bit as Bit---filledIndicesFoldable :: Foldable foldable => Int -> foldable Int -> Vector Bit-filledIndicesFoldable size foldable = runST $ do-  mv <- MutableUnboxedVector.new size-  forM_ foldable $ \ index -> do-    MutableUnboxedVector.unsafeWrite mv index (Bit.fromBool True)-  unsafeFreeze mv
− library/Indexation/Utils/Unfoldr.hs 
@@ -1,21 +0,0 @@-module Indexation.Utils.Unfoldr-where--import Indexation.Prelude-import DeferredFolds.Unfoldr-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Vector.Unboxed.Bit as BitVec---hashMapAt :: (Hashable a, Eq a) => a -> HashMap a b -> Unfoldr b-hashMapAt a = foldable . HashMap.lookup a--hashMapValuesByKeys :: (Hashable a, Eq a, Foldable foldable) => foldable a -> HashMap a b -> Unfoldr b-hashMapValuesByKeys keys hashMap = do-  key <- foldable keys-  hashMapAt key hashMap--bitVecWords :: BitVector -> Unfoldr Word-bitVecWords vec = do-  index <- intsInRange 0 (pred (BitVec.wordLength vec))-  return (BitVec.indexWord vec index)
− library/Indexation/Utils/Vector.hs 
@@ -1,61 +0,0 @@-module Indexation.Utils.Vector-where--import Indexation.Prelude-import Data.Vector-import qualified Data.Vector.Mutable as MutableVector-import qualified Data.HashMap.Strict as HashMap-import qualified DeferredFolds.UnfoldlM as UnfoldlM-import qualified ListT---{-|-This function is not tested.--}-{-# NOINLINE populate #-}-populate :: Monad effect => Int -> effect (Int, element) -> effect (Vector element)-populate size effect =-  do-    mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))-    let-      loop stepsRemaining =-        if stepsRemaining > 0-          then do-            (index, element) <- effect-            () <- return (unsafeDupablePerformIO (MutableVector.write mv index element))-            loop (pred stepsRemaining)-          else do-            !v <- return (unsafeDupablePerformIO (freeze mv))-            return v-      in loop size--{-|-This function is partial. It doesn't check the size or indices.--}-{-# INLINE indexHashMapWithSize #-}-indexHashMapWithSize :: Int -> HashMap element Int -> Vector element-indexHashMapWithSize size hashMap =-  runST $ do-    mv <- MutableVector.new size-    HashMap.foldrWithKey-      (\ element index action -> MutableVector.write mv index element >> action)-      (return ())-      hashMap-    freeze mv--{-# NOINLINE unfoldlM #-}-unfoldlM :: Monad m => Int -> UnfoldlM m (Int, element) -> m (Vector element)-unfoldlM size unfoldlM =-  let-    step mv (index, element) = return (unsafeDupablePerformIO (MutableVector.write mv index element $> mv))-    in do-      !mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))-      UnfoldlM.foldlM' step mv unfoldlM-      !iv <- return (unsafeDupablePerformIO (unsafeFreeze mv))-      return iv--listTInIO :: Int -> ListT IO (Int, element) -> IO (Vector element)-listTInIO size listT = do-  mv <- MutableVector.unsafeNew size-  flip ListT.traverse_ listT $ \ (index, element) -> MutableVector.write mv index element-  unsafeFreeze mv
+ library/Indexation/Vector.hs view
@@ -0,0 +1,60 @@+module Indexation.Vector+where++import Indexation.Prelude+import Data.Vector+import qualified Data.Vector.Mutable as MutableVector+import qualified Data.HashMap.Strict as HashMap+import qualified DeferredFolds.UnfoldM as UnfoldM+import qualified Data.HashTable.IO as HashtablesIO+++{-|+This function is not tested.+-}+{-# NOINLINE populate #-}+populate :: Monad effect => Int -> effect (Int, element) -> effect (Vector element)+populate size effect =+  do+    mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))+    let+      loop stepsRemaining =+        if stepsRemaining > 0+          then do+            (index, element) <- effect+            () <- return (unsafeDupablePerformIO (MutableVector.write mv index element))+            loop (pred stepsRemaining)+          else do+            !v <- return (unsafeDupablePerformIO (freeze mv))+            return v+      in loop size++{-|+This function is partial. It doesn't check the size or indices.+-}+{-# INLINE indexHashMapWithSize #-}+indexHashMapWithSize :: Int -> HashMap element Int -> Vector element+indexHashMapWithSize size hashMap =+  unsafePerformIO $ do+    mv <- MutableVector.unsafeNew size+    let+      step () element index = unsafeDupablePerformIO (MutableVector.write mv index element)+      !() = HashMap.foldlWithKey' step () hashMap+      in freeze mv++{-# NOINLINE unfoldM #-}+unfoldM :: Monad m => Int -> UnfoldM m (Int, element) -> m (Vector element)+unfoldM size unfoldM =+  let+    step mv (index, element) = return (unsafeDupablePerformIO (MutableVector.write mv index element $> mv))+    in do+      !mv <- return (unsafeDupablePerformIO (MutableVector.unsafeNew size))+      UnfoldM.foldlM' step mv unfoldM+      !iv <- return (unsafeDupablePerformIO (unsafeFreeze mv))+      return iv++hashTable :: Int -> HashtablesIO.CuckooHashTable element Int -> IO (Vector element)+hashTable size hashTable = do+  mv <- MutableVector.unsafeNew size+  flip HashtablesIO.mapM_ hashTable $ \ (element, index) -> MutableVector.write mv index element+  unsafeFreeze mv