gp loop errors out, time to debug this
This commit is contained in:
parent
06eac6eba4
commit
08c1e3e068
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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",
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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]
|
||||
]
|
||||
|
||||
24
src/HushGP/PushTests/TestStates.hs
Normal file
24
src/HushGP/PushTests/TestStates.hs
Normal file
@ -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
|
||||
}
|
||||
|
||||
3
src/HushGP/PushTests/VectorIntTests.hs
Normal file
3
src/HushGP/PushTests/VectorIntTests.hs
Normal file
@ -0,0 +1,3 @@
|
||||
module HushGP.PushTests.VectorIntTests where
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user