gp loop errors out, time to debug this

HushGP.cabal

@@ -58,8 +58,10 @@ library
                     , HushGP.Instructions.Opens
                     , HushGP.PushTests
                     , HushGP.PushTests.IntTests
+                    , HushGP.PushTests.VectorIntTests
                     , HushGP.PushTests.GenericTests
                     , HushGP.PushTests.UtilTests
+                    , HushGP.PushTests.TestStates
                     , HushGP.PushTests.GP.Selection
                     , HushGP.GP
                     , HushGP.GP.PushArgs
@@ -81,7 +83,7 @@ library
 
     -- Other library packages from which modules are imported.
     build-depends:
-        base, containers, lens, split, regex-tdfa, template-haskell, random, parallel, random-shuffle, dsp, hmatrix, tasty, tasty-hunit, tasty-quickcheck
+        base, containers, lens, split, regex-tdfa, template-haskell, random >= 1.3.0, parallel, dsp, hmatrix, tasty, tasty-hunit
 
     -- Directories containing source files.
     hs-source-dirs:   src

src/HushGP/GP.hs

@@ -13,7 +13,6 @@ import HushGP.GP.Simplification
 import HushGP.GP.Variation
 import HushGP.Genome
 import System.Random
-import System.Random.Shuffle
 
 -- import Debug.Trace (trace, traceStack)
 
@@ -53,10 +52,9 @@ gpLoop'
   evaluations
   population
   indexedTrainingData = do
-    print "Put information about each generation here."
     when bestIndPassesDownsample $ print $ "Semi Success Generation: " <> show generation
     parentReps <- do
-      shuffledParents <- shuffle' population (length population) <$> initStdGen
+      shuffledParents <- fst . uniformShuffleList population <$> initStdGen
       if enableDS && (generation `mod` dsParentGens == 0)
         then pure $ take (floor @Float (dsParentRate * (fromIntegral @Int @Float $ length population))) shuffledParents
         else pure []
@@ -79,7 +77,8 @@ gpLoop'
                     print $ "Simplified program: " <> show (plushyToPush pushArgs simplifiedPlushy)
                     print $ "Total simplified test error: " <> show (errorFunc epsilonPushArgs teData simplifiedPlushy)
           | (not enableDS && (generation >= maxGens))
-              || (enableDS && (evaluations >= (maxGens * length population * length indexedTrainingData))) =
+              || (enableDS && (evaluations >= (maxGens * length population * length indexedTrainingData))) = do
+              print $ "Max gens: " <> show maxGens
               print $ "Best individual: " <> show (plushy bestInd)
           | otherwise = do
               newPop <- if isElite then replicateM (popSize - 1) (newIndividual epsilonPushArgs evaledPop) else replicateM popSize (newIndividual epsilonPushArgs evaledPop)
@@ -99,6 +98,10 @@ gpLoop'
                     then updateCaseDistances repEvaluatedPop indexedTrainingData indexedTrainingData (informedDownsamplingType pushArgs) (seThresh / fromIntegral @Int @Double (length indexedTrainingData))
                     else indexedTrainingData
                 )
+    print ("Generation: " <> show generation)
+    print ("Len Population: " <> show (length population))
+    print ("Best Ind: " <> show (plushy bestInd) <> " : " <> show (totalFitness bestInd))
+    print "----------------------------------------------"
     nextAction
     where
       -- \| This will have downsampling functionality added later.

src/HushGP/GP/Downsample.hs

@@ -1,6 +1,5 @@
 module HushGP.GP.Downsample where
 
-import System.Random.Shuffle
 import System.Random
 import Data.List
 import Data.Maybe
