circular 0.2.0 → 0.3.0

raw patch · 5 files changed

+159/−89 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• bench/Bench.hs +13/−13
• circular.cabal +3/−3
• src/Data/Stack/Circular.hs +79/−62
• test/Data/Stack/CircularSpec.hs +55/−11

@@ -5,6 +5,15 @@ ## Unreleased changes  +## 0.3.0++-   Bugfix `take`.+-   Make functions more consistent (`fromVector` and `toVector` now both work on+    mutable stacks).+-   Sort functions.+-   Improve documentation.++ ## 0.2.0  -   Complete rewrite using mutable vectors. A monadic interface is required now,

@@ -52,21 +52,21 @@     ]  -- benchmarking list, foldl--- time                 196.5 ms   (169.7 ms .. 219.9 ms)---                      0.983 R²   (0.933 R² .. 1.000 R²)--- mean                 213.9 ms   (197.8 ms .. 238.8 ms)--- std dev              25.51 ms   (10.44 ms .. 37.57 ms)--- variance introduced by outliers: 31% (moderately inflated)+-- time                 81.05 ms   (77.39 ms .. 85.31 ms)+--                      0.995 R²   (0.989 R² .. 0.999 R²)+-- mean                 86.91 ms   (83.37 ms .. 96.53 ms)+-- std dev              9.154 ms   (2.550 ms .. 15.87 ms)+-- variance introduced by outliers: 29% (moderately inflated)  -- benchmarking cstack, foldl--- time                 18.65 ms   (18.11 ms .. 19.24 ms)---                      0.993 R²   (0.983 R² .. 0.999 R²)--- mean                 18.46 ms   (18.13 ms .. 18.99 ms)--- std dev              979.7 μs   (565.1 μs .. 1.446 ms)--- variance introduced by outliers: 21% (moderately inflated)+-- time                 14.92 ms   (14.82 ms .. 14.98 ms)+--                      1.000 R²   (1.000 R² .. 1.000 R²)+-- mean                 15.08 ms   (14.99 ms .. 15.55 ms)+-- std dev              464.1 μs   (31.62 μs .. 1.007 ms)+-- variance introduced by outliers: 11% (moderately inflated)  -- benchmarking cstack unboxed, foldl--- time                 13.97 ms   (13.91 ms .. 14.05 ms)+-- time                 13.70 ms   (13.64 ms .. 13.77 ms) --                      1.000 R²   (1.000 R² .. 1.000 R²)--- mean                 13.98 ms   (13.95 ms .. 14.02 ms)--- std dev              86.51 μs   (61.56 μs .. 120.9 μs)+-- mean                 13.66 ms   (13.64 ms .. 13.69 ms)+-- std dev              62.64 μs   (44.97 μs .. 86.20 μs)

@@ -1,6 +1,6 @@ cabal-version:  1.12 name:           circular-version:        0.2.0+version:        0.3.0 synopsis:       Circular fixed-sized mutable vectors description:    Please see the README at <https://github.com/dschrempf/circular#readme> category:       Math, Data Structures@@ -43,7 +43,7 @@       Paths_circular   hs-source-dirs:       test-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall   build-depends:       QuickCheck     , aeson@@ -63,7 +63,7 @@       Paths_circular   hs-source-dirs:       bench-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall   build-depends:       aeson     , base >=4.7 && <5

