diff --git a/CHANGELOG.md b/CHANGELOG.md index bf717705..756de5b0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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) diff --git a/src/System/Random.hs b/src/System/Random.hs index 9bbc2422..9ffcb0d9 100644 --- a/src/System/Random.hs +++ b/src/System/Random.hs @@ -42,6 +42,7 @@ module System.Random , uniformRs , uniformList , uniformListR + , shuffleList -- ** Bytes , uniformByteArray , uniformByteString @@ -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. -- diff --git a/src/System/Random/Internal.hs b/src/System/Random/Internal.hs index e7c6354f..e9633c78 100644 --- a/src/System/Random/Internal.hs +++ b/src/System/Random/Internal.hs @@ -63,6 +63,7 @@ module System.Random.Internal , uniformEnumRM , uniformListM , uniformListRM + , shuffleListM , isInRangeOrd , isInRangeEnum @@ -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) @@ -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 } diff --git a/src/System/Random/Stateful.hs b/src/System/Random/Stateful.hs index 294769df..20f93ad3 100644 --- a/src/System/Random/Stateful.hs +++ b/src/System/Random/Stateful.hs @@ -98,6 +98,7 @@ module System.Random.Stateful -- ** Lists , uniformListM , uniformListRM + , shuffleListM -- ** Generators for sequences of pseudo-random bytes , uniformByteArrayM diff --git a/test/Spec.hs b/test/Spec.hs index b16c66fd..d05f15d3 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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 @@ -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)