From 897f9bfb4aa360c59891846e9c7bc2cb5bbc8540 Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Thu, 27 Feb 2025 23:25:53 -0600 Subject: [PATCH] fix typo/add updateAtIndices --- src/HushGP/GP.hs | 2 +- src/HushGP/GP/Downsample.hs | 30 +++++++++++++++---- src/HushGP/GP/PushArgs.hs | 2 +- src/HushGP/GP/PushData.hs | 2 +- .../Instructions/GenericInstructions.hs | 2 +- src/HushGP/Instructions/Utility.hs | 4 +-- 6 files changed, 31 insertions(+), 11 deletions(-) diff --git a/src/HushGP/GP.hs b/src/HushGP/GP.hs index 38da66e..009c14d 100644 --- a/src/HushGP/GP.hs +++ b/src/HushGP/GP.hs @@ -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 diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs index a9df5a4..4c43004 100644 --- a/src/HushGP/GP/Downsample.hs +++ b/src/HushGP/GP/Downsample.hs @@ -10,8 +10,8 @@ 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] @@ -82,15 +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 undefined + else sum $ zipWith (\e0 e1 -> abs $ abs (signum e0) - abs (signum e1)) errors0 errors1 where lhe :: Int - lhe = length $ head errorLists + lhe = length $ case uncons errorLists of Just (x, _) -> x; _ -> error "Error: errorLists is empty!" errors0 :: [Int] - errors0 = map (\lst -> lst !! caseIndex0) errorLists + 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 diff --git a/src/HushGP/GP/PushArgs.hs b/src/HushGP/GP/PushArgs.hs index f70e5db..f9185a8 100644 --- a/src/HushGP/GP/PushArgs.hs +++ b/src/HushGP/GP/PushArgs.hs @@ -143,5 +143,5 @@ defaultPushArgs = PushArgs { umadRate = 0.1, variation = Map.fromList [("umad", 1.0)], epsilons = Nothing, - caseDelta = 0.0 + caseDelta = 0 } diff --git a/src/HushGP/GP/PushData.hs b/src/HushGP/GP/PushData.hs index 8a21cde..9f57868 100644 --- a/src/HushGP/GP/PushData.hs +++ b/src/HushGP/GP/PushData.hs @@ -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 !!) diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs index d4d4ac3..b3ee48a 100644 --- a/src/HushGP/Instructions/GenericInstructions.hs +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -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 diff --git a/src/HushGP/Instructions/Utility.hs b/src/HushGP/Instructions/Utility.hs index 6ddd11b..d891e35 100644 --- a/src/HushGP/Instructions/Utility.hs +++ b/src/HushGP/Instructions/Utility.hs @@ -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