fix typo/add updateAtIndices
This commit is contained in:
parent
720c8296d2
commit
897f9bfb4a
@ -34,7 +34,7 @@ updateIndividual errors ind = ind {totalFitness = Just (sum errors), fitnessCase
|
|||||||
gpLoop :: PushArgs -> IO ()
|
gpLoop :: PushArgs -> IO ()
|
||||||
gpLoop pushArgs@(PushArgs {trainingData = tData}) = do
|
gpLoop pushArgs@(PushArgs {trainingData = tData}) = do
|
||||||
unEvaledPopulation <- generatePopulation pushArgs
|
unEvaledPopulation <- generatePopulation pushArgs
|
||||||
let indexedTrainingData = assignIndiciesToData tData
|
let indexedTrainingData = assignIndicesToData tData
|
||||||
gpLoop' pushArgs 0 0 unEvaledPopulation indexedTrainingData
|
gpLoop' pushArgs 0 0 unEvaledPopulation indexedTrainingData
|
||||||
|
|
||||||
-- | The guts of the GP loop. Where the work gets done after the initialization happens
|
-- | The guts of the GP loop. Where the work gets done after the initialization happens
|
||||||
|
@ -10,8 +10,8 @@ import HushGP.Tools.Metrics
|
|||||||
import HushGP.Instructions.Utility
|
import HushGP.Instructions.Utility
|
||||||
|
|
||||||
-- |Sets the index of the passed training data.
|
-- |Sets the index of the passed training data.
|
||||||
assignIndiciesToData :: [PushData] -> [PushData]
|
assignIndicesToData :: [PushData] -> [PushData]
|
||||||
assignIndiciesToData oldData = zipWith (\dat idx -> dat{_downsampleIndex = Just idx}) oldData [0..]
|
assignIndicesToData oldData = zipWith (\dat idx -> dat{_downsampleIndex = Just idx}) oldData [0..]
|
||||||
|
|
||||||
-- |Initializes cases distances for passed training data.
|
-- |Initializes cases distances for passed training data.
|
||||||
initializeCaseDistances :: PushArgs -> [PushData]
|
initializeCaseDistances :: PushArgs -> [PushData]
|
||||||
@ -82,15 +82,35 @@ selectDownsampleMaxminAdaptive' newDownsample casesToPickFrom cDelta = do
|
|||||||
((casesToPickFrom !! selectedCaseIndex) : newDownsample)
|
((casesToPickFrom !! selectedCaseIndex) : newDownsample)
|
||||||
(shuffle' (deleteAt selectedCaseIndex casesToPickFrom) (length casesToPickFrom - 1) stdGen)
|
(shuffle' (deleteAt selectedCaseIndex casesToPickFrom) (length casesToPickFrom - 1) stdGen)
|
||||||
cDelta
|
cDelta
|
||||||
|
|
||||||
-- |Returns the distance between two cases given a list of individual error vectors, and the index these
|
-- |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"
|
-- cases exist in the error vector. Only makes the distinction between zero and nonzero errors"
|
||||||
getDistanceBetweenCases :: [[Int]] -> Int -> Int -> Int
|
getDistanceBetweenCases :: [[Int]] -> Int -> Int -> Int
|
||||||
getDistanceBetweenCases errorLists caseIndex0 caseIndex1 =
|
getDistanceBetweenCases errorLists caseIndex0 caseIndex1 =
|
||||||
if lhe < caseIndex0 || lhe < caseIndex1 || caseIndex0 < 0 || caseIndex1 < 0
|
if lhe < caseIndex0 || lhe < caseIndex1 || caseIndex0 < 0 || caseIndex1 < 0
|
||||||
then length errorLists
|
then length errorLists
|
||||||
else undefined
|
else sum $ zipWith (\e0 e1 -> abs $ abs (signum e0) - abs (signum e1)) errors0 errors1
|
||||||
where
|
where
|
||||||
lhe :: Int
|
lhe :: Int
|
||||||
lhe = length $ head errorLists
|
lhe = length $ case uncons errorLists of Just (x, _) -> x; _ -> error "Error: errorLists is empty!"
|
||||||
errors0 :: [Int]
|
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
|
||||||
|
@ -143,5 +143,5 @@ defaultPushArgs = PushArgs {
|
|||||||
umadRate = 0.1,
|
umadRate = 0.1,
|
||||||
variation = Map.fromList [("umad", 1.0)],
|
variation = Map.fromList [("umad", 1.0)],
|
||||||
epsilons = Nothing,
|
epsilons = Nothing,
|
||||||
caseDelta = 0.0
|
caseDelta = 0
|
||||||
}
|
}
|
||||||
|
@ -24,7 +24,7 @@ extractIndex :: PushData -> Int
|
|||||||
extractIndex PushData{_downsampleIndex = Nothing} = error "Error: Case distances are empty!. This should never happen"
|
extractIndex PushData{_downsampleIndex = Nothing} = error "Error: Case distances are empty!. This should never happen"
|
||||||
extractIndex PushData{_downsampleIndex = Just x} = x
|
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 :: [a] -> [Int] -> [a]
|
||||||
filterByIndex origList = map (origList !!)
|
filterByIndex origList = map (origList !!)
|
||||||
|
|
||||||
|
@ -320,7 +320,7 @@ instructionReverse accessor state =
|
|||||||
_ -> state
|
_ -> state
|
||||||
|
|
||||||
-- |Based on two lenses, one of a primitive type and the next of a vector type,
|
-- |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 :: Lens' State [a] -> Lens' State [[a]] -> State -> State
|
||||||
instructionPushAll primAccessor vectorAccessor state =
|
instructionPushAll primAccessor vectorAccessor state =
|
||||||
case uncons (view vectorAccessor state) of
|
case uncons (view vectorAccessor state) of
|
||||||
|
@ -26,9 +26,9 @@ insertAt idx val xs = combineTuple val (splitAt idx xs)
|
|||||||
replaceAt :: Int -> a -> [a] -> [a]
|
replaceAt :: Int -> a -> [a] -> [a]
|
||||||
replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs)
|
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
|
-- 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 :: Int -> Int -> [a] -> [a]
|
||||||
subList idx0 idx1 xs =
|
subList idx0 idx1 xs =
|
||||||
let
|
let
|
||||||
|
Loading…
x
Reference in New Issue
Block a user