perfect-vector-shuffle (empty) → 0.1.0
raw patch · 6 files changed
+264/−0 lines, 6 filesdep +MonadRandomdep +QuickCheckdep +base
Dependencies added: MonadRandom, QuickCheck, base, perfect-vector-shuffle, primitive, quickcheck-instances, random, tasty, tasty-quickcheck, vector
Files
- CHANGELOG.md +2/−0
- perfect-vector-shuffle.cabal +96/−0
- src/Immutable/Shuffle.hs +41/−0
- src/Mutable/Shuffle.hs +54/−0
- test/Immutable/Test.hs +56/−0
- test/Test.hs +15/−0
+ CHANGELOG.md view
@@ -0,0 +1,2 @@+0.1.0+
+ perfect-vector-shuffle.cabal view
@@ -0,0 +1,96 @@+cabal-version: 2.2+category: Random, Vector+build-type: Simple++name: perfect-vector-shuffle+synopsis: Library for performing vector shuffles+version: 0.1.0++author: Callan McGill+maintainer: callan.mcgill@gmail.com+homepage: https://github.com/Boarders/perfect-vector-shuffle+bug-reports: https://github.com/Boarders/perfect-vector-shuffle/issues+copyright: 2019+license: BSD-3-Clause+description:+ .+ This package contains functions for performing shuffles on mutable and+ immutable vectors. The shuffles are uniform at random amongst all+ permuations.+ .+ For an example of how to use it:+ .+ @+ module Example where+ .+ import Data.Vector+ import Immutable.Shuffle+ .+ myVector :: Vector Int+ myVector = fromList [1..10]+ .+ shuffleMyVector :: IO (Vector Int)+ shuffleMyVector = shuffleM myVector+ @+ .+ This gives the following:+ .+ @+ > shuffleMyVector+ [1,10,4,7,2,3,5,9,8,6]+ > shuffleMyVector+ [7,4,2,10,9,8,6,5,1,3]+ @++extra-source-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/Boarders/perfect-vector-shuffle+++Library++ hs-source-dirs: src++ ghc-options: -Wall++ build-depends: base ^>= 4.12.0.0+ , MonadRandom >= 0.5.1.1 && < 0.6+ , primitive >= 0.6.4.0 && < 0.7+ , random ^>= 1.1+ , vector >= 0.12.0 && < 0.13++ exposed-modules: Immutable.Shuffle+ Mutable.Shuffle++ other-modules:++ default-language: Haskell2010+++Test-Suite testsuite++ type: exitcode-stdio-1.0++ main-is: Test.hs++ hs-source-dirs: test++ ghc-options: -Wall+ -Wincomplete-patterns++ build-depends: perfect-vector-shuffle ^>= 0.1.0+ , base ^>= 4.12.0.0+ , QuickCheck ^>= 2.12.6.1+ , random ^>= 1.1+ , tasty >= 1.2 && < 1.3+ , tasty-quickcheck ^>= 0.10+ , vector >= 0.12.0 && < 0.13+ , quickcheck-instances >= 0.3.19 && < 0.4+++ other-modules:+ Immutable.Test++ default-language: Haskell2010
+ src/Immutable/Shuffle.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module provides functions to perform shuffles on immutable vectors.+-- The shuffling is uniform amongst all permuations and performs the minimal+-- number of transpositions.++module Immutable.Shuffle where++import Control.Monad.Primitive+import Control.Monad.Random (MonadRandom (..))+import Control.Monad.ST (runST)+import Data.Vector+import qualified Mutable.Shuffle as MS+import Prelude hiding (length)+import System.Random (RandomGen (..))+++-- |+-- Perform a shuffle on an immutable vector with a given random generator returning a shuffled vector and a new generator.+shuffle :: forall a g. RandomGen g => Vector a -> g -> (Vector a, g)+shuffle v g+ | length v <= 1 = (v, snd . next $ g)+ | otherwise =+ runST $+ do+ mutV <- thaw v+ newGen <- MS.shuffle mutV g+ immutV <- unsafeFreeze mutV+ pure (immutV, newGen)+++-- |+-- Perform a shuffle on an input immutable vector in a monad which has a source of randomness.+shuffleM :: forall m a . (MonadRandom m, PrimMonad m) => Vector a -> m (Vector a)+shuffleM v+ | length v <= 1 = pure v+ | otherwise =+ do+ mutV <- thaw v+ MS.shuffleM mutV+ unsafeFreeze mutV
+ src/Mutable/Shuffle.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module provides functions to perform shuffles on mutable vectors.+-- The shuffling is uniform amongst all permuations and uses the minimal+-- number of transpositions.++module Mutable.Shuffle where++import Control.Monad.Primitive+import Control.Monad.Random (MonadRandom (..))+import Data.Vector.Mutable+import Prelude hiding (length, tail)+import System.Random (RandomGen)+import qualified System.Random as SR++-- |+-- Perform a shuffle on a mutable vector with a given random generator, returning a new random generator.+shuffle+ :: forall m a g+ . ( PrimMonad m+ , RandomGen g+ )+ => MVector (PrimState m) a -> g -> m g+shuffle mutV gen = go mutV gen (length mutV - 1)+ where+ go :: MVector (PrimState m) a -> g -> Int -> m g+ go _ g 0 = pure g+ go v g maxInd =+ do+ let (ind, newGen) :: (Int, g) = SR.randomR (0, maxInd) g+ swap v 0 ind+ go (tail v) newGen (maxInd - 1)+++-- |+-- Perform a shuffle on a mutable vector in a monad which has a source of randomness.+shuffleM+ :: forall m a+ . ( PrimMonad m+ , MonadRandom m+ )+ => MVector (PrimState m) a -> m ()+shuffleM mutV = go mutV (length mutV - 1)+ where+ go :: MVector (PrimState m) a -> Int -> m ()+ go _ 0 = pure ()+ go v maxInd =+ do+ ind <- getRandomR (0, maxInd)+ swap v 0 ind+ go (tail v) (maxInd - 1)++
+ test/Immutable/Test.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+module Immutable.Test+ ( testSuite+ ) where++import Data.List (sort)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Immutable.Shuffle+import System.Random+import Test.QuickCheck.Instances.Vector ()+import Test.QuickCheck.Monadic+import Test.Tasty+import Test.Tasty.QuickCheck as QC hiding (shuffle)+++testSuite :: TestTree+testSuite = testGroup ""+ [ localOption (QuickCheckTests 1000) shuffleTestSuite+ , localOption (QuickCheckTests 1000) shuffleMTestSuite+ ]+++shuffleTestSuite :: TestTree+shuffleTestSuite = testGroup "shuffle"+ [ QC.testProperty+ "Shuffling preserves length and elements"+ (monadicIO . isPermutation @Int)]+++shuffleMTestSuite :: TestTree+shuffleMTestSuite = testGroup "shuffleM"+ [ QC.testProperty+ "Shuffling preserves length and elements"+ (monadicIO . isPermutationM @Int)]+++isPermutation :: forall a . (Ord a , Show a, Arbitrary a) => Vector a -> PropertyM IO Property+isPermutation v =+ do+ gen <- run $ getStdGen+ let v' = fst $ shuffle v gen+ let ls = V.toList v+ let ls' = V.toList v'+ pure $ (sort ls) === (sort ls')+++isPermutationM :: forall a . (Ord a , Show a, Arbitrary a) => Vector a -> PropertyM IO Property+isPermutationM v =+ do+ v' <- run $ shuffleM v+ let ls = V.toList v+ let ls' = V.toList v'+ pure $ (sort ls) === (sort ls')+
+ test/Test.hs view
@@ -0,0 +1,15 @@+module Main where++import qualified Immutable.Test as Immutable+import Test.Tasty+++main :: IO ()+main = defaultMain testSuite+++testSuite :: TestTree+testSuite = testGroup "Perfect Vector Sort"+ [ Immutable.testSuite+ ]+