-- | Module for randomizing the order of elements in a list.
--   Used to generate randomized lists for table-based random generation
module RealDice.Manipulate.RandomizeList
  ( randomizeList,
    randomizeWithCustomBools,
  )
where

import Control.Monad.State
import RealDice.Generate.BalancedTables (rdBoolsPrime)
import RealDice.Manipulate.GetValueFromRNGTable (getBoolByIndex)

-- | Stores the index of the next value to return from a randomized list
data RandomState where
  RandomState :: {RandomState -> Int
index :: Int} -> RandomState

-- | Randomizes the order of a list of integers using the default balanced
--   table of RealDice randomized booleans

-- | ==== __Examples__
--   >>> randomizeList [1, 2, 3, 4, 5]
--   [5,3,1,2,4]
randomizeList :: [Int] -> [Int]
randomizeList :: [Int] -> [Int]
randomizeList [Int]
xs = [Int] -> [Bool] -> [Int]
randomizeWithCustomBools [Int]
xs [Bool]
rdBoolsPrime

-- | Randomizes the order of a list of integers using a custom list of booleans

-- | ==== __Examples__
--   >>> randomizeWithCustomBools [1, 2, 3, 4, 5] [True, False, False, True, True]
--   [5,4,1,2,3]
randomizeWithCustomBools :: [Int] -> [Bool] -> [Int]
randomizeWithCustomBools :: [Int] -> [Bool] -> [Int]
randomizeWithCustomBools [Int]
xs [Bool]
boolList =
  State RandomState [Int] -> RandomState -> [Int]
forall s a. State s a -> s -> a
evalState
    ([Int] -> [Int] -> [Bool] -> State RandomState [Int]
randomizeListWithCustomBoolListSinglePass [Int]
xs [] [Bool]
boolList)
    (Int -> RandomState
RandomState Int
0)

randomizeListWithCustomBoolListSinglePass ::
  [Int] -> [Int] -> [Bool] -> State RandomState [Int]
randomizeListWithCustomBoolListSinglePass :: [Int] -> [Int] -> [Bool] -> State RandomState [Int]
randomizeListWithCustomBoolListSinglePass [] [Int]
l' [Bool]
_ = [Int] -> State RandomState [Int]
forall a. a -> StateT RandomState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
l'
randomizeListWithCustomBoolListSinglePass [Int]
l [Int]
l' [Bool]
boolList = do
  RandomState
random <- StateT RandomState Identity RandomState
forall s (m :: * -> *). MonadState s m => m s
get
  RandomState -> StateT RandomState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put RandomState {index :: Int
index = RandomState -> Int
index RandomState
random Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
  if Int -> [Bool] -> Bool
getBoolByIndex (RandomState -> Int
index RandomState
random) [Bool]
boolList
    then
      [Int] -> [Int] -> [Bool] -> State RandomState [Int]
randomizeListWithCustomBoolListSinglePass
        (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
l)
        ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
l Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
l')
        [Bool]
boolList
    else
      [Int] -> [Int] -> [Bool] -> State RandomState [Int]
randomizeListWithCustomBoolListSinglePass
        (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
1 [Int]
l)
        ([Int]
l' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [[Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int]
l])
        [Bool]
boolList