pure-shuffle 0.1.0.1 → 0.1.1.1

raw patch · 4 files changed

+65/−26 lines, 4 filesdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• pure-shuffle.cabal +3/−2
• src/Algorithms/Random/Shuffle/Pure.hs +27/−0
• test/Spec.hs +30/−24

@@ -1,3 +1,8 @@+# 0.1.1.1++- Add `sampleSplitOne` function.+- Improve document of `GetRandR`.+ # 0.1.0.1  - Fix: forgot to export `GetRandR` type synonym.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 75acbb9070dba3a7870d802790cd3bb9dee920df1ffbc3e5eef2d6e2991ffc0c+-- hash: 0f2dc7a3b6f602827389af39229f6e3ce923f3371cf1915667ae6fd37da11dbd  name:           pure-shuffle-version:        0.1.0.1+version:        0.1.1.1 description:    Please see the README on GitLab at <https://gitlab.com/igrep/pure-shuffle#readme> category:       Algorithms homepage:       https://gitlab.com/igrep/pure-shuffle#readme@@ -48,4 +48,5 @@     , mono-traversable     , pure-shuffle     , random-shuffle+    , transformers   default-language: Haskell2010

@@ -3,6 +3,7 @@ module Algorithms.Random.Shuffle.Pure   ( shuffle   , sampleOne+  , sampleSplitOne   , GetRandR   ) where @@ -14,6 +15,9 @@  -- | Monadic action generating an index number for shuffling. --   The type parameter 'm' is usually some @Monad@.+--   The first argument is a inclusive range /(lo, hi)/.+--   So the retuned value should be /lo <= x <= hi/+--   (like 'System.Random.randomR' and 'System.Random.MWC.uniformR'). type GetRandR m = (Int, Int) -> m Int  @@ -43,5 +47,28 @@   f (!i, !current) another = do     j <- randR (0, i)     let new = if j == 0 then another else current+    return (i + 1, new)+  size = 1+++-- | Implementation of <https://en.wikipedia.org/wiki/Reservoir_sampling Reservoir sampling>+--   for a single sample. By contrast to 'sampleOne',+--   this function returns not chosen elements in addition.+sampleSplitOne :: (S.IsSequence seq, Monad m) => GetRandR m -> seq -> m (Maybe (MT.Element seq, seq))+sampleSplitOne randR xs =+  case S.uncons xs of+    Just (first, left) -> Just <$> sampleSplitOneDef randR first left+    _                  -> return Nothing+++sampleSplitOneDef :: (S.IsSequence seq, Monad m) => GetRandR m -> MT.Element seq -> seq -> m (MT.Element seq, seq)+sampleSplitOneDef randR def = fmap snd . MT.ofoldlM f (size, (def, mempty))+ where+  f (!i, (!current, !notChosens)) another = do+    j <- randR (0, i)+    let new =+          if j == 0+            then (another, current `S.cons` notChosens)+            else (current, another `S.cons` notChosens)     return (i + 1, new)   size = 1

@@ -1,14 +1,16 @@ {-# LANGUAGE LambdaCase       #-} {-# LANGUAGE TypeApplications #-} -import           Control.Monad                  (replicateM)-import qualified Data.IORef                     as IOR-import           Data.List                      (elemIndex)-import           Data.Maybe                     (fromJust)-import qualified System.Random.Shuffle          as RS+import qualified Control.Arrow                    as A+import           Control.Monad                    (replicateM)+import           Control.Monad.Trans.State.Strict (State, evalState)+import qualified Control.Monad.Trans.State.Strict as S+import           Data.List                        (elemIndex, sort)+import           Data.Maybe                       (fromJust)+import qualified System.Random.Shuffle            as RS import           Test.Hspec import           Test.Hspec.QuickCheck-import qualified Test.QuickCheck                as QC+import qualified Test.QuickCheck                  as QC  import           Algorithms.Random.Shuffle.Pure @@ -24,16 +26,17 @@           return (xs, is)      in       prop "behaves as a monadic version of System.Random.Shuffle.shuffle" $ QC.forAll gen $ \(xs, is) -> do-        ior <- IOR.newIORef is-        let getRandR = const $ mkGen ior-        shuffle getRandR xs `shouldReturn` RS.shuffle xs is+        let getRandR = const genSt+        evalState (shuffle getRandR xs) is `shouldBe` RS.shuffle xs is -  describe "sampleOne" $ do-    it "returns Nothing given an empty list" $+  describe "sampleOne and sampleSplitOne" $ do+    it "returns Nothing given an empty list" $ do       sampleOne undefined "" `shouldReturn` Nothing+      sampleSplitOne undefined "" `shouldReturn` Nothing -    prop "returns the only element given a singleton list" $ \x ->+    prop "returns the only element given a singleton list" $ \x -> do       sampleOne undefined [x :: Char] `shouldReturn` Just x+      sampleSplitOne undefined [x :: Char] `shouldReturn` Just (x, [])      let gen = do           len <- (+ 2) <$> QC.arbitrarySizedNatural@@ -45,23 +48,26 @@           is <- (0 :) <$> QC.vectorOf (len - 2) (QC.arbitrarySizedNatural @Int)           return (xs, is)      in-      prop "returns the element at the last index where the generator returns 0." $ QC.forAll gen $ \(xs, is) -> do-        ior <- IOR.newIORef is-        let getRandR = const $ mkGen ior--            -- NOTE: Because getRandR is not called when picking the first element,-            --       The actual index is shifted by one.-            expected = xs !! (fromJust (elemRIndex 0 is) + 1)+      prop "sampleOne returns the element at the last index where the generator returns 0, and sampleSplitOne returns the other elements in addition" $+        QC.forAll gen $ \(xs, is) -> do+          let getRandR = const genSt+              -- NOTE: Because getRandR is not called when picking the first element,+              --       The actual index is shifted by one.+              chosen = xs !! (fromJust (elemRIndex 0 is) + 1)+              others = sort $ filter (/= chosen) xs -        sampleOne getRandR xs `shouldReturn` Just expected+          evalState (sampleOne getRandR xs) is `shouldBe` Just chosen+          A.second sort <$> evalState (sampleSplitOne getRandR xs) is `shouldBe` Just (chosen, others)  -mkGen :: IOR.IORef [Int] -> IO Int-mkGen ior =-  IOR.atomicModifyIORef' ior $+genSt :: State [Int] Int+genSt =+  S.get >>=     \case       [] -> error "No more elements!"-      (i : is) -> (is, i)+      (hd : tl) -> do+        S.put tl+        return hd   elemRIndex :: Eq a => a -> [a] -> Maybe Int