random-cycle 0.1.0.1 → 0.1.1.0

raw patch · 8 files changed

+73/−29 lines, 8 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• benches/Main.hs +1/−8
• benches/RunTimes.hs +1/−1
• random-cycle.cabal +2/−2
• src/RandomCycle/List.hs +11/−6
• src/RandomCycle/List/Partition.hs +5/−8
• src/RandomCycle/Vector.hs +1/−0
• src/RandomCycle/Vector/Cycle.hs +47/−4

@@ -1,5 +1,10 @@ # Revision history for random-cycle +## 0.1.1.0 -- 2023-05-07++* Adds Sattolo's algorithm to sample full cycles.+* Documentation fixes.+ ## 0.1.0.1 -- 2023-04-18  * Documentation fixes and base package bounds loosened.

@@ -10,7 +10,7 @@ {- Partitions -}  rtPartitionBench :: Benchmark-rtPartitionBench = bgroup "partitions: Run times" $ concat [rtPartitionRL, rtPartitionWithLocRL, rtPartitionRV]+rtPartitionBench = bgroup "partitions: Run times" $ concat [rtPartitionRL, rtPartitionRV, rtPartitionWithLocRL]  rtPartitionRL :: [Benchmark] rtPartitionRL =@@ -33,14 +33,7 @@   where     msg = "uniformPartitionRV: m = 0, n = " --- rtPartitionList :: [Benchmark]--- rtPartitionList = map (\m -> bench (msg ++ show m ++ ", n = 100") $ nf (`uniformPartitionList` list100) m) $ take 4 $ orderSeq 100---  where---    msg = "uniformPartitionList: m = "- {- Cycles -}---- TODO: return it when Vector impl is done.  rtCycleBench :: Benchmark rtCycleBench =

@@ -35,7 +35,7 @@ rule = (>= 2) . sum  uniformPartitionThinRL :: [Int] -> [[Int]]-uniformPartitionThinRL xs = runStateGen_ gen (RL.uniformPartitionThin rule xs)+uniformPartitionThinRL xs = fromJust $ runStateGen_ gen (RL.uniformPartitionThin maxit rule xs)  -- Vector 

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               random-cycle-version:            0.1.0.1+version:            0.1.1.0 synopsis: Uniform draws of partitions and cycle-partitions, with thinning.  description: @@ -33,7 +33,7 @@       RandomCycle.Vector.Partition       RandomCycle.Vector.Cycle     build-depends:    -      base >=4.14.3.0 && <= 4.17.0.0+      base >=4.14.3.0 && < 4.18.0.0       , primitive       , mwc-random       , random

@@ -6,6 +6,7 @@     partitionFromBits,      -- * Cycles+    uniformCycle,     uniformCyclePartition,     uniformCyclePartitionThin,   )@@ -17,13 +18,17 @@ import qualified RandomCycle.Vector as RV import System.Random.Stateful (StatefulGen) +-- | Implements [Sattolo's algorithm](https://algo.inria.fr/seminars/summary/Wilson2004b.pdf)+-- to sample a full cycle permutation uniformly over /(n-1)!/ possibilities in /O(n)/ time.+-- The list implementation is a convenience wrapper around 'RandomCycle.Vector.uniformCycle'.+uniformCycle :: (PrimMonad m, StatefulGen g m) => Int -> g -> m [(Int, Int)]+uniformCycle n g = V.toList <$> RV.uniformCycle n g+ -- | Sample a cycle graph partition of @[0.. n-1]@, -- uniformly over the /n!/ possibilities. The list implementation -- is a convenience wrapper around 'RandomCycle.Vector.uniformCyclePartition'. uniformCyclePartition :: (PrimMonad m, StatefulGen g m) => Int -> g -> m [(Int, Int)]-uniformCyclePartition n g = do-  v <- RV.uniformCyclePartition n g-  pure $ V.toList v+uniformCyclePartition n g = V.toList <$> RV.uniformCyclePartition n g  -- | Sample a cycle graph partition of @[0.. n-1]@, -- uniformly over the set satisfying the conditions.@@ -39,6 +44,6 @@   Int ->   g ->   m (Maybe [(Int, Int)])-uniformCyclePartitionThin maxit r n g = do-  v <- RV.uniformCyclePartitionThin maxit r n g-  pure $ V.toList <$> v+uniformCyclePartitionThin maxit r n g =+  fmap V.toList+    <$> RV.uniformCyclePartitionThin maxit r n g

@@ -33,14 +33,11 @@ -- as shown in the example. See 'RandomCycle.Vector.partitionFromBits' for other examples. -- -- >>> import GHC.Natural--- >>> :{ -- >>> allPartitions n | n < 0 = []--- >>> allPartitions n = map (`partitionFromBits` [0..n]) [0::Natural .. 2^(n-1) - 1]--- >>> }+-- >>> allPartitions n = map (`partitionFromBits` [0..n-1]) [0 .. 2^(n-1) - 1] -- >>> allPartitions 4--- [[[0,1,2,3,4]],[[0],[1,2,3,4]],[[0],[1],[2,3,4]],--- [[0,1],[2,3,4]],[[0,1],[2],[3,4]],[[0],[1],[2],[3,4]],--- [[0],[1,2],[3,4]],[[0,1,2],[3,4]]]+-- [[[0,1,2,3]],[[0],[1,2,3]],[[0],[1],[2,3]],[[0,1],[2,3]],[[0,1],[2],[3]],[[0],[1],[2],[3+-- ]],[[0],[1,2],[3]],[[0,1,2],[3]]] partitionFromBits :: Natural -> [a] -> [[a]] partitionFromBits _ [] = [] partitionFromBits bs xs =@@ -134,8 +131,8 @@ -- time linear in the length of its argument. This can be highly non-linear -- because /p/ in general is a function of /n/. ----- Some cases can perhaps be deceptively expensive: For example, the condition ((>=--- 2) .  length) leads to huge runtimes, since the number of partitions with at+-- Some cases can perhaps be deceptively expensive: For example, the condition @r = ((>=+-- 2) .  length)@ leads to huge runtimes, since the number of partitions with at -- least one element of length 1 is exponential in /n/. -- -- ==== __Examples__

@@ -4,6 +4,7 @@     partitionFromBits,      -- * Cycles+    uniformCycle,     uniformCyclePartition,     uniformCyclePartitionThin,   )

