module RandomCycle.List
  ( -- * Partitions
    uniformPartition,
    uniformPartitionThin,
    partitionLengths,
    partitionFromBits,

    -- * Cycles
    uniformCyclePartition,
    uniformCyclePartitionThin,
  )
where

import Control.Monad.Primitive (PrimMonad)
import qualified Data.Vector as V
import RandomCycle.List.Partition
import qualified RandomCycle.Vector as RV
import System.Random.Stateful (StatefulGen)

-- | 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 :: Int -> g -> m [(Int, Int)]
uniformCyclePartition Int
n g
g = do
  Vector (Int, Int)
v <- Int -> g -> m (Vector (Int, Int))
forall g (m :: * -> *).
(StatefulGen g m, PrimMonad m) =>
Int -> g -> m (Vector (Int, Int))
RV.uniformCyclePartition Int
n g
g
  [(Int, Int)] -> m [(Int, Int)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Int, Int)] -> m [(Int, Int)]) -> [(Int, Int)] -> m [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ Vector (Int, Int) -> [(Int, Int)]
forall a. Vector a -> [a]
V.toList Vector (Int, Int)
v

-- | Sample a cycle graph partition of @[0.. n-1]@,
-- uniformly over the set satisfying the conditions.
-- The list implementation is a convenience wrapper around
-- 'RandomCycle.Vector.uniformCyclePartitionThin'.
uniformCyclePartitionThin ::
  (PrimMonad m, StatefulGen g m) =>
  -- | maximum number of draws to attempt
  Int ->
  -- | edge-wise predicate, which all edges in the result must satisfy
  ((Int, Int) -> Bool) ->
  -- | number of vertices, which will be labeled @[0..n-1]@
  Int ->
  g ->
  m (Maybe [(Int, Int)])
uniformCyclePartitionThin :: Int -> ((Int, Int) -> Bool) -> Int -> g -> m (Maybe [(Int, Int)])
uniformCyclePartitionThin Int
maxit (Int, Int) -> Bool
r Int
n g
g = do
  Maybe (Vector (Int, Int))
v <- Int
-> ((Int, Int) -> Bool)
-> Int
-> g
-> m (Maybe (Vector (Int, Int)))
forall g (m :: * -> *).
(StatefulGen g m, PrimMonad m) =>
Int
-> ((Int, Int) -> Bool)
-> Int
-> g
-> m (Maybe (Vector (Int, Int)))
RV.uniformCyclePartitionThin Int
maxit (Int, Int) -> Bool
r Int
n g
g
  Maybe [(Int, Int)] -> m (Maybe [(Int, Int)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [(Int, Int)] -> m (Maybe [(Int, Int)]))
-> Maybe [(Int, Int)] -> m (Maybe [(Int, Int)])
forall a b. (a -> b) -> a -> b
$ Vector (Int, Int) -> [(Int, Int)]
forall a. Vector a -> [a]
V.toList (Vector (Int, Int) -> [(Int, Int)])
-> Maybe (Vector (Int, Int)) -> Maybe [(Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Vector (Int, Int))
v