rando 0.0.0.1 → 0.0.0.2

raw patch · 5 files changed

+182/−11 lines, 5 filesdep +containersdep +microspecdep +vectorPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: containers, microspec, vector

API changes (from Hackage documentation)

Files

• rando.cabal +26/−3
• src/Rando.hs +12/−8
• src/System/Random/Pick.hs +17/−0
• src/System/Random/Shuffle/FisherYates.hs +42/−0
• test/Test.hs +85/−0

@@ -1,5 +1,5 @@ name:                rando-version:             0.0.0.1+version:             0.0.0.2 synopsis:            Easy-to-use randomness for livecoding description:             Easy-to-use randomness for livecoding.@@ -9,8 +9,14 @@    > >>> pickOne ["lemon", "lime", "strawberry"]    > "lime" :: IO String    .+   > >>> flipCoin+   > True+   .+   > >>> shuffle [1..5]+   > [2,4,1,3,5]+   .    This library is in flux: names will change, types will change, functions-   will appear and disappear.+   will appear and disappear and move between modules! license:             GPL-3 license-file:        LICENSE author:              Tom Murphy@@ -22,11 +28,28 @@ stability:           experimental  library-  exposed-modules:     Rando+  exposed-modules:+      Rando+    , System.Random.Pick+    , System.Random.Shuffle.FisherYates   -- other-modules:          -- other-extensions:       build-depends:       base < 5     , tf-random+    , vector   hs-source-dirs:      src+  default-language:    Haskell2010++test-suite rando-tests+  hs-source-dirs: test, src+  main-is: Test.hs+  type: exitcode-stdio-1.0+  build-depends:+      base < 5+    , containers+    , tf-random+    , vector+    +    , microspec   default-language:    Haskell2010

@@ -1,13 +1,17 @@+-- | \"Quick, gimme everything in the 'rando' package!\"+ module Rando (+   -- We export the functions instead of the modules, so that all the docs are+   --   on one page:++   --   module System.Random.Pick      pickOne-   ) where+   , flipCoin -import System.Random.TF.Init-import System.Random.TF.Instances+   -- , module System.Random.Shuffle.FisherYates+   , shuffle+   ) where -pickOne :: [x] -> IO x-pickOne l = do-   g <- newTFGen-   let (ix, _) = randomR (0, (length::[a]->Int) l - 1) g-   pure $ l !! ix+import System.Random.Pick+import System.Random.Shuffle.FisherYates 

@@ -0,0 +1,17 @@+module System.Random.Pick (+     pickOne+   , flipCoin+   ) where++import System.Random.TF.Init+import System.Random.TF.Instances++pickOne :: [x] -> IO x+pickOne l = do+   g <- newTFGen+   let (ix, _) = randomR (0, (length::[a]->Int) l - 1) g+   pure $ l !! ix++flipCoin :: IO Bool+flipCoin = pickOne [True, False]+

@@ -0,0 +1,42 @@+module System.Random.Shuffle.FisherYates (+     shuffle+   ) where++import Control.Monad+import Control.Monad.ST+import Data.STRef+import qualified Data.Vector as V+import qualified Data.Vector.Mutable as VM+import System.Random.TF+import System.Random.TF.Instances++-- The Fisher-Yates shuffle, asymptotically optimal for both space and time:+shuffle :: [x] -> IO [x]+shuffle list = do++   initGen <- newTFGen++   pure $ V.toList $ runST $ do+      genVar <- newSTRef initGen++      v <- V.thaw $ V.fromList list+      let vLen = VM.length v++      forM_ [vLen - 1, vLen - 2 .. 1] $ \n -> do+         indexToSwap <- randSTFromZero genVar n+         -- The "unsafe" means it doesn't have bounds checks, which is fine here:+         VM.unsafeSwap v indexToSwap n++      -- This "unsafe" is also safe here:+      V.unsafeFreeze v++++-- | Picks from 0 to maxval, inclusive+randSTFromZero :: STRef s TFGen -> Int -> ST s Int+randSTFromZero genVar maxVal = do+   g0 <- readSTRef genVar+   let (x, g1) = randomR (0, maxVal) g0+   writeSTRef genVar g1+   pure x+

@@ -0,0 +1,85 @@+-- | It's obviously difficult to test nondeterministic functions.+--   Some of these methods are \"uncommon\" but they do the job.++{-# LANGUAGE ViewPatterns #-}++import Control.Monad+import qualified Data.List as L+import Data.Set (Set)+import qualified Data.Set as Set+import Test.Microspec hiding (shuffle)++import Rando++main :: IO ()+main = microspec $ do+   describe "shuffle" $ do++      -- This tests that there's no position in the list (e.g. first or last+      --   element) that's "stuck" (never changes position):+      it "at least sometimes, all elements change position" $ \(NonEmpty l) ->+         length (L.nub l) > 1 ==>+            monadicIO $ prop_sometimesAllElemsChange $ NonEmpty l++      -- This is apparently a very common symptom of off-by-one errors with+      --   this algorithm:+      it "sometimes has elements which don't change position" $+         monadicIO . prop_sometimesElemsDontChange++      it "produces roughly equal distributions" $+         monadicIO $ prop_roughlyEqualShuffleDistributions++   describe "pickOne" $ do+      it "draws from all elements of the list" $+         monadicIO . prop_pickOne_picksFromAllElems++-- L.nub so we're not confused by dupes:+prop_sometimesAllElemsChange :: NonEmptyList Int -> PropertyM IO Bool+prop_sometimesAllElemsChange (NonEmpty (L.nub -> l_u)) = do+   l_s <- run $ shuffle l_u+   if (and::[Bool]->Bool) $ zipWith (/=) l_s l_u+      then pure True+      else prop_sometimesAllElemsChange $ NonEmpty l_u++prop_sometimesElemsDontChange :: NonEmptyList Int -> PropertyM IO Bool+prop_sometimesElemsDontChange (NonEmpty (L.nub -> l_u)) = do+   l_s <- run $ shuffle l_u+   if (or::[Bool]->Bool) $ zipWith (==) l_s l_u+      then pure True+      else prop_sometimesElemsDontChange $ NonEmpty l_u++prop_roughlyEqualShuffleDistributions :: PropertyM IO Bool+prop_roughlyEqualShuffleDistributions = do+   allRuns <- run $ replicateM numRuns (shuffle ([1..9] :: [Int]))+   -- TODO: this weirdly passed when 'shuffle' was undefined! Why??+   let thingWereReallyTesting = (and::[Bool]->Bool) $+          map (closeTo5 . average) $+             L.transpose allRuns+       -- TODO: it passes even with this!!:+       forceMore =+          let (a:b:_) = allRuns+          in a /= b+   -- run $ print $ take 2 allRuns+   pure $ thingWereReallyTesting && forceMore+ where+   numRuns :: Int+   numRuns = 10000++   average :: [Int] -> Double+   average l = toEnum (sum l) / toEnum numRuns++   closeTo5 :: Double -> Bool+   closeTo5 n = abs (n - 5) < 0.02++prop_pickOne_picksFromAllElems :: Set Int -> PropertyM IO Bool+prop_pickOne_picksFromAllElems ourList =+   pickFromTest' Set.empty+ where+   pickFromTest' :: Set Int -> PropertyM IO Bool+   pickFromTest' onesWeveSeenSoFar = do+      if ourList == onesWeveSeenSoFar+         then pure True+         else do+            nextVal <- run $ pickOne $ Set.toList ourList+            pickFromTest' (Set.insert nextVal onesWeveSeenSoFar)+