tweak params

haga.cabal

@@ -30,6 +30,7 @@ library
                      , MonadRandom
                      , mwc-random
                      , optparse-applicative
+                     , parallel
                      , path
                      , pipes
                      , primitive
@@ -63,6 +64,7 @@ executable haga
                      , MonadRandom
                      , mwc-random
                      , optparse-applicative
+                     , parallel
                      , path
                      , pipes
                      , primitive
@@ -99,6 +101,7 @@ executable haga-test
                      , MonadRandom
                      , mwc-random
                      , optparse-applicative
+                     , parallel
                      , path
                      , pipes
                      , primitive

src/Main.hs

@@ -26,7 +26,7 @@ options =
       ( long "iterations"
           <> short 'i'
           <> metavar "N"
-          <> value 1000
+          <> value 100
           <> help "Number of iterations"
       )
     <*> option
@@ -34,7 +34,7 @@ options =
       ( long "population-size"
           <> short 'p'
           <> metavar "N"
-          <> value 100
+          <> value 200
           <> help "Population size"
       )
 
@@ -54,7 +54,7 @@ main =
     nurseryLEE <- shuffledNurseryLEE
     let env = nurseryLE
     let selType = Tournament 3
-    let run' = run nurseryLEE env selType 80 (5 / 100) (populationSize opts) (steps (iterations opts))
+    let run' = run nurseryLEE env selType 150 (5 / 100) (populationSize opts) (steps (iterations opts))
     pop' <- runEffect (for run' logCsv)
     nurseryLEE' <- calc nurseryLEE  pop'
     let (res, _) = bests nurseryLEE' 5 pop'

src/NurseryDataset.hs

@@ -74,13 +74,13 @@ nurseryLE =
             ((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,
+      maxDepth = 7,
       weights =
         ExpressionWeights
-          { lambdaSpucker = 1,
+          { lambdaSpucker = 2,
             lambdaSchlucker = 1,
             symbol = 30,
-            variable = 10,
+            variable = 20,
             constant = 5
           }
     }
@@ -165,23 +165,19 @@ dset :: LamdaExecutionEnv -> ([(Parents, HasNurs, Form, Children, Housing, Finan
 dset lEE = if training lEE then trainingData lEE else testData lEE
 
 evalResults :: LamdaExecutionEnv -> [TypeRequester] -> Hint.InterpreterT IO [(TypeRequester, FittnesRes)]
-evalResults ex trs = mapM (evalResult ex) trs
+evalResults ex trs = do
-
-evalResult :: LamdaExecutionEnv -> TypeRequester -> Hint.InterpreterT IO (TypeRequester, FittnesRes)
-evalResult ex tr = do
   Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"]
   Hint.unsafeSetGhcOption "-O2"
-  result <- Hint.interpret (T.unpack (toLambdaExpressionS tr)) (Hint.as :: Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass)
+  let arrayOfFunctionText = map toLambdaExpressionS trs
-  let res = map (\(a, b, c, d, e, f, g, h) -> result a b c d e f g h) (fst (dset ex))
+  let textOfFunctionArray = "[" <> T.intercalate "," arrayOfFunctionText <> "]"
-  let resAndTarget = (zip (snd (dset ex)) res)
+  result <- Hint.interpret (T.unpack (textOfFunctionArray)) (Hint.as :: [Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass])
-  let acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) / fromIntegral (length resAndTarget)
+  return $ zipWith (evalResult ex) trs result
-  let biasSmall = exp ((-(fromIntegral (countTrsR tr))) / 1000) -- 0 (schlecht) bis 1 (gut)
+
-  let fitness' = meanOfAccuricyPerClass resAndTarget
+
-  let score = fitness' + (biasSmall - 1)
+evalResult :: LamdaExecutionEnv -> TypeRequester -> (Parents -> HasNurs -> Form -> Children -> Housing -> Finance -> Social -> Health -> NurseryClass) -> (TypeRequester, FittnesRes)
-  return
+evalResult ex tr result = ( tr,
-    ( tr,
       FittnesRes
-        { total = score,
+        { total = acc * 100 + (biasSmall - 1),
           fitnessTotal = fitness',
           fitnessMean = meanOfAccuricyPerClass resAndTarget,
           fitnessGeoMean = geomeanOfDistributionAccuracy resAndTarget,
@@ -190,6 +186,14 @@ evalResult ex tr = do
           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)
+
 
 if' :: Bool -> a -> a -> a
 if' True e _ = e

src/Utils.hs

@@ -30,7 +30,7 @@ geomean :: (Show f, Floating f) => [f] -> f
 geomean values = (product values) ** (1 / (fromIntegral (length values)))
 
 accuracyInClass :: (Eq r) => [(r, r)] -> r -> R
-accuracyInClass results clas = ((accuracy' (inResClass results clas)) * 100) / fromIntegral (length (inClass results clas))
+accuracyInClass results clas = if fromIntegral (length (inClass results clas)) == 0 then 100 else ((accuracy' (inResClass results clas)) * 100) / fromIntegral (length (inClass results clas))
 
 inClass :: (Eq r) => [(r, r)] -> r -> [(r, r)]
 inClass results clas = (filter ((clas ==) . fst) results)