list-shuffle (empty) → 1.0.0

raw patch · 7 files changed

+371/−0 lines, 7 filesdep +basedep +deepseqdep +hedgehog

Dependencies added: base, deepseq, hedgehog, list-shuffle, primitive, random, tasty-bench

Files

CHANGELOG.md +3/−0
LICENSE +11/−0
README.md +9/−0
bench/Main.hs +25/−0
list-shuffle.cabal +89/−0
src/List/Shuffle.hs +178/−0
test/Main.hs +56/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+## [1.0.0] - 2023-20-25++- Initial release.

+ LICENSE view

@@ -0,0 +1,11 @@+Copyright 2023 Mitchell Rosen, Travis Staton++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,9 @@+# list-shuffle++[![GitHub CI](https://github.com/awkward-squad/list-shuffle/workflows/Haskell-CI/badge.svg)](https://github.com/awkward-squad/list-shuffle/actions)+[![Hackage](https://img.shields.io/hackage/v/list-shuffle.svg)](https://hackage.haskell.org/package/list-shuffle)+[![Stackage LTS](https://stackage.org/package/list-shuffle/badge/lts)](https://www.stackage.org/lts/package/list-shuffle)+[![Stackage Nightly](https://stackage.org/package/list-shuffle/badge/nightly)](https://www.stackage.org/nightly/package/list-shuffle)+[![Dependencies](https://img.shields.io/hackage-deps/v/list-shuffle)](https://packdeps.haskellers.com/reverse/list-shuffle)++List shuffling and sampling with optimal asymptotic time and space complexity using the imperative Fisher–Yates algorithm.

+ bench/Main.hs view

@@ -0,0 +1,25 @@+module Main (main) where++import Control.DeepSeq (force)+import Control.Exception (evaluate)+import List.Shuffle qualified as List+import System.Random qualified as Random+import Test.Tasty.Bench (bench, defaultMain, whnf)++main :: IO ()+main = do+  let list = [1 .. 1_000_000] :: [Int]+  _ <- evaluate (force list)++  defaultMain+    [ bench "sample 10/1000000" (whnf (sample 10) (list, Random.mkStdGen 0)),+      bench "shuffle 1000000" (whnf shuffle (list, Random.mkStdGen 0))+    ]++sample :: Int -> ([Int], Random.StdGen) -> [Int]+sample n (list, gen) =+  List.sample_ n list gen++shuffle :: ([Int], Random.StdGen) -> [Int]+shuffle (list, gen) =+  List.shuffle_ list gen

+ list-shuffle.cabal view

@@ -0,0 +1,89 @@+cabal-version: 2.4++author: Mitchell Rosen+bug-reports: https://github.com/awkward-squad/list-shuffle/issues+category: Data+copyright: Copyright (C) 2023 Mitchell Rosen, Travis Staton+description: List shuffling and sampling with optimal asymptotic time and space complexity using the imperative Fisher–Yates algorithm.+homepage: https://github.com/awkward-squad/list-shuffle+license: BSD-3-Clause+license-file: LICENSE+maintainer: Mitchell Rosen <mitchellwrosen@gmail.com>, Travis Staton <hello@travisstaton.com>+name: list-shuffle+stability: stable+synopsis: List shuffling and sampling+tested-with: GHC == 9.4.7, GHC == 9.6.3, GHC == 9.8.1+version: 1.0.0++extra-doc-files:+  CHANGELOG.md+  README.md++source-repository head+  type: git+  location: https://github.com/awkward-squad/list-shuffle.git++common component+  default-extensions:+    BangPatterns+    BlockArguments+    ImportQualifiedPost+    LambdaCase+    NumericUnderscores+    OverloadedStrings+    PatternSynonyms+    RankNTypes+    ScopedTypeVariables+  default-language: Haskell2010+  ghc-options:+    -Weverything+    -Wno-all-missed-specialisations+    -Wno-implicit-prelude+    -Wno-missed-specialisations+    -Wno-missing-import-lists+    -Wno-safe+    -Wno-unsafe+  if impl(ghc >= 8.10)+    ghc-options:+      -Wno-missing-safe-haskell-mode+      -Wno-prepositive-qualified-module+  if impl(ghc >= 9.2)+    ghc-options:+      -Wno-missing-kind-signatures+  if impl(ghc >= 9.8)+    ghc-options:+      -Wno-missing-role-annotations++library+  import: component+  build-depends:+    base ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19,+    primitive ^>= 0.8 || ^>= 0.9,+    random ^>= 1.2.1,+  hs-source-dirs: src+  exposed-modules: List.Shuffle++test-suite test+  import: component+  build-depends:+    base,+    hedgehog ^>= 1.4,+    list-shuffle,+    random,+  ghc-options: -rtsopts -threaded "-with-rtsopts=-N4"+  hs-source-dirs: test+  main-is: Main.hs+  type: exitcode-stdio-1.0++benchmark bench+  import: component+  build-depends:+    base,+    deepseq ^>= 1.4.6 || ^>= 1.5.0,+    list-shuffle,+    random,+    tasty-bench ^>= 0.3.5,+  ghc-options: "-with-rtsopts=-A32m -T"+  hs-source-dirs: bench+  main-is: Main.hs+  type: exitcode-stdio-1.0