@@ -23,26 +23,21 @@ -- When denoting the asymptotic runtime of functions, @n@ refers to the circular -- stack size. module Data.Stack.Circular-  ( -- * Circular stacks+  ( -- * Mutable circular stacks     MStack (..),-    Stack (..), -    -- * Construction+    -- ** Construction and conversion     replicate,--    -- * Conversion     fromVector,     toVector,     take,-    thaw,-    freeze, -    -- * Accessors+    -- ** Accessors     get,     pop,     push, -    -- * Folds+    -- ** Folds      -- | __Commutativity__ of the combining function is __assumed__ for     -- fold-like functions provided in this module, that is, the order of@@ -50,6 +45,11 @@     foldl,     sum,     product,++    -- * Immutable circular stacks+    Stack (..),+    thaw,+    freeze,   ) where @@ -68,23 +68,6 @@     mIndex :: !Int   } --- | Immutable circular stack; useful, for example, to save, or restore a--- mutable circular stack.-data Stack v a = Stack-  { iStack :: v a,-    iIndex :: !Int-  }-  deriving (Eq, Read, Show)--$(return [])--instance (FromJSON (v a)) => FromJSON (Stack v a) where-  parseJSON = $(mkParseJSON defaultOptions ''Stack)--instance (ToJSON (v a)) => ToJSON (Stack v a) where-  toJSON = $(mkToJSON defaultOptions ''Stack)-  toEncoding = $(mkToEncoding defaultOptions ''Stack)- -- | A circular stack of given size with the same element replicated. -- -- Call 'error' if the maximum size is zero or negative.@@ -119,8 +102,12 @@ -- returned vector is the current (newest) element of the stack. -- -- O(n).-toVector :: VG.Vector v a => Stack v a -> v a-toVector (Stack v i) = VG.unsafeDrop (i + 1) v VG.++ VG.unsafeTake (i + 1) v+toVector :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (v a)+toVector (MStack v i) = do+  l <- VG.freeze $ VM.unsafeDrop i' v+  r <- VG.freeze $ VM.unsafeTake i' v+  return $ l VG.++ r+  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,@@ -135,36 +122,28 @@   | k < 0 = error "toVectorN: negative k"   | k > n = error "toVectorN: circular stack too small"   | k == 0 = return VG.empty-  | i0 == 0 = VG.freeze $ VM.unsafeTake k v-  | i0 + k <= n = VG.freeze $ VM.unsafeSlice i0 k v+  -- We know now that k is in [1, n] and check if all k elements can be taken in+  -- one go.+  | i0 >= 0 = VG.freeze $ VM.unsafeSlice i0 k v+  -- Now we now that i0 is negative.   | otherwise = do-    l <- VG.freeze (VM.unsafeDrop (i + 1) v)-    r <- VG.freeze (VM.unsafeTake k' v)+    -- 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     return $ l VG.++ r   where     n = VM.length v-    -- Starting index.-    i0 = (i + 1) `mod` n-    -- Number of elements already taken from the starting index to the end of the vector.-    dk = n - i0-    -- Number of elements we still have to take.-    k' = k - dk---- | Conversion from immutable to mutable circular stack.------ O(n).-thaw :: (VG.Vector v a, PrimMonad m) => Stack v a -> m (MStack v (PrimState m) a)-thaw (Stack v i) = do-  mv <- VG.thaw v-  return $ MStack mv i+    i' = i + 1+    -- The starting index. Can be negative.+    i0 = i' - k --- | Conversion from mutable to immutable circular stack.+-- | Get the last element without changing the stack. ----- O(n).-freeze :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (Stack v a)-freeze (MStack mv i) = do-  v <- VG.freeze mv-  return $ Stack v i+-- O(1).+get :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a+get (MStack v i) = VM.unsafeRead v i+{-# INLINE get #-}  -- Select the previous element without changing the stack. previous :: VG.Vector v a => MStack v s a -> MStack v s a@@ -173,19 +152,18 @@     j = i - 1     i' = if j < 0 then VM.length v - 1 else j --- | Get the last element without changing the stack.------ O(1).-get :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a-get (MStack v i) = VM.unsafeRead v i-{-# INLINE get #-}- -- | Pop the current element from the stack and put the focus on the previous -- element. ----- Be careful: `pop` always succeeds, even if there are actually no more--- elements on the stack (similar to walking in a circle).+-- Be careful: --+-- - The stack is always full! Popping returns the last element and moves the+--   index to the second-last element, but the element is not truly removed from+--   the stack. It is only put to the end of the queue.+--+-- - Hence, `pop` always succeeds, even if there are actually no more elements+--   on the stack (similar to walking backwards in a circle).+-- -- O(1). pop :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (a, MStack v (PrimState m) a) pop x = do@@ -214,20 +192,59 @@   where     n = VM.length v --- | Left fold.+-- | Left fold over all elements of the stack. --+-- Please 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  -- | 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  -- | Compute the product of the elements on the stack. --+-- Please see the documentation of 'pop'.+-- -- O(n). product :: (Num a, VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m a product = foldl (*) 1++-- | Immutable circular stack; useful, for example, to save, or restore a+-- mutable circular stack.+data Stack v a = Stack+  { iStack :: v a,+    iIndex :: !Int+  }+  deriving (Eq, Read, Show)++$(return [])++instance (FromJSON (v a)) => FromJSON (Stack v a) where+  parseJSON = $(mkParseJSON defaultOptions ''Stack)++instance (ToJSON (v a)) => ToJSON (Stack v a) where+  toJSON = $(mkToJSON defaultOptions ''Stack)+  toEncoding = $(mkToEncoding defaultOptions ''Stack)++-- | Conversion from immutable to mutable circular stack.+--+-- O(n).+thaw :: (VG.Vector v a, PrimMonad m) => Stack v a -> m (MStack v (PrimState m) a)+thaw (Stack v i) = do+  mv <- VG.thaw v+  return $ MStack mv i++-- | Conversion from mutable to immutable circular stack.+--+-- O(n).+freeze :: (VG.Vector v a, PrimMonad m) => MStack v (PrimState m) a -> m (Stack v a)+freeze (MStack mv i) = do+  v <- VG.freeze mv+  return $ Stack v i

@@ -25,6 +25,7 @@ import Data.Aeson import qualified Data.Stack.Circular as C import qualified Data.Vector as VB+-- import Debug.Trace import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck hiding (Result, Success)@@ -46,7 +47,7 @@ ss = se >>= C.push 13  fromTo :: VB.Vector Int -> VB.Vector Int-fromTo v = C.toVector $ runST $ C.fromVector v >>= C.freeze+fromTo v = runST $ C.fromVector v >>= C.toVector  prop_from_to_id :: VB.Vector Int -> Bool prop_from_to_id v@@ -62,7 +63,7 @@ prop_push x v   | VB.length v == 0 = True   | otherwise =-    C.toVector (runST $ C.fromVector v >>= C.push x >>= C.freeze)+    (runST $ C.fromVector v >>= C.push x >>= C.toVector)       == VB.tail v VB.++ VB.singleton x  prop_many_pushes :: [Int] -> VB.Vector Int -> Bool@@ -70,32 +71,74 @@   | VB.length v == 0 = True   | length xs <= VB.length v = True   | otherwise =-    C.toVector-      ( runST $ do-          ms <- C.fromVector v-          ms' <- foldM (flip C.push) ms xs-          C.freeze ms'-      )+    ( runST $ do+        ms <- C.fromVector v+        ms' <- foldM (flip C.push) ms xs+        C.toVector ms'+    )       == sol   where     nl = length xs     nv = VB.length v-    -- That was hard :).+    -- This was hard :).     sol = VB.drop nl v VB.++ VB.fromList (reverse $ take nv $ reverse xs)  prop_json :: C.Stack VB.Vector Int -> Bool prop_json c = Success c == fromJSON (toJSON c) +-- We initialize a stack, push some values and take some values.+prop_push_take :: Int -> [Int] -> VB.Vector Int -> Bool+prop_push_take k l v+  | VB.length v == 0 = True+  | otherwise =+    -- traceShow+    --   ( "Input:" ++ show k ++ " " ++ show l ++ " " ++ show v+    --       ++ " k': "+    --       ++ show k'+    --       ++ " Stack full: "+    --       ++ show stackFull+    --       ++ " Stack take: "+    --       ++ show stackTake+    --       ++ " Sol: "+    --       ++ show solution+    --   ) $+      stackTake == solution+  where+    -- stackFull = runST $ do+    --   m <- C.fromVector v+    --   m' <- foldM (flip C.push) m l+    --   C.toVector m'+    stackTake = runST $ do+      m <- C.fromVector v+      m' <- foldM (flip C.push) m l+      C.take k' m'+    nl = length l+    nv = VB.length v+    -- We have to take a non-negative number of elements, and cannot take more+    -- elements than the stack size.+    k' = min (abs k) nv+    -- Also this was hard :).+    solution =+      if k' <= nl+        then VB.fromList (reverse $ take k' $ reverse l)+        else -- k' is larger than nl but lower than nv.+        --+        -- We take all the nl elements from the list and (k' - nl) elements from+        -- the end of the vector.+        --+        -- So we need to drop (nv - k' + nl) from the beginning of the vector.+          VB.drop (nv - k' + nl) v VB.++ VB.fromList l+ spec :: Spec spec = do   describe "construction" $     it "doesn't choke on weird inputs" $ do-      C.toVector (runST $ se >>= C.freeze) `shouldBe` VB.replicate 10 0+      runST (se >>= C.toVector) `shouldBe` VB.replicate 10 0       runST (ss >>= C.get) `shouldBe` 13    describe "conversion identities" $ do     it "correctly converts partly filled stacks" $-      C.toVector (runST $ ss >>= C.freeze) `shouldBe` (VB.replicate 9 0 `VB.snoc` 13)+      runST (ss >>= C.toVector) `shouldBe` (VB.replicate 9 0 `VB.snoc` 13)     prop "toVector . fromVector is identity" (prop_from_to_id :: VB.Vector Int -> Bool)    describe "conversion failure" $@@ -107,3 +150,4 @@     prop "push_get" prop_push_get     prop "many pushes" prop_many_pushes     prop "json" prop_json+    prop "push_take" prop_push_take