Skip to content

Commit

Permalink
Merge pull request #140 from haskell/lehins/shuffleList
Browse files Browse the repository at this point in the history
Introduce `shuffleList` and `shuffleListM`
  • Loading branch information
lehins authored Jan 27, 2024
2 parents fdcc5d2 + 4d212cc commit 74146bd
Show file tree
Hide file tree
Showing 5 changed files with 43 additions and 0 deletions.
1 change: 1 addition & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# 1.3.0

* Add `shuffleList` and `shuffleListM`: [#140](https://github.com/haskell/random/pull/140)
* Add `mkStdGen64`: [#155](https://github.com/haskell/random/pull/155)
* Add `uniformListRM`, `uniformList`, `uniformListR`, `uniforms` and `uniformRs`:
[#154](https://github.com/haskell/random/pull/154)
Expand Down
14 changes: 14 additions & 0 deletions src/System/Random.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@ module System.Random
, uniformRs
, uniformList
, uniformListR
, shuffleList
-- ** Bytes
, uniformByteArray
, uniformByteString
Expand Down Expand Up @@ -289,6 +290,19 @@ uniformListR :: (UniformRange a, RandomGen g) => Int -> (a, a) -> g -> ([a], g)
uniformListR n r g = runStateGen g (uniformListRM n r)
{-# INLINE uniformListR #-}

-- | Shuffle elements of a list in a random order.
--
-- ====__Examples__
--
-- >>> let gen = mkStdGen 2023
-- >>> shuffleList ['a'..'z'] gen
-- ("renlhfqmgptwksdiyavbxojzcu",StdGen {unStdGen = SMGen 9882508430712573120 1920468677557965761})
--
-- @since 1.3.0
shuffleList :: RandomGen g => [a] -> g -> ([a], g)
shuffleList xs g = runStateGen g (shuffleListM xs)
{-# INLINE shuffleList #-}

-- | Generates a 'ByteString' of the specified size using a pure pseudo-random
-- number generator. See 'uniformByteStringM' for the monadic version.
--
Expand Down
20 changes: 20 additions & 0 deletions src/System/Random/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ module System.Random.Internal
, uniformEnumRM
, uniformListM
, uniformListRM
, shuffleListM
, isInRangeOrd
, isInRangeEnum

Expand Down Expand Up @@ -96,6 +97,7 @@ import Data.Bits
import Data.ByteString.Short.Internal (ShortByteString(SBS), fromShort)
import Data.IORef (IORef, newIORef)
import Data.Int
import Data.List (sortOn)
import Data.Word
import Foreign.C.Types
import Foreign.Storable (Storable)
Expand Down Expand Up @@ -846,6 +848,24 @@ uniformListRM :: (StatefulGen g m, UniformRange a) => Int -> (a, a) -> g -> m [a
uniformListRM n range gen = replicateM n (uniformRM range gen)
{-# INLINE uniformListRM #-}

-- | Shuffle elements of a list in a random order.
--
-- ====__Examples__
--
-- >>> import System.Random.Stateful
-- >>> let pureGen = mkStdGen 2023
-- >>> g <- newIOGenM pureGen
-- >>> shuffleListM ['a'..'z'] g :: IO String
-- "renlhfqmgptwksdiyavbxojzcu"
--
-- @since 1.3.0
shuffleListM :: StatefulGen g m => [a] -> g -> m [a]
shuffleListM xs gen = do
is <- uniformListM n gen
pure $ map snd $ sortOn fst $ zip (is :: [Int]) xs
where
!n = length xs
{-# INLINE shuffleListM #-}

-- | The standard pseudo-random number generator.
newtype StdGen = StdGen { unStdGen :: SM.SMGen }
Expand Down
1 change: 1 addition & 0 deletions src/System/Random/Stateful.hs
Original file line number Diff line number Diff line change
Expand Up @@ -98,6 +98,7 @@ module System.Random.Stateful
-- ** Lists
, uniformListM
, uniformListRM
, shuffleListM

-- ** Generators for sequences of pseudo-random bytes
, uniformByteArrayM
Expand Down
7 changes: 7 additions & 0 deletions test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ import Control.Monad.ST (runST)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as SBS
import Data.Int
import Data.List (sortOn)
import Data.Typeable
import Data.Void
import Data.Word
Expand Down Expand Up @@ -245,6 +246,12 @@ uniformSpec px =
case uniform g of
(range, g') ->
take len (randomRs range g' :: [a]) == fst (uniformListR len range g')
, SC.testProperty "shuffleList" $
seededWithLen $ \len g ->
case uniformList len g of
(xs, g') ->
let xs' = zip [0 :: Int ..] (xs :: [a])
in sortOn fst (fst (shuffleList xs' g')) == xs'
, SC.testProperty "uniforms" $
seededWithLen $ \len g ->
take len (randoms g :: [a]) == take len (uniforms g)
Expand Down

0 comments on commit 74146bd

Please sign in to comment.