@@ -8,6 +8,7 @@ import Control.Monad.Primitive (PrimMonad, PrimState, liftPrim) import Data.STRef import qualified Data.Vector as V+import qualified Data.Vector.Mutable as MV import System.Random.MWC.Distributions (uniformPermutation, uniformShuffleM) import System.Random.Stateful @@ -44,17 +45,59 @@       uniformCyclePartitionThinM chk maxit r v gen   pure () +-- | Internal. Helper for'uniformCycle'. Caller's responsibility to ensure+-- first input is the length of the vector, and that i ranges over @[0..n-2]@.+-- At the moment, it favors 'MV.swap' over 'MV.unsafeSwap' to maintain bounds+-- checks.+swapIt ::+  (StatefulGen g m, PrimMonad m) =>+  -- | Vector length.+  Int ->+  -- | Vector to modify.+  MV.MVector (PrimState m) Int ->+  -- | Generator.+  g ->+  -- | Index.+  Int ->+  m ()+swapIt n mv g i = do+  let m = n - 2 - i+  j <- uniformRM (0, m) g+  MV.swap mv j (m + 1)+ {- RANDOM -} --- TODO: uniform (full) cycle with [Sattolo's algorithm](https://algo.inria.fr/seminars/summary/Wilson2004b.pdf)--- uniformCycle+-- | Implements [Sattolo's algorithm](https://algo.inria.fr/seminars/summary/Wilson2004b.pdf)+-- to sample a full cycle permutation uniformly over /(n-1)!/ possibilities in /O(n)/ time.+-- The algorithm is nearly identical to the Fisher-Yates shuffle on @[0..n-1]@, and therefore+-- this implementation is very similar to that of 'uniformPermutation'.+--+-- This will throw an exception with syntax analogous to 'uniformPermutation'+-- if the provided size is negative.+--+-- ==== __Examples__+--+-- >>> import System.Random.Stateful+-- >>> import RandomCycle.Vector+-- >>> runSTGen_ (mkStdGen 1901) $ uniformCycle 4+-- [(0,3),(1,0),(2,1),(3,2)]+uniformCycle ::+  (StatefulGen g m, PrimMonad m) =>+  -- | Size /n/ of cycle.+  Int ->+  g ->+  m (V.Vector (Int, Int))+uniformCycle n _ | n < 0 = error "RandomCycle.Vector.Cycle: size must be >= 0"+uniformCycle n gen = do+  mv <- MV.generateM n pure+  mapM_ (swapIt n mv gen) [0 .. n - 2]+  V.indexed <$> V.freeze mv  -- | Select a partition of @[0..n-1]@ into disjoint --  [cycle graphs](https://en.wikipedia.org/wiki/Cycle_graph), --  uniformly over the /n!/ possibilities. The sampler relies on the fact that such --  partitions are isomorphic with the permutations of @[0..n-1]@ via the map sending---  a permutation /\sigma/ to the edge set /\{(i, \sigma(i))\}_0^{n-1}/. In other words,---  the cycle partition graphs are isomorphic with the rotation matrices.+--  a permutation /\sigma/ to the edge set /\{(i, \sigma(i))\}_0^{n-1}/. -- --  Therefore, this function simply calls 'uniformPermutation' and tuples the result with its --  indices. The returned value is a vector of edges. /O(n)/, since 'uniformPermutation'