From 08c1e3e068a902a8591979d6e2006c0f4c016fbc Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Sat, 8 Mar 2025 23:49:22 -0600 Subject: [PATCH] gp loop errors out, time to debug this --- HushGP.cabal | 4 +- src/HushGP/GP.hs | 11 ++- src/HushGP/GP/Downsample.hs | 11 ++- src/HushGP/GP/Selection.hs | 7 +- src/HushGP/GP/Simplification.hs | 3 +- src/HushGP/Problems/IntegerRegression.hs | 7 +- src/HushGP/PushTests/GenericTests.hs | 52 ++++++------- src/HushGP/PushTests/IntTests.hs | 29 +++++-- src/HushGP/PushTests/TestStates.hs | 24 ++++++ src/HushGP/PushTests/VectorIntTests.hs | 3 + src/HushGP/State.hs | 98 ++++++++++-------------- src/HushGP/Tools/Metrics.hs | 3 +- 12 files changed, 137 insertions(+), 115 deletions(-) create mode 100644 src/HushGP/PushTests/TestStates.hs create mode 100644 src/HushGP/PushTests/VectorIntTests.hs diff --git a/HushGP.cabal b/HushGP.cabal index 0814b2b..5bccd10 100644 --- a/HushGP.cabal +++ b/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 diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 3b82239..eca0788 100644 --- a/src/HushGP/GP.hs +++ b/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. diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs index b54742e..623ccf5 100644 --- a/src/HushGP/GP/Downsample.hs +++ b/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 diff --git a/src/HushGP/GP/Selection.hs b/src/HushGP/GP/Selection.hs index 692a750..8143221 100644 --- a/src/HushGP/GP/Selection.hs +++ b/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. diff --git a/src/HushGP/GP/Simplification.hs b/src/HushGP/GP/Simplification.hs index b7e0dd9..9e46e78 100644 --- a/src/HushGP/GP/Simplification.hs +++ b/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 diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index bcd06b6..15347a2 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/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, - populationSize = 1000, + maxGenerations = 200, + populationSize = 100, maxInitialPlushySize = 100, stepLimit = 200, parentSelectionAlgo = "lexicase", diff --git a/src/HushGP/PushTests/GenericTests.hs b/src/HushGP/PushTests/GenericTests.hs index dddd508..2088a5e 100644 --- a/src/HushGP/PushTests/GenericTests.hs +++ b/src/HushGP/PushTests/GenericTests.hs @@ -1,8 +1,8 @@ module HushGP.PushTests.GenericTests where -import HushGP.State -import Control.Lens -import Test.Tasty.QuickCheck +-- import HushGP.State +-- import Control.Lens +-- 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 accessor instruction ltAmt state - | length (view accessor state) < ltAmt = state === instruction state - | otherwise = state =/= instruction state +-- diff1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> Int -> State -> Property +-- diff1Test accessor instruction ltAmt state +-- | length (view accessor state) < ltAmt = state === instruction state +-- | otherwise = state =/= instruction state --- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property --- aa1Test accessor instruction transformation state = --- 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) --- _ -> state === instruction state +-- -- aa1Test :: (Show a, Eq a) => Lens' State [a] -> (State -> State) -> (a -> a) -> State -> Property +-- -- aa1Test accessor instruction transformation state = +-- -- 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) +-- -- _ -> state === instruction state --- | 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. -diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> State -> Property -diff2Test accessorFrom accessorTo instruction ltAmt state - | length (view accessorFrom state) < ltAmt = state === instruction state - | otherwise = length (view accessorTo $ instruction state) =/= length (view accessorTo state) .&&. - length (view accessorFrom $ instruction state) =/= length (view accessorFrom state) +-- -- | 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. +-- diff2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> Int -> State -> Property +-- diff2Test accessorFrom accessorTo instruction ltAmt state +-- | length (view accessorFrom state) < ltAmt = state === instruction state +-- | otherwise = length (view accessorTo $ instruction state) =/= length (view accessorTo 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 accessorFrom accessorTo instruction 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) - 2 - _ -> state === instruction state +-- aab2Test :: (Show b, Eq b) => Lens' State [a] -> Lens' State [b] -> (State -> State) -> State -> Property +-- aab2Test accessorFrom accessorTo instruction 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) - 2 +-- _ -> state === instruction state -- popTest :: (Show a) => Lens' State [a] -> (State -> State) -> State -> Property -- popTest accessor instruction state = diff --git a/src/HushGP/PushTests/IntTests.hs b/src/HushGP/PushTests/IntTests.hs index 728d960..9f674d8 100644 --- a/src/HushGP/PushTests/IntTests.hs +++ b/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 System.Environment +import HushGP.PushTests.TestStates +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_VERBOSE" "False" + -- setEnv "TASTY_QUICKCHECK_MAX_SIZE" "10" + -- 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] + ] diff --git a/src/HushGP/PushTests/TestStates.hs b/src/HushGP/PushTests/TestStates.hs new file mode 100644 index 0000000..c5f4c05 --- /dev/null +++ b/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 + } + diff --git a/src/HushGP/PushTests/VectorIntTests.hs b/src/HushGP/PushTests/VectorIntTests.hs new file mode 100644 index 0000000..8b131f9 --- /dev/null +++ b/src/HushGP/PushTests/VectorIntTests.hs @@ -0,0 +1,3 @@ +module HushGP.PushTests.VectorIntTests where + + diff --git a/src/HushGP/State.hs b/src/HushGP/State.hs index de6432e..f5c3902 100644 --- a/src/HushGP/State.hs +++ b/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 - coarbitrary _ gen = gen +-- instance CoArbitrary StdGen where +-- coarbitrary _ gen = gen -instance CoArbitrary Gene +-- instance CoArbitrary Gene -instance Arbitrary Gene where - arbitrary = - oneof - [ GeneInt <$> arbitrary, - GeneFloat <$> arbitrary, - GeneBool <$> arbitrary, - GeneString <$> arbitrary, - GeneChar <$> arbitrary, - StateFunc <$> arbitrary, - -- PlaceInput <$> arbitrary, - GeneVectorInt <$> arbitrary, - GeneVectorFloat <$> arbitrary, - GeneVectorBool <$> arbitrary, - GeneVectorString <$> arbitrary, - GeneVectorChar <$> arbitrary, - Block <$> arbitrary - ] +-- instance Arbitrary Gene where +-- arbitrary = +-- oneof +-- [ GeneInt <$> arbitrary, +-- GeneFloat <$> arbitrary, +-- GeneBool <$> arbitrary, +-- GeneString <$> arbitrary, +-- GeneChar <$> arbitrary, +-- StateFunc <$> arbitrary, +-- -- PlaceInput <$> arbitrary, +-- GeneVectorInt <$> arbitrary, +-- GeneVectorFloat <$> arbitrary, +-- GeneVectorBool <$> arbitrary, +-- GeneVectorString <$> arbitrary, +-- GeneVectorChar <$> 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 - arbitrary = do - arbExec <- arbitrary - arbCode <- arbitrary - arbInt <- arbitrary - arbFloat <- arbitrary - arbBool <- arbitrary - arbString <- arbitrary - arbChar <- arbitrary - arbVectorInt <- arbitrary - arbVectorFloat <- arbitrary - arbVectorBool <- arbitrary - arbVectorString <- arbitrary - arbVectorChar <- arbitrary - arbParameter <- arbitrary - -- arbInput <- arbitrary - State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary --- Thanks hlint lol +-- instance Arbitrary State where +-- arbitrary = do +-- arbExec <- arbitrary +-- arbCode <- arbitrary +-- arbInt <- arbitrary +-- arbFloat <- arbitrary +-- arbBool <- arbitrary +-- arbString <- arbitrary +-- arbChar <- arbitrary +-- arbVectorInt <- arbitrary +-- arbVectorFloat <- arbitrary +-- arbVectorBool <- arbitrary +-- arbVectorString <- arbitrary +-- arbVectorChar <- arbitrary +-- arbParameter <- arbitrary +-- -- arbInput <- arbitrary +-- State arbExec arbCode arbInt arbFloat arbBool arbString arbChar arbVectorInt arbVectorFloat arbVectorBool arbVectorString arbVectorChar arbParameter <$> arbitrary +-- -- 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) diff --git a/src/HushGP/Tools/Metrics.hs b/src/HushGP/Tools/Metrics.hs index e46e300..0b14d4b 100644 --- a/src/HushGP/Tools/Metrics.hs +++ b/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.