From b74b43a9c069c06481ef66c01de2a972f8ef7a5c Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Thu, 6 Mar 2025 23:55:20 -0600 Subject: [PATCH] added int lin alg functions --- src/HushGP/GP/Simplification.hs | 2 - .../Instructions/GenericInstructions.hs | 24 ++++- src/HushGP/Instructions/Utility.hs | 26 ++++- .../Instructions/VectorIntInstructions.hs | 96 ++++++++++++++++++- 4 files changed, 135 insertions(+), 13 deletions(-) diff --git a/src/HushGP/GP/Simplification.hs b/src/HushGP/GP/Simplification.hs index 6ea4197..b7e0dd9 100644 --- a/src/HushGP/GP/Simplification.hs +++ b/src/HushGP/GP/Simplification.hs @@ -7,8 +7,6 @@ import Data.List import HushGP.State import HushGP.GP.PushArgs -import Debug.Trace - -- | Takes a list of Genes (a plushy), chunks it up into sizes of 1 (type is [[Gene]]). -- and a list of indices for replacement (gets sorted before replacement). deleteAtMultiple :: [Int] -> [Gene] -> [Gene] diff --git a/src/HushGP/Instructions/GenericInstructions.hs b/src/HushGP/Instructions/GenericInstructions.hs index 3e80180..4cdff42 100644 --- a/src/HushGP/Instructions/GenericInstructions.hs +++ b/src/HushGP/Instructions/GenericInstructions.hs @@ -4,8 +4,6 @@ import Control.Lens import Data.List (sort, sortBy) import Data.Ord import Data.List.Split -import Numeric.LinearAlgebra (vector, norm_2) -import Numeric.Statistics.Moment import HushGP.State import HushGP.Instructions.Utility-- import Debug.Trace @@ -567,8 +565,24 @@ instructionVectorInsertVector _ state = state -- |Takes a numeric vector lens and a primitive lens. Pushes the mean of the top -- vector to the primitive stack. -instructionVectorMean :: Fractional a => Lens' State [a] -> Lens' State [[a]] -> (b -> a) -> State -> State -instructionVectorMean primAccessor vectorAccessor wrangleFunc state = +-- instructionVectorMean :: Fractional a => Lens' State [a] -> Lens' State [[a]] -> (b -> a) -> State -> State +-- instructionVectorMean primAccessor vectorAccessor wrangleFunc state = +-- case uncons (view vectorAccessor state) of +-- Just (v1, vs) -> state & vectorAccessor .~ vs & primAccessor .~ (mean v1 : view primAccessor state) +-- _ -> state + +-- |Takes a vector lens, a primitive lens, and an arbitrary function. Pushes the result +-- of applying the arbitrary function to the top vector lens item to the top of the primitive lens stack. +instructionVectorFuncVectorToPrim :: Ord a => Lens' State [a] -> Lens' State [[a]] -> ([a] -> a) -> State -> State +instructionVectorFuncVectorToPrim primAccessor vectorAccessor func state = case uncons (view vectorAccessor state) of - Just (v1, vs) -> state & vectorAccessor .~ vs & primAccessor .~ (mean v1 : view primAccessor state) + Just (v1, vs) -> state & vectorAccessor .~ vs & primAccessor .~ func v1 : view primAccessor state + _ -> state + +-- |Takes a vector lens and an arbitrary function. Applies the arbitrary function to the top +-- item of the vector lens stack and returns it to said stack. +instructionVectorFuncVectorToVector :: Ord a => Lens' State [[a]] -> ([a] -> [a]) -> State -> State +instructionVectorFuncVectorToVector accessor func state = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ func v1 : vs _ -> state diff --git a/src/HushGP/Instructions/Utility.hs b/src/HushGP/Instructions/Utility.hs index d891e35..f6196e7 100644 --- a/src/HushGP/Instructions/Utility.hs +++ b/src/HushGP/Instructions/Utility.hs @@ -1,8 +1,10 @@ module HushGP.Instructions.Utility where -import Control.Lens hiding (index) -import HushGP.State import Data.Char +import Data.List +import Data.Ord +import Control.Lens hiding (index, uncons) +import HushGP.State -- generic utility @@ -262,8 +264,6 @@ lstrip s = case s of rstrip :: String -> String rstrip = reverse . lstrip . reverse --- string utility - -- |Utility Function: Casts a type based on a lens to a string. Pushes the result -- to the string stack. instructionStringFromLens :: Show a => Lens' State [a] -> State -> State @@ -271,3 +271,21 @@ instructionStringFromLens accessor state@(State {_string = ss}) = case uncons (view accessor state) of Nothing -> state Just (x1,_) -> state{_string = show x1 : ss} + +-- vector utilty + +-- |Utility Function: Takes a list of numbers and returns the mode of said list. +mode :: (Num a, Ord a) => [a] -> a +mode xs = + case uncons (maximumBy (comparing length) (group (sort xs))) of + Just (x, _) -> x + _ -> error "Error: list is empty when determining mode!" + +-- |Utility Function: Calculates the 2-norm of a list and returns it. +twoNorm :: (Floating a) => [a] -> a +twoNorm xs = sqrt $ sum $ map (^ 2) xs + +-- |Utility Function: Takes in any value and returns 0. Used primarily to return 0 +-- when a function such as maximum is operating on an empty list. +retZero :: (Num b) => a -> b +retZero _ = 0 diff --git a/src/HushGP/Instructions/VectorIntInstructions.hs b/src/HushGP/Instructions/VectorIntInstructions.hs index fbc8478..3b7fa14 100644 --- a/src/HushGP/Instructions/VectorIntInstructions.hs +++ b/src/HushGP/Instructions/VectorIntInstructions.hs @@ -1,9 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} module HushGP.Instructions.VectorIntInstructions where +import Numeric.LinearAlgebra import HushGP.Instructions.GenericInstructions import HushGP.State import HushGP.TH +import HushGP.Instructions.Utility -- |Pops the top int vector from the int vector stack. instructionVectorIntPop :: State -> State @@ -332,9 +334,99 @@ instructionVectorIntInsertVectorInt :: State -> State instructionVectorIntInsertVectorInt = instructionVectorInsertVector vectorInt -- |Takes the mean of the top int vector and pushes the rounded int value --- to the int stack. +-- to the int stack. No way to easily make this generic. instructionVectorIntMean :: State -> State -instructionVectorIntMean = instructionVectorMean int vectorInt id +instructionVectorIntMean state@(State {_int = is, _vectorInt = v1 : vs}) = state{_int = mean v1 : is, _vectorInt = vs} + where + mean :: [Integer] -> Integer + mean [] = 0 + mean xs = round $ sum (map (fromIntegral @Integer @Double) xs) / fromIntegral @Int @Double (length xs) +instructionVectorIntMean state = state + +-- |Takes the maximum of the top int vector and pushes the int value +-- to the int stack. +instructionVectorIntMaximum :: State -> State +instructionVectorIntMaximum state@(State {_vectorInt = [] : _}) = instructionVectorFuncVectorToPrim int vectorInt retZero state +instructionVectorIntMaximum state = instructionVectorFuncVectorToPrim int vectorInt maximum state + +-- |Takes the minimum of the top int vector and pushes the int value +-- to the int stack. +instructionVectorIntMinimum :: State -> State +instructionVectorIntMinimum state@(State {_vectorInt = [] : _ }) = instructionVectorFuncVectorToPrim int vectorInt retZero state +instructionVectorIntMinimum state = instructionVectorFuncVectorToPrim int vectorInt minimum state + +-- |Takes the sum of the top int vector and pushes the int value +-- to the int stack. +instructionVectorIntSum :: State -> State +instructionVectorIntSum state@(State {_vectorInt = [] : _}) = instructionVectorFuncVectorToPrim int vectorInt retZero state +instructionVectorIntSum state = instructionVectorFuncVectorToPrim int vectorInt sum state + +-- |Takes the mode of the top int vector and pushes the int value +-- to the int stack. +instructionVectorIntMode :: State -> State +instructionVectorIntMode state@(State {_vectorInt = [] : _}) = instructionVectorFuncVectorToPrim int vectorInt retZero state +instructionVectorIntMode state = instructionVectorFuncVectorToPrim int vectorInt mode state + +-- |Takes the 2-norm of the top int vector and pushes the rounded result to +-- the int stack. +instructionVectorIntNorm :: State -> State -- Ends up replacing with 0 so it's good. +instructionVectorIntNorm = instructionVectorFuncVectorToPrim int vectorInt (round . twoNorm . map (fromIntegral @Integer @Double)) + +-- |Takes the cummulative mean of the int vector, rounds the results and places them into a vector as the caluculations happen and pushes it back to the top of +-- the int vector stack. +instructionVectorIntCummulativeMean :: State -> State +instructionVectorIntCummulativeMean = instructionVectorFuncVectorToVector vectorInt (\xs -> zipWith div (scanl1 (+) xs) [1..]) + +-- |Takes the cummulative sum of the int vector, places the results in a vector as the caluculations happen and pushes it back to the top of +-- the int vector stack. +instructionVectorIntCummulativeSum :: State -> State +instructionVectorIntCummulativeSum = instructionVectorFuncVectorToVector vectorInt (scanl1 (+)) + +-- |Takes the cummulative max of the int vector, places the results in a vector as the caluculations happen and pushes it back to the top of +-- the int vector stack. +instructionVectorIntCummulativeMax :: State -> State +instructionVectorIntCummulativeMax = instructionVectorFuncVectorToVector vectorInt (scanl1 max) + +-- |Takes the cummulative min of the int vector, places the results in a vector as the caluculations happen and pushes it back to the top of +-- the int vector stack. +instructionVectorIntCummulativeMin :: State -> State +instructionVectorIntCummulativeMin = instructionVectorFuncVectorToVector vectorInt (scanl1 min) + +-- |Applies the exponential function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntExp :: State -> State +instructionVectorIntExp = instructionVectorFuncVectorToVector vectorInt (map (round . exp . fromIntegral @Integer @Double)) + +-- |Applies the log function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntLog :: State -> State +instructionVectorIntLog = instructionVectorFuncVectorToVector vectorInt (map (round . log . fromIntegral @Integer @Double)) + +-- |Applies the sin function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntSin :: State -> State +instructionVectorIntSin = instructionVectorFuncVectorToVector vectorInt (map (round . sin . fromIntegral @Integer @Double)) + +-- |Applies the cos function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntCos :: State -> State +instructionVectorIntCos = instructionVectorFuncVectorToVector vectorInt (map (round . cos . fromIntegral @Integer @Double)) + +-- |Applies the tan function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntTan :: State -> State +instructionVectorIntTan = instructionVectorFuncVectorToVector vectorInt (map (round . tan . fromIntegral @Integer @Double)) + +-- |Applies the abs function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntAbs :: State -> State +instructionVectorIntAbs = instructionVectorFuncVectorToVector vectorInt (map (round . abs . fromIntegral @Integer @Double)) + +-- |Applies the square function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntSquare :: State -> State +instructionVectorIntSquare = instructionVectorFuncVectorToVector vectorInt (map (round . (^ 2) . fromIntegral @Integer @Double)) + +-- |Applies the cube function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntCube :: State -> State +instructionVectorIntCube = instructionVectorFuncVectorToVector vectorInt (map (round . (^ 3) . fromIntegral @Integer @Double)) + +-- |Applies the sqrt function to all indices in an int vector, rounds the result as it moves along. +instructionVectorIntSqrt :: State -> State +instructionVectorIntSqrt = instructionVectorFuncVectorToVector vectorInt (map (round . sqrt . fromIntegral @Integer @Double)) allVectorIntInstructions :: [Gene] allVectorIntInstructions = map StateFunc ($(functionExtractor "instruction"))