module RunTimes where

import Data.List (maximum)
import Data.Maybe (fromJust)
import Data.Vector (Vector)
import qualified Data.Vector as V
import RandomCycle.List (uniformCyclePartition)
import qualified RandomCycle.List as RL
import qualified RandomCycle.Vector as RV
import System.Random.Stateful

gen = mkStdGen 0

{- Partitions -}

-- List

-- /O(nm)/ in uniformPartitionList, where 'm' is the number of partitions
-- "consumed."
-- uniformPartitionList :: Int -> [Int] -> [[[Int]]]
-- uniformPartitionList m xs = take m $ fst $ runStateGen gen (RL.uniformPartitionList xs)

-- /O(n)/ RL.uniformPartition
uniformPartitionRL :: [Int] -> [[Int]]
uniformPartitionRL xs = runStateGen_ gen (RL.uniformPartition xs)

-- /O(n\/p)/ RL.uniformPartitionThin where rule is a local condition. /p/
-- is the probability @all rule yss == True@ for a uniformly chosen partition
-- yss.
-- This can be deceptively expensive: For example, the condition ((>= 2) .
-- length) leads to huge runtimes, since the number of partitions of [1..n]
-- with at least one element of length 1 is large.
-- IMPORTANT: You must guarantee here the function terminates on the input.
-- You
rule = (>= 2) . sum

uniformPartitionThinRL :: [Int] -> [[Int]]
uniformPartitionThinRL xs = runStateGen_ gen (RL.uniformPartitionThin rule xs)

-- Vector

-- /O(n)/ RV.uniformPartition
uniformPartitionRV :: Vector Int -> [Vector Int]
uniformPartitionRV xs = runStateGen_ gen (RV.uniformPartition xs)

{- Cycles -}

-- List
--
-- NOTE: The list impl. for now is just a convenience wrapper around
-- the vector impl. No need to benchmark it.

-- Vector

-- /O(n)/. In effect a demonstration of linear runtime for 'uniformPermutation'
-- from mwc-random.
uniformCyclePartitionRV :: Int -> Vector (Int, Int)
uniformCyclePartitionRV n = runSTGen_ gen (RV.uniformCyclePartition n)

-- max iterations allowed for cycle sampler.
maxit = 100000

-- We want this to fail if no matches are found in maxit tries
uniformCyclePartitionThinRVnoSelf :: Int -> Vector (Int, Int)
uniformCyclePartitionThinRVnoSelf n =
  fromJust $
    runSTGen_ gen (RV.uniformCyclePartitionThin maxit noSelf n)

uniformCyclePartitionThinRVsimpleEdgeRules :: Int -> Vector (Int, Int)
uniformCyclePartitionThinRVsimpleEdgeRules n =
  fromJust $
    runSTGen_ gen (RV.uniformCyclePartitionThin maxit simpleEdgeRules n)

-- NOTE: copied from tests.
-- You must ensure the predicate check 'all' of them has non-empty support.
minN :: Int
minN = 3

noSelf :: (Int, Int) -> Bool
noSelf = uncurry (/=)

-- NOTE: This list requires the number of vertices to be > 2
-- for there to exist a solution.
simpleEdgeRules :: (Int, Int) -> Bool
simpleEdgeRules e = all ($ e) [noSelf, no12]
  where
    no12 (1, 2) = False
    no12 _ = True