Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- uniformPartition :: (Vector v a, StatefulGen g m) => v a -> g -> m [v a]
- partitionFromBits :: Vector v a => Natural -> v a -> [v a]
- uniformCyclePartition :: (StatefulGen g m, PrimMonad m) => Int -> g -> m (Vector (Int, Int))
- uniformCyclePartitionThin :: (StatefulGen g m, PrimMonad m) => Int -> ((Int, Int) -> Bool) -> Int -> g -> m (Maybe (Vector (Int, Int)))
Documentation
uniformPartition :: (Vector v a, StatefulGen g m) => v a -> g -> m [v a] Source #
Draw a random partition of the input vector xs
from the uniform
distribution on partitions. This proceeds by randomizing the placement of
each breakpoint, in other words by walking a random path in a perfect binary
tree. O(n) for a vector length n.
This function preserves the order of the input list.
partitionFromBits :: Vector v a => Natural -> v a -> [v a] Source #
Partition a vector v
according to groupings provided by the bits bs
.
If the first set bit in bs
is at a position larger than the last index of
v
, this returns [v]
. More generally, bits set at positions after the
last index of v
do not contribute to the grouping. bs == 0
always
results in [v]
.
See partitionFromBits
for other examples.
>>>
import qualified Data.Vector as V
>>>
partitionFromBits 5 (V.fromList [0..2::Int])
[[0],[1],[2]]>>>
partitionFromBits 13 (V.fromList [0..2::Int])
[[0],[1],[2]]>>>
partitionFromBits 4 (V.fromList [0..2::Int])
[[0,1],[2]]>>>
partitionFromBits 8 (V.fromList [0..2::Int])
[[0,1,2]]
uniformCyclePartition :: (StatefulGen g m, PrimMonad m) => Int -> g -> m (Vector (Int, Int)) Source #
Select a partition of '[0..n-1]' into disjoint cycle graphs, 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.
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
implements the Fisher-Yates shuffle.
uniformPermutation
uses in-place mutation, so this function must be run in a PrimMonad
context.
Examples
>>>
import System.Random.Stateful
>>>
import RandomCycle.Vector
>>>
import Data.Vector (Vector)
>>>
runSTGen_ (mkStdGen 1305) $ RV.uniformCyclePartition 4 :: Vector (Int, Int)
[(0,1),(1,3),(2,2),(3,0)]
uniformCyclePartitionThin :: (StatefulGen g m, PrimMonad m) => Int -> ((Int, Int) -> Bool) -> Int -> g -> m (Maybe (Vector (Int, Int))) Source #
Uniform selection of a cycle partition graph of '[0..n-1]' elements,
conditional on an edge-wise predicate. See uniformCyclePartition
for
details on the sampler.
O(n/p), where p is the probability that a uniformly sampled cycle partition graph (over all n! possible) satisfies the conditions. This can be highly non-linear since p in general is a function of n.
Since this is a rejection sampling method, the user is asked to provide a counter for the maximum number of sampling attempts in order to guarantee termination in cases where the edge predicate has probability of success close to zero.
Note this will return 'pure Nothing' if given a number of vertices that is
non-positive, in the third argument, unlike uniformCyclePartition
which
will throw an error.