circular 0.3.0 → 0.3.1

raw patch · 5 files changed

+104/−57 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• bench/Bench.hs +2/−2
• circular.cabal +1/−1
• src/Data/Stack/Circular.hs +54/−47
• test/Data/Stack/CircularSpec.hs +41/−7

@@ -5,6 +5,12 @@ ## Unreleased changes  +## 0.3.1++-   Change monadic folds so that commutativity is not anymore required.+-   Provide `foldKM`, a fold over the last k elements on the stack.++ ## 0.3.0  -   Bugfix `take`.

@@ -30,13 +30,13 @@ cstackV l = runST $ do   c <- C.replicate 1000 0 :: ST s (C.MStack V.Vector s Int)   c' <- foldlM (flip C.push) c [0 .. l]-  C.sum c'+  C.foldM (+) 0 c'  cstackU :: Int -> Int cstackU l = runST $ do   c <- C.replicate 1000 0 :: ST s (C.MStack U.Vector s Int)   c' <- foldlM (flip C.push) c [0 .. l]-  C.sum c'+  C.foldM (+) 0 c'  -- When using foldr, cstack is slower by far. This is because list are lazy. 

@@ -1,6 +1,6 @@ cabal-version:  1.12 name:           circular-version:        0.3.0+version:        0.3.1 synopsis:       Circular fixed-sized mutable vectors description:    Please see the README at <https://github.com/dschrempf/circular#readme> category:       Math, Data Structures

