clean up, organize and document
This commit is contained in:
Johannes Merl
1014
lambda/src/LambdaDatasets/GermanData.hs
Normal file
1014
lambda/src/LambdaDatasets/GermanData.hs
Normal file
File diff suppressed because it is too large
Load Diff
208
lambda/src/LambdaDatasets/GermanDataset.hs
Normal file
208
lambda/src/LambdaDatasets/GermanDataset.hs
Normal file
@@ -0,0 +1,208 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module LambdaDatasets.GermanDataset
|
||||
( module LambdaCalculus,
|
||||
module LambdaDatasets.GermanDataset,
|
||||
module LambdaDatasets.GermanData,
|
||||
module GA,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Random
|
||||
import Data.Random.Distribution.Uniform
|
||||
import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import GA
|
||||
import LambdaDatasets.GermanData
|
||||
import LambdaCalculus
|
||||
import qualified Language.Haskell.Interpreter as Hint
|
||||
import qualified Language.Haskell.Interpreter.Unsafe as Hint
|
||||
import Protolude
|
||||
import Protolude.Error
|
||||
import System.Random.MWC (createSystemRandom)
|
||||
import qualified Type.Reflection as Ref
|
||||
import Utils
|
||||
|
||||
lE :: LambdaEnviroment
|
||||
lE =
|
||||
LambdaEnviroment
|
||||
{ functions =
|
||||
Map.fromList
|
||||
[ -- Math
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int))), ["(+)", "(-)", "(*)"]),
|
||||
-- Logic
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Bool -> Bool))), ["(&&)", "(||)"]),
|
||||
-- Ordered Enums
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(AccountStatus -> AccountStatus -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(CreditHistory -> CreditHistory -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Savings -> Savings -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(EmploymentStatus -> EmploymentStatus -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(OtherDebtors -> OtherDebtors -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Job -> Job -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
-- Eq Enum
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(GermanClass -> GermanClass -> Bool))), ["(==)", "(/=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Purpose -> Purpose -> Bool))), ["(==)", "(/=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(StatusAndSex -> StatusAndSex -> Bool))), ["(==)", "(/=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Property -> Property -> Bool))), ["(==)", "(/=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(OtherPlans -> OtherPlans -> Bool))), ["(==)", "(/=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Housing -> Housing -> Bool))), ["(==)", "(/=)"]),
|
||||
-- Any Type
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Int -> Int -> Int))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> GermanClass -> GermanClass -> GermanClass))), ["if'","if'","if'","if'","if'","if'","if'","if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> AccountStatus -> AccountStatus -> AccountStatus))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> CreditHistory -> CreditHistory -> CreditHistory))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Purpose -> Purpose -> Purpose))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Savings -> Savings -> Savings))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> EmploymentStatus -> EmploymentStatus -> EmploymentStatus))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> StatusAndSex -> StatusAndSex -> StatusAndSex))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> OtherDebtors -> OtherDebtors -> OtherDebtors))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Property -> Property -> Property))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> OtherPlans -> OtherPlans -> OtherPlans))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Housing -> Housing -> Housing))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Job -> Job -> Job))), ["if'"])
|
||||
],
|
||||
constants =
|
||||
Map.fromList
|
||||
[ ((Ref.SomeTypeRep (Ref.TypeRep @(Int))), [(fmap show (uniform 0 10 :: RVar Int))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool))), [(fmap show (uniform True False :: RVar Bool))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(GermanClass))), [(fmap show (enumUniform Accept Deny))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(AccountStatus))), [(fmap show (enumUniform AccountInDebt HighAccountBalanceOrRegular))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(CreditHistory))), [(fmap show (enumUniform HistoryGood CreditsExist ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Purpose))), [(fmap show (enumUniform OldCar Other ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Savings))), [(fmap show (enumUniform UnknownOrNone GreatSavings ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(EmploymentStatus))), [(fmap show (enumUniform NotEmployed VeteranEmployed ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(StatusAndSex))), [(fmap show (enumUniform MaleAndSeperated MaleAndWidowedOrMarried ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(OtherDebtors))), [(fmap show (enumUniform NoOtherDebtors Guarantor ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Property))), [(fmap show (enumUniform UnknownOrNoProperty CarOrOther ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(OtherPlans))), [(fmap show (enumUniform PlansAtBank NoOtherPlans ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Housing))), [(fmap show (enumUniform Renting ResidingForFree ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Job))), [(fmap show (enumUniform UnemployedOrUnskilledNonResident HighlySkilled ))])
|
||||
],
|
||||
targetType = (Ref.SomeTypeRep (Ref.TypeRep @(AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass))),
|
||||
maxDepth = 8,
|
||||
weights =
|
||||
ExpressionWeights
|
||||
{ lambdaSpucker = 1,
|
||||
lambdaSchlucker = 2,
|
||||
symbol = 30,
|
||||
variable = 10,
|
||||
constant = 5
|
||||
}
|
||||
}
|
||||
|
||||
lEE :: LamdaExecutionEnv
|
||||
lEE =
|
||||
LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.GermanDefinition"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion 0.8 germanTrainingData),
|
||||
map snd (takeFraktion 0.8 germanTrainingData)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion 0.8 germanTrainingData),
|
||||
map snd (dropFraktion 0.8 germanTrainingData)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
shuffledLEE :: IO LamdaExecutionEnv
|
||||
shuffledLEE = do
|
||||
mwc <- liftIO createSystemRandom
|
||||
let smpl = ((sampleFrom mwc) :: RVar a -> IO a)
|
||||
itD <- smpl $ shuffle germanTrainingData
|
||||
return
|
||||
LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.GermanDefinition"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion 0.8 itD),
|
||||
map snd (takeFraktion 0.8 itD)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion 0.8 itD),
|
||||
map snd (dropFraktion 0.8 itD)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
data LamdaExecutionEnv = LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports :: [Text],
|
||||
training :: Bool,
|
||||
trainingData :: ([(AccountStatus, Int, CreditHistory, Purpose, Int, Savings, EmploymentStatus, Int, StatusAndSex, OtherDebtors, Int, Property, Int, OtherPlans, Housing, Int, Job, Int, Bool, Bool)], [GermanClass]),
|
||||
testData :: ([(AccountStatus, Int, CreditHistory, Purpose, Int, Savings, EmploymentStatus, Int, StatusAndSex, OtherDebtors, Int, Property, Int, OtherPlans, Housing, Int, Job, Int, Bool, Bool)], [GermanClass]),
|
||||
exTargetType :: TypeRep,
|
||||
-- todo: kindaHacky
|
||||
results :: Map TypeRequester FittnesRes
|
||||
}
|
||||
|
||||
data FittnesRes = FittnesRes
|
||||
{ total :: R,
|
||||
fitnessTotal :: R,
|
||||
fitnessGeoMean :: R,
|
||||
fitnessMean :: R,
|
||||
accuracy :: R,
|
||||
biasSize :: R,
|
||||
totalSize :: N
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance Fitness FittnesRes where
|
||||
getR = total
|
||||
|
||||
instance Evaluator TypeRequester LamdaExecutionEnv FittnesRes where
|
||||
fitness' env tr = (results env) Map.! tr
|
||||
|
||||
calc env pop = do
|
||||
let relevantResults = Map.filterWithKey (\k _ -> contains pop k) (results env)
|
||||
let toAdd = NE.filter (\k -> not (Map.member k relevantResults)) pop
|
||||
toInsert <- Hint.runInterpreter (evalResults env toAdd)
|
||||
let insertPair (key, val) m = Map.insert key val m
|
||||
let res = foldr insertPair relevantResults (fromRight (error ("To insert is " <> show toInsert)) toInsert)
|
||||
return env {results = res}
|
||||
|
||||
dset :: LamdaExecutionEnv -> ([(AccountStatus, Int, CreditHistory, Purpose, Int, Savings, EmploymentStatus, Int, StatusAndSex, OtherDebtors, Int, Property, Int, OtherPlans, Housing, Int, Job, Int, Bool, Bool)], [GermanClass])
|
||||
dset lEE = if training lEE then trainingData lEE else testData lEE
|
||||
|
||||
evalResults :: LamdaExecutionEnv -> [TypeRequester] -> Hint.InterpreterT IO [(TypeRequester, FittnesRes)]
|
||||
evalResults ex trs = do
|
||||
Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"]
|
||||
Hint.unsafeSetGhcOption "-O2"
|
||||
let arrayOfFunctionText = map toLambdaExpressionS trs
|
||||
let textOfFunctionArray = "[" <> T.intercalate "," arrayOfFunctionText <> "]"
|
||||
result <- Hint.interpret (T.unpack (textOfFunctionArray)) (Hint.as :: [AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass])
|
||||
return $ zipWith (evalResult ex) trs result
|
||||
|
||||
|
||||
evalResult :: LamdaExecutionEnv -> TypeRequester -> (AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass) -> (TypeRequester, FittnesRes)
|
||||
evalResult ex tr result = ( tr,
|
||||
FittnesRes
|
||||
{ total = score,
|
||||
fitnessTotal = fitness',
|
||||
fitnessMean = meanOfAccuricyPerClass resAndTarget,
|
||||
fitnessGeoMean = geomeanOfDistributionAccuracy resAndTarget,
|
||||
accuracy = acc,
|
||||
biasSize = biasSmall,
|
||||
totalSize = countTrsR tr
|
||||
}
|
||||
)
|
||||
where
|
||||
res = map (\(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t) -> result a b c d e f g h i j k l m n o p q r s t) (fst (dset ex))
|
||||
resAndTarget = (zip (snd (dset ex)) res)
|
||||
acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) / fromIntegral (length resAndTarget)
|
||||
biasSmall = exp ((-(fromIntegral (countTrsR tr))) / 1000) -- 0 (schlecht) bis 1 (gut)
|
||||
fitness' = meanOfAccuricyPerClass resAndTarget
|
||||
score = fitness' + (biasSmall - 1)
|
||||
|
||||
168
lambda/src/LambdaDatasets/IrisData.hs
Normal file
168
lambda/src/LambdaDatasets/IrisData.hs
Normal file
@@ -0,0 +1,168 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module LambdaDatasets.IrisData
|
||||
( module LambdaDatasets.IrisDefinition,
|
||||
module LambdaDatasets.IrisData,
|
||||
)
|
||||
where
|
||||
|
||||
import LambdaDatasets.IrisDefinition
|
||||
import Protolude
|
||||
|
||||
irisTrainingData :: [((Float, Float, Float, Float), IrisClass)]
|
||||
irisTrainingData =
|
||||
[ ((6.7, 3.1, 4.4, 1.4), Versicolor),
|
||||
((5.4, 3.7, 1.5, 0.2), Setosa),
|
||||
((5.4, 3.0, 4.5, 1.5), Versicolor),
|
||||
((5.1, 3.8, 1.5, 0.3), Setosa),
|
||||
((5.0, 2.3, 3.3, 1.0), Versicolor),
|
||||
((6.0, 2.7, 5.1, 1.6), Versicolor),
|
||||
((4.6, 3.2, 1.4, 0.2), Setosa),
|
||||
((5.6, 2.7, 4.2, 1.3), Versicolor),
|
||||
((6.7, 3.3, 5.7, 2.1), Virginica),
|
||||
((6.9, 3.1, 5.1, 2.3), Virginica),
|
||||
((7.7, 3.8, 6.7, 2.2), Virginica),
|
||||
((6.1, 2.8, 4.7, 1.2), Versicolor),
|
||||
((5.8, 2.7, 3.9, 1.2), Versicolor),
|
||||
((6.7, 3.3, 5.7, 2.5), Virginica),
|
||||
((5.0, 3.4, 1.5, 0.2), Setosa),
|
||||
((4.7, 3.2, 1.6, 0.2), Setosa),
|
||||
((6.8, 3.0, 5.5, 2.1), Virginica),
|
||||
((6.2, 2.2, 4.5, 1.5), Versicolor),
|
||||
((5.7, 3.8, 1.7, 0.3), Setosa),
|
||||
((5.8, 4.0, 1.2, 0.2), Setosa),
|
||||
((7.2, 3.2, 6.0, 1.8), Virginica),
|
||||
((5.8, 2.7, 4.1, 1.0), Versicolor),
|
||||
((6.5, 3.0, 5.8, 2.2), Virginica),
|
||||
((6.9, 3.2, 5.7, 2.3), Virginica),
|
||||
((5.8, 2.7, 5.1, 1.9), Virginica),
|
||||
((5.2, 4.1, 1.5, 0.1), Setosa),
|
||||
((4.6, 3.6, 1.0, 0.2), Setosa),
|
||||
((4.7, 3.2, 1.3, 0.2), Setosa),
|
||||
((6.9, 3.1, 5.4, 2.1), Virginica),
|
||||
((6.1, 2.9, 4.7, 1.4), Versicolor),
|
||||
((6.0, 3.4, 4.5, 1.6), Versicolor),
|
||||
((5.6, 3.0, 4.5, 1.5), Versicolor),
|
||||
((5.2, 3.4, 1.4, 0.2), Setosa),
|
||||
((6.3, 3.3, 4.7, 1.6), Versicolor),
|
||||
((7.2, 3.6, 6.1, 2.5), Virginica),
|
||||
((6.5, 3.2, 5.1, 2.0), Virginica),
|
||||
((6.3, 2.5, 4.9, 1.5), Versicolor),
|
||||
((5.1, 3.8, 1.9, 0.4), Setosa),
|
||||
((7.0, 3.2, 4.7, 1.4), Versicolor),
|
||||
((4.9, 3.1, 1.5, 0.1), Setosa),
|
||||
((4.9, 2.4, 3.3, 1.0), Versicolor),
|
||||
((6.1, 3.0, 4.9, 1.8), Virginica),
|
||||
((4.9, 3.1, 1.5, 0.1), Setosa),
|
||||
((6.2, 2.9, 4.3, 1.3), Versicolor),
|
||||
((5.7, 3.0, 4.2, 1.2), Versicolor),
|
||||
((7.2, 3.0, 5.8, 1.6), Virginica),
|
||||
((5.0, 2.0, 3.5, 1.0), Versicolor),
|
||||
((4.3, 3.0, 1.1, 0.1), Setosa),
|
||||
((6.7, 3.1, 4.7, 1.5), Versicolor),
|
||||
((5.5, 2.4, 3.8, 1.1), Versicolor),
|
||||
((5.7, 2.8, 4.5, 1.3), Versicolor),
|
||||
((7.7, 2.8, 6.7, 2.0), Virginica),
|
||||
((7.6, 3.0, 6.6, 2.1), Virginica),
|
||||
((4.9, 2.5, 4.5, 1.7), Virginica),
|
||||
((5.1, 2.5, 3.0, 1.1), Versicolor),
|
||||
((6.4, 2.8, 5.6, 2.1), Virginica),
|
||||
((6.4, 2.8, 5.6, 2.2), Virginica),
|
||||
((5.9, 3.0, 5.1, 1.8), Virginica),
|
||||
((4.4, 3.2, 1.3, 0.2), Setosa),
|
||||
((6.3, 2.3, 4.4, 1.3), Versicolor),
|
||||
((5.4, 3.4, 1.7, 0.2), Setosa),
|
||||
((4.9, 3.0, 1.4, 0.2), Setosa),
|
||||
((6.7, 3.0, 5.2, 2.3), Virginica),
|
||||
((5.0, 3.5, 1.3, 0.3), Setosa),
|
||||
((5.1, 3.3, 1.7, 0.5), Setosa),
|
||||
((7.7, 2.6, 6.9, 2.3), Virginica),
|
||||
((5.6, 2.9, 3.6, 1.3), Versicolor),
|
||||
((7.3, 2.9, 6.3, 1.8), Virginica),
|
||||
((6.7, 3.1, 5.6, 2.4), Virginica),
|
||||
((6.3, 2.8, 5.1, 1.5), Virginica),
|
||||
((5.6, 2.5, 3.9, 1.1), Versicolor),
|
||||
((5.4, 3.9, 1.3, 0.4), Setosa),
|
||||
((5.5, 2.3, 4.0, 1.3), Versicolor),
|
||||
((6.4, 2.7, 5.3, 1.9), Virginica),
|
||||
((5.1, 3.5, 1.4, 0.3), Setosa),
|
||||
((5.5, 3.5, 1.3, 0.2), Setosa),
|
||||
((5.0, 3.2, 1.2, 0.2), Setosa),
|
||||
((5.1, 3.4, 1.5, 0.2), Setosa),
|
||||
((5.4, 3.9, 1.7, 0.4), Setosa),
|
||||
((4.5, 2.3, 1.3, 0.3), Setosa),
|
||||
((6.7, 3.0, 5.0, 1.7), Versicolor),
|
||||
((5.0, 3.3, 1.4, 0.2), Setosa),
|
||||
((7.1, 3.0, 5.9, 2.1), Virginica),
|
||||
((5.8, 2.6, 4.0, 1.2), Versicolor),
|
||||
((6.3, 2.7, 4.9, 1.8), Virginica),
|
||||
((6.8, 3.2, 5.9, 2.3), Virginica),
|
||||
((6.6, 3.0, 4.4, 1.4), Versicolor),
|
||||
((5.4, 3.4, 1.5, 0.4), Setosa),
|
||||
((5.0, 3.6, 1.4, 0.2), Setosa),
|
||||
((5.9, 3.2, 4.8, 1.8), Versicolor),
|
||||
((6.3, 2.5, 5.0, 1.9), Virginica),
|
||||
((6.0, 3.0, 4.8, 1.8), Virginica),
|
||||
((7.9, 3.8, 6.4, 2.0), Virginica),
|
||||
((5.9, 3.0, 4.2, 1.5), Versicolor),
|
||||
((4.8, 3.0, 1.4, 0.1), Setosa),
|
||||
((5.7, 2.8, 4.1, 1.3), Versicolor),
|
||||
((6.7, 2.5, 5.8, 1.8), Virginica),
|
||||
((5.7, 2.6, 3.5, 1.0), Versicolor),
|
||||
((4.4, 3.0, 1.3, 0.2), Setosa),
|
||||
((4.8, 3.4, 1.9, 0.2), Setosa),
|
||||
((6.3, 3.4, 5.6, 2.4), Virginica),
|
||||
((5.5, 4.2, 1.4, 0.2), Setosa),
|
||||
((5.0, 3.0, 1.6, 0.2), Setosa),
|
||||
((5.7, 2.9, 4.2, 1.3), Versicolor),
|
||||
((6.2, 2.8, 4.8, 1.8), Virginica),
|
||||
((6.2, 3.4, 5.4, 2.3), Virginica),
|
||||
((6.5, 3.0, 5.2, 2.0), Virginica),
|
||||
((4.9, 3.1, 1.5, 0.1), Setosa),
|
||||
((5.8, 2.7, 5.1, 1.9), Virginica),
|
||||
((5.1, 3.5, 1.4, 0.2), Setosa),
|
||||
((5.6, 2.8, 4.9, 2.0), Virginica),
|
||||
((5.5, 2.4, 3.7, 1.0), Versicolor),
|
||||
((6.1, 2.8, 4.0, 1.3), Versicolor),
|
||||
((5.7, 4.4, 1.5, 0.4), Setosa),
|
||||
((6.9, 3.1, 4.9, 1.5), Versicolor),
|
||||
((5.8, 2.8, 5.1, 2.4), Virginica),
|
||||
((5.7, 2.5, 5.0, 2.0), Virginica),
|
||||
((6.8, 2.8, 4.8, 1.4), Versicolor),
|
||||
((6.3, 2.9, 5.6, 1.8), Virginica),
|
||||
((6.0, 2.2, 4.0, 1.0), Versicolor),
|
||||
((5.0, 3.5, 1.6, 0.6), Setosa),
|
||||
((4.6, 3.1, 1.5, 0.2), Setosa),
|
||||
((4.8, 3.4, 1.6, 0.2), Setosa),
|
||||
((4.8, 3.0, 1.4, 0.3), Setosa),
|
||||
((6.4, 2.9, 4.3, 1.3), Versicolor),
|
||||
((5.5, 2.6, 4.4, 1.2), Versicolor),
|
||||
((5.2, 2.7, 3.9, 1.4), Versicolor),
|
||||
((6.0, 2.9, 4.5, 1.5), Versicolor),
|
||||
((5.3, 3.7, 1.5, 0.2), Setosa),
|
||||
((6.4, 3.2, 5.3, 2.3), Virginica),
|
||||
((6.4, 3.1, 5.5, 1.8), Virginica),
|
||||
((5.1, 3.8, 1.6, 0.2), Setosa),
|
||||
((5.1, 3.7, 1.5, 0.4), Setosa),
|
||||
((4.6, 3.4, 1.4, 0.3), Setosa),
|
||||
((5.6, 3.0, 4.1, 1.3), Versicolor),
|
||||
((6.1, 3.0, 4.6, 1.4), Versicolor),
|
||||
((5.2, 3.5, 1.5, 0.2), Setosa),
|
||||
((7.4, 2.8, 6.1, 1.9), Virginica),
|
||||
((6.5, 2.8, 4.6, 1.5), Versicolor),
|
||||
((6.3, 3.3, 6.0, 2.5), Virginica),
|
||||
((4.8, 3.1, 1.6, 0.2), Setosa),
|
||||
((7.7, 3.0, 6.1, 2.3), Virginica),
|
||||
((6.0, 2.2, 5.0, 1.5), Virginica),
|
||||
((5.5, 2.5, 4.0, 1.3), Versicolor),
|
||||
((6.5, 3.0, 5.5, 1.8), Virginica),
|
||||
((4.4, 2.9, 1.4, 0.2), Setosa),
|
||||
((6.4, 3.2, 4.5, 1.5), Versicolor),
|
||||
((5.0, 3.4, 1.6, 0.4), Setosa),
|
||||
((6.1, 2.6, 5.6, 1.4), Virginica),
|
||||
((6.6, 2.9, 4.6, 1.3), Versicolor)
|
||||
]
|
||||
168
lambda/src/LambdaDatasets/IrisDataset.hs
Normal file
168
lambda/src/LambdaDatasets/IrisDataset.hs
Normal file
@@ -0,0 +1,168 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module LambdaDatasets.IrisDataset
|
||||
( module LambdaCalculus,
|
||||
module LambdaDatasets.IrisDataset,
|
||||
module LambdaDatasets.IrisData,
|
||||
module GA,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Random
|
||||
import System.Random.MWC (createSystemRandom)
|
||||
import Data.Random.Distribution.Uniform
|
||||
import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import GA
|
||||
import LambdaCalculus
|
||||
import LambdaDatasets.IrisData
|
||||
import qualified Language.Haskell.Interpreter as Hint
|
||||
import qualified Language.Haskell.Interpreter.Unsafe as Hint
|
||||
import Protolude
|
||||
import Utils
|
||||
import Protolude.Error
|
||||
import qualified Type.Reflection as Ref
|
||||
|
||||
lE :: LambdaEnviroment
|
||||
lE =
|
||||
LambdaEnviroment
|
||||
{ functions =
|
||||
Map.fromList
|
||||
[ ((Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float))), ["(+)", "(-)", "(*)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Bool))), ["(>)", "(==)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(IrisClass -> IrisClass -> Bool))), ["(==)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Float -> Float -> Float))), ["if'","if'","if'","if'","if'","if'","if'","if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Bool -> Bool))), ["(&&)", "(||)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> IrisClass -> IrisClass -> IrisClass))), ["if'","if'","if'","if'","if'","if'","if'","if'","if'","if'"])
|
||||
],
|
||||
constants =
|
||||
Map.fromList
|
||||
[ ((Ref.SomeTypeRep (Ref.TypeRep @(Float))), [(fmap show (uniform 0 10 :: RVar Float))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool))), [(fmap show (uniform True False :: RVar Bool))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(IrisClass))), [(fmap show (enumUniform Setosa Versicolor :: RVar IrisClass))])
|
||||
],
|
||||
targetType = (Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float -> Float -> IrisClass))),
|
||||
maxDepth = 10,
|
||||
weights =
|
||||
ExpressionWeights
|
||||
{ lambdaSpucker = 1,
|
||||
lambdaSchlucker = 1,
|
||||
symbol = 30,
|
||||
variable = 100,
|
||||
constant = 5
|
||||
}
|
||||
}
|
||||
|
||||
lEE :: LamdaExecutionEnv
|
||||
lEE =
|
||||
LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.IrisDataset"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion 0.8 irisTrainingData),
|
||||
map snd (takeFraktion 0.8 irisTrainingData)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion 0.8 irisTrainingData),
|
||||
map snd (dropFraktion 0.8 irisTrainingData)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float -> Float -> IrisClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
shuffledLEE :: IO LamdaExecutionEnv
|
||||
shuffledLEE = do
|
||||
mwc <- liftIO createSystemRandom
|
||||
let smpl = ((sampleFrom mwc) :: RVar a -> IO a)
|
||||
itD <- smpl $ shuffle irisTrainingData
|
||||
return LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.IrisDataset"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion 0.8 itD),
|
||||
map snd (takeFraktion 0.8 itD)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion 0.8 itD),
|
||||
map snd (dropFraktion 0.8 itD)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float -> Float -> IrisClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
data LamdaExecutionEnv = LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports :: [Text],
|
||||
training :: Bool,
|
||||
trainingData :: ([(Float, Float, Float, Float)], [IrisClass]),
|
||||
testData :: ([(Float, Float, Float, Float)], [IrisClass]),
|
||||
exTargetType :: TypeRep,
|
||||
-- todo: kindaHacky
|
||||
results :: Map TypeRequester FittnesRes
|
||||
}
|
||||
|
||||
data FittnesRes = FittnesRes
|
||||
{ total :: R,
|
||||
fitnessTotal :: R,
|
||||
fitnessGeoMean :: R,
|
||||
fitnessMean :: R,
|
||||
accuracy :: R,
|
||||
biasSize :: R,
|
||||
totalSize :: N
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance Fitness FittnesRes where
|
||||
getR = total
|
||||
|
||||
instance Evaluator TypeRequester LamdaExecutionEnv FittnesRes where
|
||||
fitness' env tr = (results env) Map.! tr
|
||||
|
||||
calc env pop = do
|
||||
let relevantResults = Map.filterWithKey (\k _ -> contains pop k) (results env)
|
||||
let toAdd = NE.filter (\k -> not (Map.member k relevantResults)) pop
|
||||
toInsert <- Hint.runInterpreter (evalResults env toAdd)
|
||||
let insertPair (key, val) m = Map.insert key val m
|
||||
let res = foldr insertPair relevantResults (fromRight (error ("To insert is " <> show toInsert)) toInsert)
|
||||
return env {results = res}
|
||||
|
||||
dset :: LamdaExecutionEnv -> ([(Float, Float, Float, Float)], [IrisClass])
|
||||
dset lEE = if training lEE then trainingData lEE else testData lEE
|
||||
|
||||
evalResults :: LamdaExecutionEnv -> [TypeRequester] -> Hint.InterpreterT IO [(TypeRequester, FittnesRes)]
|
||||
evalResults ex trs = do
|
||||
Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"]
|
||||
Hint.unsafeSetGhcOption "-O2"
|
||||
let arrayOfFunctionText = map toLambdaExpressionS trs
|
||||
let textOfFunctionArray = "[" <> T.intercalate "," arrayOfFunctionText <> "]"
|
||||
result <- Hint.interpret (T.unpack (textOfFunctionArray)) (Hint.as :: [Float -> Float -> Float -> Float -> IrisClass])
|
||||
return $ zipWith (evalResult ex) trs result
|
||||
|
||||
|
||||
evalResult :: LamdaExecutionEnv -> TypeRequester -> (Float -> Float -> Float -> Float -> IrisClass) -> (TypeRequester, FittnesRes)
|
||||
evalResult ex tr result = ( tr,
|
||||
FittnesRes
|
||||
{ total = score,
|
||||
fitnessTotal = fitness',
|
||||
fitnessMean = meanOfAccuricyPerClass resAndTarget,
|
||||
fitnessGeoMean = geomeanOfDistributionAccuracy resAndTarget,
|
||||
accuracy = acc,
|
||||
biasSize = biasSmall,
|
||||
totalSize = countTrsR tr
|
||||
}
|
||||
)
|
||||
where
|
||||
res = map (\(a, b, c, d) -> result a b c d) (fst (dset ex))
|
||||
resAndTarget = (zip (snd (dset ex)) res)
|
||||
acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) / fromIntegral (length resAndTarget)
|
||||
biasSmall = exp ((-(fromIntegral (countTrsR tr))) / 1000) -- 0 (schlecht) bis 1 (gut)
|
||||
fitness' = meanOfAccuricyPerClass resAndTarget
|
||||
score = fitness' + (biasSmall - 1)
|
||||
12978
lambda/src/LambdaDatasets/NurseryData.hs
Normal file
12978
lambda/src/LambdaDatasets/NurseryData.hs
Normal file
File diff suppressed because it is too large
Load Diff
199
lambda/src/LambdaDatasets/NurseryDataset.hs
Normal file
199
lambda/src/LambdaDatasets/NurseryDataset.hs
Normal file
@@ -0,0 +1,199 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
|
||||
module LambdaDatasets.NurseryDataset
|
||||
( module LambdaCalculus,
|
||||
module LambdaDatasets.NurseryDataset,
|
||||
module LambdaDatasets.NurseryData,
|
||||
module GA,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Random
|
||||
import Data.Random.Distribution.Uniform
|
||||
import qualified Data.Text as T
|
||||
import Data.Tuple.Extra
|
||||
import GA
|
||||
import LambdaDatasets.NurseryData
|
||||
import LambdaCalculus
|
||||
import qualified Language.Haskell.Interpreter as Hint
|
||||
import qualified Language.Haskell.Interpreter.Unsafe as Hint
|
||||
import Protolude
|
||||
import Protolude.Error
|
||||
import System.Random.MWC (createSystemRandom)
|
||||
import qualified Type.Reflection as Ref
|
||||
import Utils
|
||||
|
||||
lE :: LambdaEnviroment
|
||||
lE =
|
||||
LambdaEnviroment
|
||||
{ functions =
|
||||
Map.fromList
|
||||
[ -- Math
|
||||
-- Logic
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Bool -> Bool))), ["(&&)", "(||)"]),
|
||||
-- Ordered Enums
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(NurseryClass -> NurseryClass -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Parents -> Parents -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(HasNurs -> HasNurs -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Form -> Form -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Children -> Children -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Housing -> Housing -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Finance -> Finance -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Social -> Social -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Health -> Health -> Bool))), ["(>)", "(==)", "(/=)", "(>=)"]),
|
||||
-- Eq Enum
|
||||
-- Any Type
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Int -> Int -> Int))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> NurseryClass -> NurseryClass -> NurseryClass))), ["if'","if'","if'","if'","if'","if'","if'","if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Parents -> Parents -> Parents))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> HasNurs -> HasNurs -> HasNurs))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Form -> Form -> Form))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Children -> Children -> Children))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Housing -> Housing -> Housing))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Finance -> Finance -> Finance))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Social -> Social -> Social))), ["if'"]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Health -> Health -> Health))), ["if'"])
|
||||
],
|
||||
constants =
|
||||
Map.fromList
|
||||
[ ((Ref.SomeTypeRep (Ref.TypeRep @(Bool))), [(fmap show (uniform True False :: RVar Bool))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(NurseryClass))), [(fmap show (enumUniform NotRecommend SpecPriority))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Parents))), [(fmap show (enumUniform Usual GreatPret))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(HasNurs))), [(fmap show (enumUniform ProperNurs VeryCritNurs ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Form))), [(fmap show (enumUniform CompleteFamilyForm FosterFamilyForm ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Children))), [(fmap show (enumUniform OneChild MoreChilds ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Housing))), [(fmap show (enumUniform ConvenientHousing CriticalHousing ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Finance))), [(fmap show (enumUniform ConvenientFinance InconvFinance ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Social))), [(fmap show (enumUniform NotProblematicSocial ProblematicSocial ))]),
|
||||
((Ref.SomeTypeRep (Ref.TypeRep @(Health))), [(fmap show (enumUniform NotRecommendHealth PriorityHealth ))])
|
||||
],
|
||||
targetType = (Ref.SomeTypeRep (Ref.TypeRep @(Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass))),
|
||||
maxDepth = 8,
|
||||
weights =
|
||||
ExpressionWeights
|
||||
{ lambdaSpucker = 1,
|
||||
lambdaSchlucker = 2,
|
||||
symbol = 30,
|
||||
variable = 20,
|
||||
constant = 5
|
||||
}
|
||||
}
|
||||
|
||||
trainingFraction :: R
|
||||
trainingFraction = (2/3)
|
||||
|
||||
lEE :: LamdaExecutionEnv
|
||||
lEE =
|
||||
LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.NurseryDefinition"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion trainingFraction nurseryTrainingData),
|
||||
map snd (takeFraktion trainingFraction nurseryTrainingData)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion trainingFraction nurseryTrainingData),
|
||||
map snd (dropFraktion trainingFraction nurseryTrainingData)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
shuffledLEE :: IO LamdaExecutionEnv
|
||||
shuffledLEE = do
|
||||
mwc <- liftIO createSystemRandom
|
||||
let smpl = ((sampleFrom mwc) :: RVar a -> IO a)
|
||||
itD <- smpl $ shuffle nurseryTrainingData
|
||||
return
|
||||
LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports = ["LambdaDatasets.NurseryDefinition"],
|
||||
training = True,
|
||||
trainingData =
|
||||
( map fst (takeFraktion trainingFraction itD),
|
||||
map snd (takeFraktion trainingFraction itD)
|
||||
),
|
||||
testData =
|
||||
( map fst (dropFraktion trainingFraction itD),
|
||||
map snd (dropFraktion trainingFraction itD)
|
||||
),
|
||||
exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass))),
|
||||
results = Map.empty
|
||||
}
|
||||
|
||||
data LamdaExecutionEnv = LamdaExecutionEnv
|
||||
{ -- For now these need to define all available functions and types. Generic functions can be used.
|
||||
imports :: [Text],
|
||||
training :: Bool,
|
||||
trainingData :: ([(Parents, HasNurs, Form, Children, Housing, Finance, Social, Health)], [NurseryClass]),
|
||||
testData :: ([(Parents, HasNurs, Form, Children, Housing, Finance, Social, Health)], [NurseryClass]),
|
||||
exTargetType :: TypeRep,
|
||||
-- todo: kindaHacky
|
||||
results :: Map TypeRequester FittnesRes
|
||||
}
|
||||
|
||||
data FittnesRes = FittnesRes
|
||||
{ total :: R,
|
||||
fitnessTotal :: R,
|
||||
fitnessGeoMean :: R,
|
||||
fitnessMean :: R,
|
||||
accuracy :: R,
|
||||
biasSize :: R,
|
||||
totalSize :: N
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
instance Fitness FittnesRes where
|
||||
getR = total
|
||||
|
||||
instance Evaluator TypeRequester LamdaExecutionEnv FittnesRes where
|
||||
fitness' env tr = (results env) Map.! tr
|
||||
|
||||
calc env pop = do
|
||||
let relevantResults = Map.filterWithKey (\k _ -> contains pop k) (results env)
|
||||
let toAdd = NE.filter (\k -> not (Map.member k relevantResults)) pop
|
||||
toInsert <- Hint.runInterpreter (evalResults env toAdd)
|
||||
let insertPair (key, val) m = Map.insert key val m
|
||||
let res = foldr insertPair relevantResults (fromRight (error ("To insert is " <> show toInsert)) toInsert)
|
||||
return env {results = res}
|
||||
|
||||
dset :: LamdaExecutionEnv -> ([(Parents, HasNurs, Form, Children, Housing, Finance, Social, Health)], [NurseryClass])
|
||||
dset lEE = if training lEE then trainingData lEE else testData lEE
|
||||
|
||||
evalResults :: LamdaExecutionEnv -> [TypeRequester] -> Hint.InterpreterT IO [(TypeRequester, FittnesRes)]
|
||||
evalResults ex trs = do
|
||||
Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"]
|
||||
Hint.unsafeSetGhcOption "-O2"
|
||||
let arrayOfFunctionText = map toLambdaExpressionS trs
|
||||
let textOfFunctionArray = "[" <> T.intercalate "," arrayOfFunctionText <> "]"
|
||||
result <- Hint.interpret (T.unpack (textOfFunctionArray)) (Hint.as :: [Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass])
|
||||
return $ zipWith (evalResult ex) trs result
|
||||
|
||||
|
||||
evalResult :: LamdaExecutionEnv -> TypeRequester -> (Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass) -> (TypeRequester, FittnesRes)
|
||||
evalResult ex tr result = ( tr,
|
||||
FittnesRes
|
||||
{ total = acc * 100 + (biasSmall - 1),
|
||||
fitnessTotal = fitness',
|
||||
fitnessMean = meanOfAccuricyPerClass resAndTarget,
|
||||
fitnessGeoMean = geomeanOfDistributionAccuracy resAndTarget,
|
||||
accuracy = acc,
|
||||
biasSize = biasSmall,
|
||||
totalSize = countTrsR tr
|
||||
}
|
||||
)
|
||||
where
|
||||
res = map (\(a, b, c, d, e, f, g, h) -> result a b c d e f g h) (fst (dset ex))
|
||||
resAndTarget = (zip (snd (dset ex)) res)
|
||||
acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) / fromIntegral (length resAndTarget)
|
||||
biasSmall = exp ((-(fromIntegral (countTrsR tr))) / 1000) -- 0 (schlecht) bis 1 (gut)
|
||||
fitness' = meanOfAccuricyPerClass resAndTarget
|
||||
score = fitness' + (biasSmall - 1)
|
||||
|
||||
Reference in New Issue
Block a user