Compare commits

...

2 Commits

7 changed files with 47 additions and 15 deletions

View File

@ -34,7 +34,7 @@ updateIndividual errors ind = ind {totalFitness = Just (sum errors), fitnessCase
gpLoop :: PushArgs -> IO ()
gpLoop pushArgs@(PushArgs {trainingData = tData}) = do
unEvaledPopulation <- generatePopulation pushArgs
let indexedTrainingData = assignIndiciesToData tData
let indexedTrainingData = assignIndicesToData tData
gpLoop' pushArgs 0 0 unEvaledPopulation indexedTrainingData
-- | The guts of the GP loop. Where the work gets done after the initialization happens

View File

@ -10,14 +10,14 @@ import HushGP.Tools.Metrics
import HushGP.Instructions.Utility
-- |Sets the index of the passed training data.
assignIndiciesToData :: [PushData] -> [PushData]
assignIndiciesToData oldData = zipWith (\dat idx -> dat{_downsampleIndex = Just idx}) oldData [0..]
assignIndicesToData :: [PushData] -> [PushData]
assignIndicesToData oldData = zipWith (\dat idx -> dat{_downsampleIndex = Just idx}) oldData [0..]
-- |Initializes cases distances for passed training data.
initializeCaseDistances :: PushArgs -> [PushData]
initializeCaseDistances (PushArgs {trainingData = tData, populationSize = popSize}) = [ dat{_caseDistances = Just (replicate (length tData) (fromIntegral @Int @Double popSize))} | dat <- tData ]
initializeCaseDistances (PushArgs {trainingData = tData, populationSize = popSize}) = [ dat{_caseDistances = Just (replicate (length tData) popSize)} | dat <- tData ]
-- |Updates the cases distances when downsampling
-- |Updates the cases distances when downsampling.
updateCaseDistances :: [Individual] -> [PushData] -> [PushData] -> String -> Double -> [PushData]
updateCaseDistances evaledPop downsampleData trainingData informedDownsamplingType solutionThreshold = undefined
@ -70,7 +70,7 @@ selectDownsampleMaxminAdaptive (PushArgs {caseDelta = cDelta}) pushData = do
-- original pushData wrapped in a list, the second [PushData] holds the rest of the list
-- without the aformentioned head. The Int is the caseDelta derived from the downsample rate
-- and the length of the original [pushData].
selectDownsampleMaxminAdaptive' :: [PushData] -> [PushData] -> Double -> IO [PushData]
selectDownsampleMaxminAdaptive' :: [PushData] -> [PushData] -> Int -> IO [PushData]
selectDownsampleMaxminAdaptive' newDownsample casesToPickFrom cDelta = do
let newDistances = map extractDistance newDownsample
let minCaseDistances = minOfColumns (map (\distList -> filterByIndex distList (map extractIndex casesToPickFrom)) newDistances)
@ -82,3 +82,35 @@ selectDownsampleMaxminAdaptive' newDownsample casesToPickFrom cDelta = do
((casesToPickFrom !! selectedCaseIndex) : newDownsample)
(shuffle' (deleteAt selectedCaseIndex casesToPickFrom) (length casesToPickFrom - 1) stdGen)
cDelta
-- |Returns the distance between two cases given a list of individual error vectors, and the index these
-- cases exist in the error vector. Only makes the distinction between zero and nonzero errors"
getDistanceBetweenCases :: [[Int]] -> Int -> Int -> Int
getDistanceBetweenCases errorLists caseIndex0 caseIndex1 =
if lhe < caseIndex0 || lhe < caseIndex1 || caseIndex0 < 0 || caseIndex1 < 0
then length errorLists
else sum $ zipWith (\e0 e1 -> abs $ abs (signum e0) - abs (signum e1)) errors0 errors1
where
lhe :: Int
lhe = length $ case uncons errorLists of Just (x, _) -> x; _ -> error "Error: errorLists is empty!"
errors0 :: [Int]
errors0 = map (!! caseIndex0) errorLists
errors1 :: [Int]
errors1 = map (!! caseIndex1) errorLists
-- |Updates a list with the values from another list based on an index from a third list.
-- The first list (bigList) has its indices updated with the values from the second list (smallList)
-- per index notated in the third [Int] list.
updateAtIndices :: [Int] -> [Int] -> [Int] -> [Int]
updateAtIndices bigList _ [] = bigList
updateAtIndices bigList smallList indices =
if length smallList /= length indices || any (\x -> x < 0 || x >= length bigList) indices
then bigList
else updateAtIndices' bigList smallList indices
-- |Look at updateAtIndicies for documentation. You should probably not
-- call this function. There is error checking in updateAtIndices, not this one.
updateAtIndices' :: [a] -> [a] -> [Int] -> [a]
updateAtIndices' bigList _ [] = bigList
updateAtIndices' bigList [] _ = bigList
updateAtIndices' bigList (sval:svals) (idx:idxs) = updateAtIndices' (replaceAt idx sval bigList) svals idxs

View File

@ -96,7 +96,7 @@ data PushArgs = PushArgs
epsilons :: Maybe [Double],
-- | Used with the CaseMaxminAuto downsampling strategy. Tells downsampling to stop when
-- the maximum minimum distance is too far away.
caseDelta :: Double
caseDelta :: Int
}
-- | The default values for which all runs of Hush derive
@ -143,5 +143,5 @@ defaultPushArgs = PushArgs {
umadRate = 0.1,
variation = Map.fromList [("umad", 1.0)],
epsilons = Nothing,
caseDelta = 0.0
caseDelta = 0
}

View File

@ -9,12 +9,12 @@ data PushData = PushData {
_inputData :: [Gene],
_outputData :: Gene,
_downsampleIndex :: Maybe Int,
_caseDistances :: Maybe [Double]
_caseDistances :: Maybe [Int]
} deriving (Show)
-- |Extracts the case distances from a PushData object. Errors if the
-- _caseDistances list is Nothing.
extractDistance :: PushData -> [Double]
extractDistance :: PushData -> [Int]
extractDistance PushData{_caseDistances = Nothing} = error "Error: Case distances are empty!. This should never happen"
extractDistance PushData{_caseDistances = Just xs} = xs
@ -24,7 +24,7 @@ extractIndex :: PushData -> Int
extractIndex PushData{_downsampleIndex = Nothing} = error "Error: Case distances are empty!. This should never happen"
extractIndex PushData{_downsampleIndex = Just x} = x
-- |Filters a list by another list of indicies.
-- |Filters a list by another list of indices.
filterByIndex :: [a] -> [Int] -> [a]
filterByIndex origList = map (origList !!)

View File

@ -320,7 +320,7 @@ instructionReverse accessor state =
_ -> state
-- |Based on two lenses, one of a primitive type and the next of a vector type,
-- takes the vector and individually pushes its indicies to the passed primitive stack.
-- takes the vector and individually pushes its indices to the passed primitive stack.
instructionPushAll :: Lens' State [a] -> Lens' State [[a]] -> State -> State
instructionPushAll primAccessor vectorAccessor state =
case uncons (view vectorAccessor state) of

View File

@ -26,9 +26,9 @@ insertAt idx val xs = combineTuple val (splitAt idx xs)
replaceAt :: Int -> a -> [a] -> [a]
replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs)
-- |Utility Function: Takes two ints as indicies. Sorts them low to high, sets the start to
-- |Utility Function: Takes two ints as indices. Sorts them low to high, sets the start to
-- 0 if the lowest start is less than 0 and the end to the length of the list - 1 if the end
-- if larger than the list. Grabs the sub list of adjusted indicies.
-- if larger than the list. Grabs the sub list of adjusted indices.
subList :: Int -> Int -> [a] -> [a]
subList idx0 idx1 xs =
let

View File

@ -5,7 +5,7 @@ import System.Random
import System.Random.Shuffle
-- |Maps minimum over the transposed [[Double]].
minOfColumns :: [[Double]] -> [Double]
minOfColumns :: [[Int]] -> [Int]
minOfColumns columns = map minimum (transpose columns)
-- |Returns the index of the maximum value in a list, randomly tiebreaking.