@@ -21,13 +20,13 @@ initializeCaseDistances (PushArgs {trainingData = tData, populationSize = popSiz
 
 -- |Draws a random amount of data points from a passed list of data points.
 selectDownsampleRandom :: PushArgs -> [PushData] -> IO [PushData]
-selectDownsampleRandom (PushArgs {downsampleRate = dsRate}) pushData = take (floor (dsRate * fromIntegral @Int @Float (length pushData))) . shuffle' pushData (length pushData) <$> initStdGen
+selectDownsampleRandom (PushArgs {downsampleRate = dsRate}) pushData = take (floor (dsRate * fromIntegral @Int @Float (length pushData))) . fst . uniformShuffleList pushData <$> initStdGen
 
 -- |Selects a downsample that has it's cases maximally far away by sequentially
 -- adding cases to the downsample that have their closest case maximally far away.
 selectDownsampleMaxmin :: PushArgs -> [PushData] -> IO [PushData]
 selectDownsampleMaxmin (PushArgs {downsampleRate = dsRate}) pushData = do
-  shuffledCases <- shuffle' pushData (length pushData) <$> initStdGen
+  shuffledCases <- fst . uniformShuffleList pushData <$> initStdGen
   let goalSize = floor @Float @Int (dsRate * (fromIntegral @Int @Float $ length pushData))
   selectDownsampleMaxmin'
     (case uncons shuffledCases of (Just (x, _)) -> [x]; _ -> error "error: shuffledCases empty!")
@@ -49,7 +48,7 @@ selectDownsampleMaxmin' newDownsample casesToPickFrom goalSize
       stdGen <- initStdGen
       selectDownsampleMaxmin'
         ((casesToPickFrom !! selectedCaseIndex) : newDownsample)
-        (shuffle' (deleteAt selectedCaseIndex casesToPickFrom) (length casesToPickFrom - 1) stdGen)
+        (fst $ uniformShuffleList (deleteAt selectedCaseIndex casesToPickFrom) stdGen)
         goalSize
 
 -- |selects a downsample that has it's cases maximally far away by sequentially 
@@ -57,7 +56,7 @@ selectDownsampleMaxmin' newDownsample casesToPickFrom goalSize
 -- automatically stops when the maximum minimum distance is below delta
 selectDownsampleMaxminAdaptive :: PushArgs -> [PushData] -> IO [PushData]
 selectDownsampleMaxminAdaptive (PushArgs {caseDelta = cDelta}) pushData = do
-  shuffledCases <- shuffle' pushData (length pushData) <$> initStdGen
+  shuffledCases <- fst . uniformShuffleList pushData <$> initStdGen
   selectDownsampleMaxminAdaptive'
     (case uncons shuffledCases of (Just (x, _)) -> [x]; _ -> error "error: shuffledCases empty!")
     (drop 1 shuffledCases)
@@ -78,7 +77,7 @@ selectDownsampleMaxminAdaptive' newDownsample casesToPickFrom cDelta = do
       then pure newDownsample
       else selectDownsampleMaxminAdaptive'
             ((casesToPickFrom !! selectedCaseIndex) : newDownsample)
-            (shuffle' (deleteAt selectedCaseIndex casesToPickFrom) (length casesToPickFrom - 1) stdGen)
+            (fst $ uniformShuffleList (deleteAt selectedCaseIndex casesToPickFrom) stdGen)
             cDelta
 
 -- |Returns the distance between two cases given a list of individual error vectors, and the index these

src/HushGP/GP/Selection.hs

@@ -4,7 +4,6 @@ import Numeric.Statistics.Median (medianFast)
 import Data.List
 import Data.Maybe
 import System.Random
-import System.Random.Shuffle
 import HushGP.GP.PushArgs
 import HushGP.GP.Individual
 import HushGP.Utility
@@ -13,7 +12,7 @@ import HushGP.Utility
 -- Takes the individual with the lowest total error in the tournament.
 tournamentSelection :: PushArgs -> [Individual] -> IO Individual
 tournamentSelection PushArgs{tournamentSize = tSize} pop = do
-  shuffledPop <- shuffle' pop (length pop) <$> initStdGen
+  shuffledPop <- fst. uniformShuffleList pop <$> initStdGen
   let tournSet = take tSize shuffledPop
   pure $ minimum tournSet
 
@@ -23,7 +22,7 @@ tournamentSelection PushArgs{tournamentSize = tSize} pop = do
 -- until a single individual remains. This is the top level function.
 lexicaseSelection :: PushArgs -> [Individual] -> IO Individual
 lexicaseSelection PushArgs{initialCases = iCases} pop = do
-  startCases <- maybe (shuffle' [0..lehp] lehp <$> initStdGen) (pure @IO) iCases
+  startCases <- maybe (fst . uniformShuffleList [0..lehp] <$> initStdGen) (pure @IO) iCases
   survivors <- mapM randElem (groupBy (\x y -> fitnessCases x == fitnessCases y) pop)
   lexicaseSelection' survivors startCases startCases
   where
@@ -74,7 +73,7 @@ epsilonList' epsilons index errorList errorLength =
 -- for a test case, only individuals with an error outside of a predefined epsilon are filtered.
 epsilonLexicaseSelection :: PushArgs -> [Individual] -> IO Individual
 epsilonLexicaseSelection PushArgs{epsilons = eps} pop = do
-  startCases <- shuffle' [0..lehp] lehp <$> initStdGen
+  startCases <- fst . uniformShuffleList [0..lehp] <$> initStdGen
   epsilonLexicaseSelection' (fromMaybe (error "Error: epsilons list is empty!") eps) pop startCases
   where
     lehp :: Int -- length of the extracted fitness cases of the head of the passed population.

src/HushGP/GP/Simplification.hs

@@ -1,6 +1,5 @@
 module HushGP.GP.Simplification where
 
-import System.Random.Shuffle
 import System.Random
 import Control.Monad
 import Data.List
@@ -23,7 +22,7 @@ deleteAtMultiple' curr (idx:idxs) (plushyPiece:plushy) =
 -- | Deletes a random amount of genes from the passed plushy based on ant int.
 deleteRandomAmt :: Int -> [Gene] -> IO [Gene]
 deleteRandomAmt k plushy = do
-  randomIndicies <- take k . shuffle' [0..(length plushy - 1)] (length plushy) <$> initStdGen
+  randomIndicies <- take k . fst . uniformShuffleList [0..(length plushy - 1)] <$> initStdGen
   pure $ deleteAtMultiple randomIndicies plushy
 
 -- | Simplifies a Plushy by randomly deleting instructions and seeing how it impacts

src/HushGP/Problems/IntegerRegression.hs

@@ -42,7 +42,8 @@ intSolutionPlushy =
 -- is trying to evolve.
 targetFunction :: Integer -> Integer
 -- targetFunction x = (x * x * x) + (2 * x) + 6
-targetFunction x = x * x * x
+targetFunction x = (x * x * x) + (2 * x)
+-- targetFunction x = x * x * x
 
 -- | The training data for the model.
 intTrainData :: [PushData]
@@ -101,8 +102,8 @@ intPushArgs = defaultPushArgs
     errorFunction = intErrorFunction,
     trainingData = intTrainData,
     testingData = intTestData,
-    maxGenerations = 300,
+    maxGenerations = 200,
-    populationSize = 1000,
+    populationSize = 100,
     maxInitialPlushySize = 100,
     stepLimit = 200,
     parentSelectionAlgo = "lexicase",

src/HushGP/PushTests/GenericTests.hs

@@ -1,8 +1,8 @@
 module HushGP.PushTests.GenericTests where
 
-import HushGP.State
+-- import HushGP.State
-import Control.Lens
+-- import Control.Lens
-import Test.Tasty.QuickCheck
+-- import Test.Tasty.QuickCheck
 -- -- import HushGP.Instructions.GenericInstructions
 
 -- -- The naming scheme:
@@ -18,37 +18,37 @@ import Test.Tasty.QuickCheck
 -- Based on a primitive lens. Should only be used with functions that modify the length of one stack
 -- by one. The first Int specifies what size the stacks should differ by. The second Int
 -- specifies how many intial items should be in the stack to not be considered a no-op.
-diff1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> Int -> State -> Property
+-- diff1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> Int -> State -> Property
-diff1Test accessor instruction ltAmt state
+-- diff1Test accessor instruction ltAmt state
-  | length (view accessor state) < ltAmt = state === instruction state
+--   | length (view accessor state) < ltAmt = state === instruction state
-  | otherwise = state =/= instruction state
+--   | otherwise = state =/= instruction state
 
--- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property
+-- -- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property
--- aa1Test accessor instruction transformation state =
+-- -- aa1Test accessor instruction transformation state =
---   case (uncons (view accessor state), uncons (view accessor $ instruction state)) of
+-- --   case (uncons (view accessor state), uncons (view accessor $ instruction state)) of
---     (Just (origx1, _), Just (modx1, _)) -> transformation origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state)
+-- --     (Just (origx1, _), Just (modx1, _)) -> transformation origx1 === modx1 .&&. length (view accessor state) === length (view accessor $ instruction state)
---     _ -> state === instruction state
+-- --     _ -> state === instruction state
 
--- | Test to see if the length difference between 2 separate stacks post execution if
+-- -- | Test to see if the length difference between 2 separate stacks post execution if
--- the up/down by a passed amt for the respective stats. Is used to test functions like instructionIntFromFloat.
+-- -- the up/down by a passed amt for the respective stats. Is used to test functions like instructionIntFromFloat.
-diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> State -> Property
+-- diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> State -> Property
-diff2Test accessorFrom accessorTo instruction ltAmt state
+-- diff2Test accessorFrom accessorTo instruction ltAmt state
-  | length (view accessorFrom state) < ltAmt = state === instruction state
+--   | length (view accessorFrom state) < ltAmt = state === instruction state
-  | otherwise = length (view accessorTo $ instruction state) =/= length (view accessorTo state) .&&.
+--   | otherwise = length (view accessorTo $ instruction state) =/= length (view accessorTo state) .&&.
-      length (view accessorFrom $ instruction state) =/= length (view accessorFrom state)
+--       length (view accessorFrom $ instruction state) =/= length (view accessorFrom state)
   -- case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
     -- (Just (_, _), Just (_, _)) -> 
     --   length (view accessorTo $ instruction state) === length (view accessorTo state) + 1 .&&.
     --   length (view accessorFrom $ instruction state) === length (view accessorFrom state) - 1 
     -- _ -> state === instruction state
 
-aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> State -> Property
+-- aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> State -> Property
-aab2Test accessorFrom accessorTo instruction state =
+-- aab2Test accessorFrom accessorTo instruction state =
-  case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
+--   case (uncons (view accessorTo $ instruction state), uncons (view accessorFrom state)) of
-    (Just (_, _), Just (_, _ : _)) ->
+--     (Just (_, _), Just (_, _ : _)) ->
-      length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&.
+--       length (view accessorTo $ instruction state) == length (view accessorTo state) + 1 .&&.
-      length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2       
+--       length (view accessorFrom $ instruction state) == length (view accessorFrom state) - 2       
-    _ -> state === instruction state
+--     _ -> state === instruction state
 
 -- popTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property
 -- popTest accessor instruction state = 

src/HushGP/PushTests/IntTests.hs

@@ -1,20 +1,33 @@
 module HushGP.PushTests.IntTests where
 
-import Data.Char
 import HushGP.State
-import HushGP.PushTests.GenericTests
 import HushGP.Instructions.IntInstructions
--- import Control.Lens hiding (uncons)
+import HushGP.PushTests.TestStates
-import System.Environment
+import Control.Lens hiding (uncons)
+-- import System.Environment
 import Test.Tasty
-import Test.Tasty.QuickCheck as QC
+-- import Test.Tasty.QuickCheck as QC
+import Test.Tasty.HUnit
 
 main :: IO ()
 main = do
-  setEnv "TASTY_QUICKCHECK_MAX_SIZE" "10"
+  -- setEnv "TASTY_QUICKCHECK_MAX_SIZE" "10"
-  setEnv "TASTY_QUICKCHECK_VERBOSE" "False"
+  -- setEnv "TASTY_QUICKCHECK_VERBOSE" "False"
   defaultMain intTests
 
 -- |Holds the tree for property and unit tests.
 intTests :: TestTree
-intTests = testGroup "All Int Tests" []
+intTests = testGroup "All Int Tests" [intUnitTests]
+
+intUnitTests :: TestTree
+intUnitTests = testGroup "Unit Tests"
+  [ testCase "Int DupN Success" $ view int (instructionIntDupN exampleState) @?= [5, 5, 5, 8, 9, 6, 10, 11, 15]
+  , testCase "Int DupN NoOp" $ view int (instructionIntDupN emptyState) @?= []
+  , testCase "Int Yank Success" $ view int (instructionIntYank exampleState) @?= [6, 5, 8, 9, 10, 11, 15]
+  , testCase "Int Yank NoOp" $ view int (instructionIntYank emptyState) @?= []
+  , testCase "Int Shove Success" $ view int (instructionIntShove exampleState) @?= [8, 9, 5, 6, 10, 11, 15]
+  , testCase "Int Shove NoOp" $ view int (instructionIntShove emptyState) @?= []
+  , testCase "Int ShoveDup Success" $ view int (instructionIntShoveDup exampleState) @?= [5, 8, 9, 5, 6, 10, 11, 15]
+  , testCase "Int ShoveDup NoOp" $ view int (instructionIntShoveDup emptyState) @?= []
+  , testCase "Int DupItems Success" $ view int (instructionIntDupItems exampleState) @?= [5, 8, 9, 5, 8, 9, 6, 10, 11, 15]
+  ]

src/HushGP/PushTests/TestStates.hs

@@ -0,0 +1,24 @@
+module HushGP.PushTests.TestStates where
+
+import HushGP.State
+import Data.Map qualified as Map
+
+exampleState :: State
+exampleState =
+  State
+    { _exec = [],
+      _code = [],
+      _int = [3, 5, 8, 9, 6, 10, 11, 15],
+      _float = [3.23, 9.235, 5.3211, 8.0],
+      _bool = [True, False],
+      _string = ["abc", "123"],
+      _char = ['d', 'e', 'f'],
+      _parameter = [],
+      _vectorInt = [[1, 2], [5, 6, 8]],
+      _vectorFloat = [[1.234, 9.21], [5.42, 6.221, 8.5493]],
+      _vectorBool = [[True, False], [False, False, True]],
+      _vectorString = [["this is a sentence", "this is also a sentence"], ["s0", "s1", "s2"]],
+      _vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']],
+      _input = Map.empty
+    }
+

src/HushGP/PushTests/VectorIntTests.hs

@@ -0,0 +1,3 @@
+module HushGP.PushTests.VectorIntTests where
+
+

src/HushGP/State.hs

@@ -5,7 +5,6 @@ module HushGP.State where
 import Control.Lens hiding (elements)
 import Data.Map qualified as Map
 import System.Random
-import Test.Tasty.QuickCheck
 import GHC.Generics
 
 -- | The exec stack must store heterogenous types,
@@ -158,28 +157,28 @@ instance Show Gene where
   show CrossoverPadding = "Crossover Padding"
   show Gap = "Gap"
 
-instance CoArbitrary StdGen where
+-- instance CoArbitrary StdGen where
-  coarbitrary _ gen = gen
+--   coarbitrary _ gen = gen
 
-instance CoArbitrary Gene
+-- instance CoArbitrary Gene
 
-instance Arbitrary Gene where
+-- instance Arbitrary Gene where
-  arbitrary =
+--   arbitrary =
-    oneof
+--     oneof
-      [ GeneInt <$> arbitrary,
+--       [ GeneInt <$> arbitrary,
-        GeneFloat <$> arbitrary,
+--         GeneFloat <$> arbitrary,
-        GeneBool <$> arbitrary,
+--         GeneBool <$> arbitrary,
-        GeneString <$> arbitrary,
+--         GeneString <$> arbitrary,
-        GeneChar <$> arbitrary,
+--         GeneChar <$> arbitrary,
-        StateFunc <$> arbitrary,
+--         StateFunc <$> arbitrary,
-        -- PlaceInput <$> arbitrary,
+--         -- PlaceInput <$> arbitrary,
-        GeneVectorInt <$> arbitrary,
+--         GeneVectorInt <$> arbitrary,
-        GeneVectorFloat <$> arbitrary,
+--         GeneVectorFloat <$> arbitrary,
-        GeneVectorBool <$> arbitrary,
+--         GeneVectorBool <$> arbitrary,
-        GeneVectorString <$> arbitrary,
+--         GeneVectorString <$> arbitrary,
-        GeneVectorChar <$> arbitrary,
+--         GeneVectorChar <$> arbitrary,
-        Block <$> arbitrary
+--         Block <$> arbitrary
-      ]
+--       ]
 
 -- | The structure that holds all of the values.
 data State = State
@@ -200,26 +199,26 @@ data State = State
   }
   deriving (Show, Eq, Ord, Generic)
 
-instance CoArbitrary State
+-- instance CoArbitrary State
 
-instance Arbitrary State where
+-- instance Arbitrary State where
-  arbitrary = do
+--   arbitrary = do
-    arbExec <- arbitrary
+--     arbExec <- arbitrary
-    arbCode <- arbitrary
+--     arbCode <- arbitrary
-    arbInt <- arbitrary
+--     arbInt <- arbitrary
-    arbFloat <- arbitrary
+--     arbFloat <- arbitrary
-    arbBool <- arbitrary
+--     arbBool <- arbitrary
-    arbString <- arbitrary
+--     arbString <- arbitrary
-    arbChar <- arbitrary
+--     arbChar <- arbitrary
-    arbVectorInt <- arbitrary
+--     arbVectorInt <- arbitrary
-    arbVectorFloat <- arbitrary
+--     arbVectorFloat <- arbitrary
-    arbVectorBool <- arbitrary
+--     arbVectorBool <- arbitrary
-    arbVectorString <- arbitrary
+--     arbVectorString <- arbitrary
-    arbVectorChar <- arbitrary
+--     arbVectorChar <- arbitrary
-    arbParameter <- arbitrary
+--     arbParameter <- arbitrary
-    -- arbInput <- arbitrary
+--     -- arbInput <- arbitrary
-    State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
+--     State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary
--- Thanks hlint lol
+-- -- Thanks hlint lol
 
 emptyState :: State
 emptyState =
@@ -240,25 +239,6 @@ emptyState =
       _input = Map.empty
     }
 
-exampleState :: State
-exampleState =
-  State
-    { _exec = [],
-      _code = [],
-      _int = [32, 56, 88, 91],
-      _float = [3.23, 9.235, 5.3211, 8.0],
-      _bool = [True, False],
-      _string = ["abc", "123"],
-      _char = ['d', 'e', 'f'],
-      _parameter = [],
-      _vectorInt = [[1, 2], [5, 6, 8]],
-      _vectorFloat = [[1.234, 9.21], [5.42, 6.221, 8.5493]],
-      _vectorBool = [[True, False], [False, False, True]],
-      _vectorString = [["this is a sentence", "this is also a sentence"], ["s0", "s1", "s2"]],
-      _vectorChar = [['z', 'x'], ['r', 'a', 't', 'l']],
-      _input = Map.empty
-    }
-
 -- This must stay at the end of the file.
 -- Template haskell seems to be messing with GHC.Generics
 $(makeLenses ''State)

src/HushGP/Tools/Metrics.hs

@@ -2,7 +2,6 @@ module HushGP.Tools.Metrics where
 
 import Data.List
 import System.Random
-import System.Random.Shuffle
 
 -- |Maps minimum over the transposed [[Double]].
 minOfColumns :: (Num a, Ord a) => [[a]] -> [a]
@@ -10,7 +9,7 @@ minOfColumns columns = map minimum (transpose columns)
 
 -- |Returns the index of the maximum value in a list, randomly tiebreaking.
 argMax :: Ord a => [a] -> IO Int
-argMax xs = argMaxHead . shuffle' (elemIndices (maximum xs) xs) (length xs) <$> initStdGen
+argMax xs = argMaxHead . fst . uniformShuffleList (elemIndices (maximum xs) xs) <$> initStdGen
 
 -- |Takes the first element from a list and returns an error as specified. For use with
 -- the argMax function.