diff --git a/src/HushGP/GP/Downsample.hs b/src/HushGP/GP/Downsample.hs index f3c3d0f..c544c0a 100644 --- a/src/HushGP/GP/Downsample.hs +++ b/src/HushGP/GP/Downsample.hs @@ -4,6 +4,7 @@ import System.Random.Shuffle import System.Random import Data.List import HushGP.Genome +import HushGP.Utility import HushGP.GP.PushData import HushGP.GP.PushArgs import HushGP.Tools.Metrics @@ -115,3 +116,7 @@ updateAtIndices' bigList (sval:svals) (idx:idxs) = updateAtIndices' (replaceAt i updateCaseDistances :: [Individual] -> [PushData] -> [PushData] -> String -> Double -> [PushData] updateCaseDistances evaledPop downsampleData trainingData informedDownsamplingType solutionThreshold = undefined -- map (\other -> getDistanceBetweenCases [[0,0],[0,0]] 0 other) [0..(length [3,4] - 1)] +-- tempData = intTrainData !! 0 +-- dCase = tempData{_downsampleIndex = Just 3, _caseDistances = Just [2,2,2,2,2]} +-- updateIn dCase (updateAtIndices [2,2,2,2,2] (map (\other -> getDistanceBetweenCases [[0,0],[0,0]] 0 0) [0..(length [3,4] - 1)]) [3,4]) +-- Replacement for updateIn: dCase{_caseDistances = Just (updateAtIndices (extractDistance dCase) (map (\other -> getDistanceBetweenCases [[0,0],[0,0]] 0 0) [0..(length [3,4] - 1)]) [3,4])} diff --git a/src/HushGP/GP/PushData.hs b/src/HushGP/GP/PushData.hs index 9f57868..ba43731 100644 --- a/src/HushGP/GP/PushData.hs +++ b/src/HushGP/GP/PushData.hs @@ -15,13 +15,13 @@ data PushData = PushData { -- |Extracts the case distances from a PushData object. Errors if the -- _caseDistances list is Nothing. extractDistance :: PushData -> [Int] -extractDistance PushData{_caseDistances = Nothing} = error "Error: Case distances are empty!. This should never happen" +extractDistance PushData{_caseDistances = Nothing} = error "Error: Case distances are Nothing!. They should be assigned first!" extractDistance PushData{_caseDistances = Just xs} = xs -- |Extracts the downsample index from a PushData object. Errors if the -- _downsampleIndex is Nothing. extractIndex :: PushData -> Int -extractIndex PushData{_downsampleIndex = Nothing} = error "Error: Case distances are empty!. This should never happen" +extractIndex PushData{_downsampleIndex = Nothing} = error "Error: Downsample index is empty!. They should be assigned first!" extractIndex PushData{_downsampleIndex = Just x} = x -- |Filters a list by another list of indices. diff --git a/src/HushGP/Problems/IntegerRegression.hs b/src/HushGP/Problems/IntegerRegression.hs index 430a082..9999ba7 100644 --- a/src/HushGP/Problems/IntegerRegression.hs +++ b/src/HushGP/Problems/IntegerRegression.hs @@ -12,6 +12,10 @@ import HushGP.Push import HushGP.Instructions.Utility import HushGP.GP +-- temporary imports for testing until I get this updated. +import HushGP.Utility +import HushGP.GP.Downsample + testPlushy :: [Gene] testPlushy = [ PlaceInput 0, @@ -20,6 +24,16 @@ testPlushy = [ -- GeneFloat 3.2 ] +-- |Equivalent to ds-data +testIntDsData :: [PushData] +testIntDsData = [ + (head intTrainData){_downsampleIndex = Just 3, _caseDistances = Just [2,2,2,2,2]}, + (intTrainData !! 1){_downsampleIndex = Just 4, _caseDistances = Just [2,2,2,2,2]} + ] + +tempFunc :: [PushData] +tempFunc = mapIndexed (\idx dCase -> dCase{_caseDistances = Just (updateAtIndices (extractDistance dCase) (map (\other -> getDistanceBetweenCases [[0,0],[0,0]] idx other) [0..(length [3,4] - 1)]) [3,4])}) testIntDsData + -- | The target function for this run. The function the gp -- is trying to evolve. targetFunction :: Integer -> Integer diff --git a/src/HushGP/Utility.hs b/src/HushGP/Utility.hs index c99fc22..560bb9e 100644 --- a/src/HushGP/Utility.hs +++ b/src/HushGP/Utility.hs @@ -13,3 +13,13 @@ randomInstruction instructions = do -- | Generates a list of random instructions from a list of instructions passed in. randomInstructions :: Int -> [Gene] -> IO [Gene] randomInstructions amt instructions = replicateM amt (randomInstruction instructions) + +-- | Maps a function like the normal mapping function and also applies an index to it. +mapIndexed :: (Int -> a -> b) -> [a] -> [b] +mapIndexed = mapIndexed' 0 + +-- | Internals for mapIndexed, can supply a starting index for rather than just 0 +-- with mapIndexed. +mapIndexed' :: Int -> (Int -> a -> b) -> [a] -> [b] +mapIndexed' _ _ [] = [] +mapIndexed' count f (x:xs) = f count x : mapIndexed' (count + 1) f xs