@@ -37,14 +37,9 @@     pop,     push, -    -- ** Folds--    -- | __Commutativity__ of the combining function is __assumed__ for-    -- fold-like functions provided in this module, that is, the order of-    -- elements of the stack must not matter!-    foldl,-    sum,-    product,+    -- ** Monadic folds+    foldM,+    foldKM,      -- * Immutable circular stacks     Stack (..),@@ -56,7 +51,6 @@ import Control.Monad.Primitive import Data.Aeson import Data.Aeson.TH-import qualified Data.Foldable as F import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Mutable as VM import Prelude hiding (foldl, product, replicate, sum, take)@@ -64,7 +58,7 @@ -- | Mutable circular stacks with fixed size are just mutable vectors with a -- pointer to the last element. data MStack v s a = MStack-  { mStack :: VG.Mutable v s a,+  { mVector :: VG.Mutable v s a,     mIndex :: !Int   } @@ -81,9 +75,8 @@     return $ MStack v 0  -- | Convert a vector to a circular stack with size being equal to the length of--- the vector. The first element of the vector is the deepest (oldest) element--- of the stack, the last element of the vector is the current (newest) element--- of the stack.+-- the vector. The first element of the vector is the oldest element of the+-- stack, the last element of the vector is the youngest element of the stack. -- -- The vector must be non-empty. --@@ -98,8 +91,8 @@     n = VG.length v  -- | Convert a circular stack to a vector. The first element of the returned--- vector is the deepest (oldest) element of the stack, the last element of the--- returned vector is the current (newest) element of the stack.+-- vector is the oldest element of the stack, the last element of the returned+-- vector is the youngest element of the stack. -- -- O(n). toVector :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (v a)@@ -107,12 +100,12 @@   l <- VG.freeze $ VM.unsafeDrop i' v   r <- VG.freeze $ VM.unsafeTake i' v   return $ l VG.++ r-  where i' = i+1+  where+    i' = i + 1  -- | Convert the last k elements of a circular stack to a vector. The first--- element of the returned vector is the deepest (oldest) element of the stack,--- the last element of the returned vector is the current (newest) element of--- the stack.+-- element of the returned vector is the oldest element of the stack, the last+-- element of the returned vector is the youngest element of the stack. -- -- The size of the stack must be larger than k. --@@ -130,7 +123,7 @@     -- The length of r is i'.     r <- VG.freeze $ VM.unsafeTake i' v     -- The length of l has to be k-i'. So we have to drop n-(k-i')=n+i0.-    l <- VG.freeze $ VM.unsafeDrop (n+i0) v+    l <- VG.freeze $ VM.unsafeDrop (n + i0) v     return $ l VG.++ r   where     n = VM.length v@@ -145,14 +138,14 @@ get (MStack v i) = VM.unsafeRead v i {-# INLINE get #-} --- Select the previous element without changing the stack.+-- Select the previous older element without changing the stack. previous :: VG.Vector v a => MStack v s a -> MStack v s a previous (MStack v i) = MStack v i'   where     j = i - 1     i' = if j < 0 then VM.length v - 1 else j --- | Pop the current element from the stack and put the focus on the previous+-- | Pop the youngest element from the stack and put the focus on the previous -- element. -- -- Be careful:@@ -170,11 +163,11 @@   val <- get x   return (val, previous x) --- Replace the current element.+-- Replace the youngest element. put :: (VG.Vector v a, PrimMonad m) => a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a) put x (MStack v i) = VM.unsafeWrite v i x >> return (MStack v i) --- Select the next element without changing the stack.+-- Select the next younger element without changing the stack. next :: VG.Vector v a => MStack v s a -> MStack v s a next (MStack v i) = MStack v i'   where@@ -186,35 +179,49 @@ push :: (VG.Vector v a, PrimMonad m) => a -> MStack v (PrimState m) a -> m (MStack v (PrimState m) a) push x = put x . next --- Left fold over a mutable vector. This is all a little stupid.-foldlMV :: (VM.MVector v b, PrimMonad m) => (a -> b -> a) -> a -> v (PrimState m) b -> m a-foldlMV f x v = F.foldlM (\acc i -> f acc <$> VM.unsafeRead v i) x [0 .. (n -1)]-  where-    n = VM.length v---- | Left fold over all elements of the stack.+-- | Monadic fold from young to old over all elements of the stack. ----- Please see the documentation of 'pop'.+-- Please also see the documentation of 'pop'. -- -- O(n).-foldl :: (VG.Vector v b, PrimMonad m) => (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a-foldl f x (MStack v _) = foldlMV f x v+foldM :: (VG.Vector v b, PrimMonad m) => (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a+foldM f x s = foldKM n f x s+  where n = VM.length $ mVector s --- | Compute the sum of the elements on the stack.------ Please see the documentation of 'pop'.------ O(n).-sum :: (Num a, VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a-sum = foldl (+) 0+-- Monadic fold over k elements in a vector.+foldKV ::+  (VM.MVector v b, PrimMonad m) =>+  -- Number of elements to take.+  Int ->+  -- Current index.+  Int ->+  (a -> b -> a) ->+  a ->+  v (PrimState m) b ->+  m a+foldKV 0 _ _ x _ = return x+foldKV k i f x v = do+  x' <- f x <$> VM.unsafeRead v i+  -- Assume that i-1 is non-negative.+  foldKV (k-1) (i-1) f x' v --- | Compute the product of the elements on the stack.------ Please see the documentation of 'pop'.+-- | See 'foldM' but only over the @k@ youngest elements on the stack. ----- O(n).-product :: (Num a, VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a-product = foldl (*) 1+-- O(k).+foldKM :: (VG.Vector v b, PrimMonad m) => Int -> (a -> b -> a) -> a -> MStack v (PrimState m) b -> m a+foldKM k f x (MStack v i)+  | k < 0 = error "foldKM: k is negative."+  | k > n = error "foldKM: k is larger than the stack size."+  -- We can do the fold in one go.+  | k <= i' = foldKV k i f x v+  -- Or not.+  | otherwise = do+      x' <- foldKV i' i f x v+      -- Continue from the end of the vector.+      foldKV (k-i') (n-1) f x' v+  where+    n = VM.length v+    i' = i+1  -- | Immutable circular stack; useful, for example, to save, or restore a -- mutable circular stack.

@@ -23,6 +23,7 @@ import Control.Monad.Primitive import Control.Monad.ST import Data.Aeson+import Data.List import qualified Data.Stack.Circular as C import qualified Data.Vector as VB -- import Debug.Trace@@ -46,6 +47,12 @@ ss :: PrimMonad m => m (C.MStack VB.Vector (PrimState m) Int) ss = se >>= C.push 13 +s3 :: PrimMonad m => m (C.MStack VB.Vector (PrimState m) Int)+s3 = ss >>= C.push 12 >>= C.push 11++s3' :: PrimMonad m => m (C.MStack VB.Vector (PrimState m) Int)+s3' = se >>= (fmap snd <$> C.pop) >>= C.push 1 >>= C.push 2 >>= C.push 3+ fromTo :: VB.Vector Int -> VB.Vector Int fromTo v = runST $ C.fromVector v >>= C.toVector @@ -63,7 +70,7 @@ prop_push x v   | VB.length v == 0 = True   | otherwise =-    (runST $ C.fromVector v >>= C.push x >>= C.toVector)+    runST (C.fromVector v >>= C.push x >>= C.toVector)       == VB.tail v VB.++ VB.singleton x  prop_many_pushes :: [Int] -> VB.Vector Int -> Bool@@ -71,11 +78,12 @@   | VB.length v == 0 = True   | length xs <= VB.length v = True   | otherwise =-    ( runST $ do-        ms <- C.fromVector v-        ms' <- foldM (flip C.push) ms xs-        C.toVector ms'-    )+    runST+      ( do+          ms <- C.fromVector v+          ms' <- foldM (flip C.push) ms xs+          C.toVector ms'+      )       == sol   where     nl = length xs@@ -102,7 +110,7 @@     --       ++ " Sol: "     --       ++ show solution     --   ) $-      stackTake == solution+    stackTake == solution   where     -- stackFull = runST $ do     --   m <- C.fromVector v@@ -129,6 +137,20 @@         -- So we need to drop (nv - k' + nl) from the beginning of the vector.           VB.drop (nv - k' + nl) v VB.++ VB.fromList l +-- We initialize a stack, push some values and take some values.+prop_fold_independent_of_index :: VB.Vector Int -> Bool+prop_fold_independent_of_index v+  | VB.length v == 0 = True+  | otherwise = do+    [solV] == nub solSs+  where+    n = VB.length v+    solV = VB.sum v+    solSs =+      runST $ do+        stack <- C.fromVector v+        sequence [C.foldM (+) 0 (stack {C.mIndex = i}) | i <- [0 .. n - 1 :: Int]]+ spec :: Spec spec = do   describe "construction" $@@ -145,9 +167,21 @@     it "fails to convert empty vectors" $       evaluate (runST $ C.fromVector VB.empty >>= C.freeze) `shouldThrow` anyErrorCall +  describe "foldKM over end" $+    it "works" $ do+      runST (s3 >>= C.foldKM 1 (+) 0) `shouldBe` 11+      runST (s3 >>= C.foldKM 2 (+) 0) `shouldBe` (11 + 12)+      runST (s3 >>= C.foldKM 3 (+) 0) `shouldBe` (11 + 12 + 13)+      runST (s3 >>= C.foldKM 4 (+) 0) `shouldBe` (11 + 12 + 13)+      runST (s3 >>= C.foldKM 3 (*) 1) `shouldBe` (11 * 12 * 13)+      runST (s3 >>= C.foldKM 4 (*) 1) `shouldBe` 0+      runST (s3' >>= C.foldKM 3 (*) 1) `shouldBe` 6+      runST (s3' >>= C.foldKM 4 (*) 1) `shouldBe` 0+   describe "properties" $ do     prop "push" prop_push     prop "push_get" prop_push_get     prop "many pushes" prop_many_pushes     prop "json" prop_json     prop "push_take" prop_push_take+    prop "fold_independent_of_index" prop_fold_independent_of_index