+ src/List/Shuffle.hs view

@@ -0,0 +1,178 @@+-- | List shuffling and sampling with optimal asymptotic time and space complexity using the imperative Fisher–Yates+-- algorithm.+module List.Shuffle+  ( -- * Shuffling+    shuffle,+    shuffle_,+    shuffleIO,++    -- * Sampling+    sample,+    sample_,+    sampleIO,++    -- * Adapting to other monads++    -- ** Reader monad+    -- $example-reader++    -- ** State monad+    -- $example-state+  )+where++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.ST (runST)+import Control.Monad.ST.Strict (ST)+import Data.Foldable qualified as Foldable+import Data.Primitive.Array qualified as Array+import System.Random (RandomGen)+import System.Random qualified as Random++-- $example-reader+--+-- You are working in a reader monad, with access to a pseudo-random number generator somewhere in the environment,+-- in a mutable cell like an @IORef@ or @TVar@:+--+-- > import System.Random qualified as Random+-- > import System.Random.Stateful qualified as Random+-- >+-- > data MyMonad a+-- >+-- > instance MonadIO MyMonad+-- > instance MonadReader MyEnv MyMonad+-- >+-- > data MyEnv = MyEnv+-- >   { ...+-- >   , prng :: Random.AtomicGenM Random.StdGen+-- >   , ...+-- >   }+--+-- In this case, you can adapt 'shuffle' to work in your monad as follows:+--+-- > import List.Shuffle qualified as List+-- > import System.Random qualified as Random+-- >+-- > shuffleList :: [a] -> MyMonad [a]+-- > shuffleList list = do+-- >   MyEnv {prng} <- ask+-- >   Random.applyAtomicGen (List.shuffle list) prng++-- $example-state+--+-- You are working in a state monad with access to a pseudo-random number generator somewhere in the state type. You+-- also have a lens onto this field, which is commonly either provided by @generic-lens@/@optics@ or written manually:+--+-- > import System.Random qualified as Random+-- >+-- > data MyState = MyState+-- >   { ...+-- >   , prng :: Random.StdGen+-- >   , ...+-- >   }+-- >+-- > prngLens :: Lens' MyState Random.StdGen+--+-- In this case, you can adapt 'shuffle' to work in your monad as follows:+--+-- > import Control.Lens qualified as Lens+-- > import Control.Monad.Trans.State.Strict qualified as State+-- > import List.Shuffle qualified as List+-- >+-- > shuffleList :: Monad m => [a] -> StateT MyState m [a]+-- > shuffleList =+-- >   Lens.zoom prngLens . State.state . List.shuffle++-- | \(\mathcal{O}(n)\). Shuffle a list.+shuffle :: (RandomGen g) => [a] -> g -> ([a], g)+shuffle list gen0 =+  runST do+    array <- listToMutableArray list+    gen1 <- shuffleN (Array.sizeofMutableArray array - 1) array gen0+    array1 <- Array.unsafeFreezeArray array+    pure (Foldable.toList array1, gen1)+{-# SPECIALIZE shuffle :: [a] -> Random.StdGen -> ([a], Random.StdGen) #-}++-- `shuffleN n array g` shuffles the first `n` elements of `array`, i.e. it performs the Fisher-Yates algorithm, but+-- stopping after `n` elements, effectively leaving those `n` elements at the head of the array "shuffled" and the rest+-- in some random indeterminate order.+--+-- Call `len` the length of the array minus 1. When `n` is the len, the whole array gets shuffled, as shuffling `n-1` of+-- `n` elements is equivalent to shuffling all `n` elements.+--+-- It's fine to pass nonsense values for `n` - negative numbers are equivalent to 0, and numbers larger than `len` are+-- equivalent to `len`.+shuffleN :: forall a g s. (RandomGen g) => Int -> Array.MutableArray s a -> g -> ST s g+shuffleN n0 array =+  go 0+  where+    go :: Int -> g -> ST s g+    go !i gen0+      | i >= n = pure gen0+      | otherwise = do+          let (j, gen1) = Random.uniformR (i, m) gen0+          swapArrayElems i j array+          go (i + 1) gen1++    n = min n0 m+    m = Array.sizeofMutableArray array - 1+{-# SPECIALIZE shuffleN :: Int -> Array.MutableArray s a -> Random.StdGen -> ST s Random.StdGen #-}++-- | \(\mathcal{O}(n)\). Like 'shuffle', but discards the final generator.+shuffle_ :: (RandomGen g) => [a] -> g -> [a]+shuffle_ list g =+  fst (shuffle list g)+{-# SPECIALIZE shuffle_ :: [a] -> Random.StdGen -> [a] #-}++-- | \(\mathcal{O}(n)\). Like 'shuffle', but uses the global random number generator.+shuffleIO :: (MonadIO m) => [a] -> m [a]+shuffleIO list =+  shuffle_ list <$> Random.newStdGen+{-# SPECIALIZE shuffleIO :: [a] -> IO [a] #-}++-- | \(\mathcal{O}(n)\). Sample elements of a list, without replacement.+--+-- @sample_ c xs@ is equivalent to @take c . shuffle_ xs@, but with a constant factor that is proportional to @c@, not+-- the length of @xs@.+sample :: (RandomGen g) => Int -> [a] -> g -> ([a], g)+sample n list gen0 =+  runST do+    array <- listToMutableArray list+    gen1 <- shuffleN n array gen0+    array1 <- Array.unsafeFreezeArray array+    pure (take n (Foldable.toList array1), gen1)+{-# SPECIALIZE sample :: Int -> [a] -> Random.StdGen -> ([a], Random.StdGen) #-}++-- | \(\mathcal{O}(n)\). Like 'sample', but discards the final generator.+sample_ :: (RandomGen g) => Int -> [a] -> g -> [a]+sample_ n list g =+  fst (sample n list g)+{-# SPECIALIZE sample_ :: Int -> [a] -> Random.StdGen -> [a] #-}++-- | \(\mathcal{O}(n)\). Like 'sample', but uses the global random number generator.+sampleIO :: (MonadIO m) => Int -> [a] -> m [a]+sampleIO n list =+  sample_ n list <$> Random.newStdGen+{-# SPECIALIZE sampleIO :: Int -> [a] -> IO [a] #-}++-- Swap two elements in a mutable array.+swapArrayElems :: Int -> Int -> Array.MutableArray s a -> ST s ()+swapArrayElems i j array = do+  x <- Array.readArray array i+  y <- Array.readArray array j+  Array.writeArray array i y+  Array.writeArray array j x+{-# INLINE swapArrayElems #-}++-- Construct a mutable array from a list.+listToMutableArray :: [a] -> ST s (Array.MutableArray s a)+listToMutableArray list = do+  array <- Array.newArray (length list) undefined+  let writeElems !i = \case+        [] -> pure ()+        x : xs -> do+          Array.writeArray array i x+          writeElems (i + 1) xs+  writeElems 0 list+  pure array+{-# INLINE listToMutableArray #-}

+ test/Main.hs view

@@ -0,0 +1,56 @@+module Main (main) where++import Data.List qualified as List+import Data.Word+import Hedgehog+import Hedgehog.Gen qualified as Gen+import Hedgehog.Main+import Hedgehog.Range qualified as Range+import List.Shuffle qualified as List+import System.Random qualified as Random++main :: IO ()+main = do+  defaultMain [checkParallel (Group "tests" (map (\(name, prop) -> (name, withTests 10000 (property prop))) tests))]++tests :: [(PropertyName, PropertyT IO ())]+tests =+  [ ( "shuffle preserves list elements",+      do+        list <- generateList+        gen <- generateGen+        List.sort (List.shuffle_ list gen) === List.sort list+    ),+    ( "sample returns the requested number of elements",+      do+        list <- generateList+        gen <- generateGen+        n <- forAll (Gen.int (Range.linearFrom 0 (-30) (30)))+        length (List.sample_ n list gen) === (min (length list) . max 0) n+    ),+    ( "sample returns a subset of list elements",+      do+        list <- generateList+        gen <- generateGen+        n <- forAll (Gen.int (Range.linearFrom 0 (-30) (30)))+        assert (List.sort (List.sample_ n list gen) `isSubsetOf` List.sort list)+    )+  ]++generateList :: PropertyT IO [Word8]+generateList =+  forAll (Gen.list (Range.linear 0 200) (Gen.word8 Range.linearBounded))++generateGen :: PropertyT IO Random.StdGen+generateGen =+  Random.mkStdGen <$> forAll (Gen.int Range.constantBounded)++-- precondition: lists are sorted+isSubsetOf :: (Ord a) => [a] -> [a] -> Bool+isSubsetOf [] _ = True+isSubsetOf (_ : _) [] = False+isSubsetOf (x : xs) (y : ys) =+  case compare x y of+    LT -> False+    EQ -> isSubsetOf xs ys+    GT -> isSubsetOf (x : xs) ys