-- | This module prvodies the randomizeList function, which randomizes Sortable
--   lists.
module Data.Tensort.Utils.RandomizeList (randomizeList) where

import Data.Tensort.Utils.Types (Sortable (..))
import System.Random (mkStdGen)
import System.Random.Shuffle (shuffle')

-- | Takes a seed for random generation and a Sortable list and returns a new
--   Sortable list with the same elements as the input list but in a random
--   order.

-- | ==== __Examples__
-- >>> randomizeList 143 (SortBit [4, 8, 15, 16, 23, 42])
-- SortBit [16,23,4,8,15,42]
--
-- >>> randomizeList 143 (SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)])
-- SortRec [(1,16),(5,23),(2,4),(3,8),(0,15),(4,42)]
randomizeList :: Int -> Sortable -> Sortable
randomizeList :: Int -> Sortable -> Sortable
randomizeList Int
seed (SortBit [Int]
xs) = [Int] -> Sortable
SortBit ([Int] -> Int -> StdGen -> [Int]
forall gen a. RandomGen gen => [a] -> Int -> gen -> [a]
shuffle' [Int]
xs ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs) (Int -> StdGen
mkStdGen Int
seed))
randomizeList Int
seed (SortRec [Record]
xs) = [Record] -> Sortable
SortRec ([Record] -> Int -> StdGen -> [Record]
forall gen a. RandomGen gen => [a] -> Int -> gen -> [a]
shuffle' [Record]
xs ([Record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Record]
xs) (Int -> StdGen
mkStdGen Int
seed))