implement Iris dataset

src/GA.hs

@@ -35,6 +35,7 @@ import System.Random.MWC (create, createSystemRandom)
 import Test.QuickCheck hiding (sample, shuffle)
 import Test.QuickCheck.Instances ()
 import Test.QuickCheck.Monadic
+import Debug.Trace as DB
 
 -- TODO there should be a few 'shuffle's here
 
@@ -214,13 +215,10 @@ run eval env selectionType nParents pElite nPop term = do
   mwc <- liftIO createSystemRandom
   let smpl = ((sampleFrom mwc) :: RVar a -> IO a)
   firstPop <- liftIO $ smpl $ (population env nPop)
-  _ <- liftIO $ putText $ pretty $ NE.head firstPop
-  firstPop <- liftIO $ smpl $ (population env nPop)
-  _ <- liftIO $ putText $ pretty $ NE.head firstPop
   res <- runIter eval 0 firstPop smpl
   return res
   where
-    runIter eval count pop smpl =
+    runIter eval count pop smpl = (
       if term pop count
         then do
           return pop
@@ -232,7 +230,7 @@ run eval env selectionType nParents pElite nPop term = do
           let fBest = fitness eval $ NE.head $ fst $ bests eval 1 resPop
           Pipes.yield (count, fBest)
           res <- runIter eval (count + 1) resPop smpl
-          return res
+          return res)
 
 -- * Selection mechanisms
 

src/IrisDataset.hs

@@ -0,0 +1,438 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module IrisDataset
+  ( module LambdaCalculus,
+    module IrisDataset,
+    module GA,
+  )
+where
+
+import qualified Data.ByteString.Lazy as B
+import Data.Csv
+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 qualified Debug.Trace as DB
+import GA
+import LambdaCalculus
+import qualified Language.Haskell.Interpreter as Hint
+import qualified Language.Haskell.Interpreter.Unsafe as Hint
+import Protolude
+import qualified Type.Reflection as Ref
+
+data IrisClass = Setosa | Virginica | Versicolor deriving (Eq, Generic, Show, Enum, Bounded)
+
+instance FromRecord IrisClass
+
+instance ToRecord IrisClass
+
+irisLE :: LambdaEnviroment
+irisLE =
+  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'"]),
+            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> Bool -> Bool))), ["(&&)", "(||)"]),
+            ((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> IrisClass -> IrisClass -> IrisClass))), ["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 = 1,
+            variable = 2,
+            constant = 1
+          }
+    }
+
+irisLEE :: LamdaExecutionEnv
+irisLEE =
+  LamdaExecutionEnv
+    { -- For now these need to define all available functions and types. Generic functions can be used.
+      imports = ["IrisDataset"],
+      -- Path to a CSV file containing the training dataset
+      trainingDataset = "./iris.csv",
+      -- Path to a CSV file containing the dataset results
+      trainingDatasetRes = "./res.csv",
+      trainingData =
+        ( [ (5.1, 3.5, 1.4, 0.2),
+            (4.9, 3.0, 1.4, 0.2),
+            (4.7, 3.2, 1.3, 0.2),
+            (4.6, 3.1, 1.5, 0.2),
+            (5.0, 3.6, 1.4, 0.2),
+            (5.4, 3.9, 1.7, 0.4),
+            (4.6, 3.4, 1.4, 0.3),
+            (5.0, 3.4, 1.5, 0.2),
+            (4.4, 2.9, 1.4, 0.2),
+            (4.9, 3.1, 1.5, 0.1),
+            (5.4, 3.7, 1.5, 0.2),
+            (4.8, 3.4, 1.6, 0.2),
+            (4.8, 3.0, 1.4, 0.1),
+            (4.3, 3.0, 1.1, 0.1),
+            (5.8, 4.0, 1.2, 0.2),
+            (5.7, 4.4, 1.5, 0.4),
+            (5.4, 3.9, 1.3, 0.4),
+            (5.1, 3.5, 1.4, 0.3),
+            (5.7, 3.8, 1.7, 0.3),
+            (5.1, 3.8, 1.5, 0.3),
+            (5.4, 3.4, 1.7, 0.2),
+            (5.1, 3.7, 1.5, 0.4),
+            (4.6, 3.6, 1.0, 0.2),
+            (5.1, 3.3, 1.7, 0.5),
+            (4.8, 3.4, 1.9, 0.2),
+            (5.0, 3.0, 1.6, 0.2),
+            (5.0, 3.4, 1.6, 0.4),
+            (5.2, 3.5, 1.5, 0.2),
+            (5.2, 3.4, 1.4, 0.2),
+            (4.7, 3.2, 1.6, 0.2),
+            (4.8, 3.1, 1.6, 0.2),
+            (5.4, 3.4, 1.5, 0.4),
+            (5.2, 4.1, 1.5, 0.1),
+            (5.5, 4.2, 1.4, 0.2),
+            (4.9, 3.1, 1.5, 0.1),
+            (5.0, 3.2, 1.2, 0.2),
+            (5.5, 3.5, 1.3, 0.2),
+            (4.9, 3.1, 1.5, 0.1),
+            (4.4, 3.0, 1.3, 0.2),
+            (5.1, 3.4, 1.5, 0.2),
+            (5.0, 3.5, 1.3, 0.3),
+            (4.5, 2.3, 1.3, 0.3),
+            (4.4, 3.2, 1.3, 0.2),
+            (5.0, 3.5, 1.6, 0.6),
+            (5.1, 3.8, 1.9, 0.4),
+            (4.8, 3.0, 1.4, 0.3),
+            (5.1, 3.8, 1.6, 0.2),
+            (4.6, 3.2, 1.4, 0.2),
+            (5.3, 3.7, 1.5, 0.2),
+            (5.0, 3.3, 1.4, 0.2),
+            (7.0, 3.2, 4.7, 1.4),
+            (6.4, 3.2, 4.5, 1.5),
+            (6.9, 3.1, 4.9, 1.5),
+            (5.5, 2.3, 4.0, 1.3),
+            (6.5, 2.8, 4.6, 1.5),
+            (5.7, 2.8, 4.5, 1.3),
+            (6.3, 3.3, 4.7, 1.6),
+            (4.9, 2.4, 3.3, 1.0),
+            (6.6, 2.9, 4.6, 1.3),
+            (5.2, 2.7, 3.9, 1.4),
+            (5.0, 2.0, 3.5, 1.0),
+            (5.9, 3.0, 4.2, 1.5),
+            (6.0, 2.2, 4.0, 1.0),
+            (6.1, 2.9, 4.7, 1.4),
+            (5.6, 2.9, 3.6, 1.3),
+            (6.7, 3.1, 4.4, 1.4),
+            (5.6, 3.0, 4.5, 1.5),
+            (5.8, 2.7, 4.1, 1.0),
+            (6.2, 2.2, 4.5, 1.5),
+            (5.6, 2.5, 3.9, 1.1),
+            (5.9, 3.2, 4.8, 1.8),
+            (6.1, 2.8, 4.0, 1.3),
+            (6.3, 2.5, 4.9, 1.5),
+            (6.1, 2.8, 4.7, 1.2),
+            (6.4, 2.9, 4.3, 1.3),
+            (6.6, 3.0, 4.4, 1.4),
+            (6.8, 2.8, 4.8, 1.4),
+            (6.7, 3.0, 5.0, 1.7),
+            (6.0, 2.9, 4.5, 1.5),
+            (5.7, 2.6, 3.5, 1.0),
+            (5.5, 2.4, 3.8, 1.1),
+            (5.5, 2.4, 3.7, 1.0),
+            (5.8, 2.7, 3.9, 1.2),
+            (6.0, 2.7, 5.1, 1.6),
+            (5.4, 3.0, 4.5, 1.5),
+            (6.0, 3.4, 4.5, 1.6),
+            (6.7, 3.1, 4.7, 1.5),
+            (6.3, 2.3, 4.4, 1.3),
+            (5.6, 3.0, 4.1, 1.3),
+            (5.5, 2.5, 4.0, 1.3),
+            (5.5, 2.6, 4.4, 1.2),
+            (6.1, 3.0, 4.6, 1.4),
+            (5.8, 2.6, 4.0, 1.2),
+            (5.0, 2.3, 3.3, 1.0),
+            (5.6, 2.7, 4.2, 1.3),
+            (5.7, 3.0, 4.2, 1.2),
+            (5.7, 2.9, 4.2, 1.3),
+            (6.2, 2.9, 4.3, 1.3),
+            (5.1, 2.5, 3.0, 1.1),
+            (5.7, 2.8, 4.1, 1.3),
+            (6.3, 3.3, 6.0, 2.5),
+            (5.8, 2.7, 5.1, 1.9),
+            (7.1, 3.0, 5.9, 2.1),
+            (6.3, 2.9, 5.6, 1.8),
+            (6.5, 3.0, 5.8, 2.2),
+            (7.6, 3.0, 6.6, 2.1),
+            (4.9, 2.5, 4.5, 1.7),
+            (7.3, 2.9, 6.3, 1.8),
+            (6.7, 2.5, 5.8, 1.8),
+            (7.2, 3.6, 6.1, 2.5),
+            (6.5, 3.2, 5.1, 2.0),
+            (6.4, 2.7, 5.3, 1.9),
+            (6.8, 3.0, 5.5, 2.1),
+            (5.7, 2.5, 5.0, 2.0),
+            (5.8, 2.8, 5.1, 2.4),
+            (6.4, 3.2, 5.3, 2.3),
+            (6.5, 3.0, 5.5, 1.8),
+            (7.7, 3.8, 6.7, 2.2),
+            (7.7, 2.6, 6.9, 2.3),
+            (6.0, 2.2, 5.0, 1.5),
+            (6.9, 3.2, 5.7, 2.3),
+            (5.6, 2.8, 4.9, 2.0),
+            (7.7, 2.8, 6.7, 2.0),
+            (6.3, 2.7, 4.9, 1.8),
+            (6.7, 3.3, 5.7, 2.1),
+            (7.2, 3.2, 6.0, 1.8),
+            (6.2, 2.8, 4.8, 1.8),
+            (6.1, 3.0, 4.9, 1.8),
+            (6.4, 2.8, 5.6, 2.1),
+            (7.2, 3.0, 5.8, 1.6),
+            (7.4, 2.8, 6.1, 1.9),
+            (7.9, 3.8, 6.4, 2.0),
+            (6.4, 2.8, 5.6, 2.2),
+            (6.3, 2.8, 5.1, 1.5),
+            (6.1, 2.6, 5.6, 1.4),
+            (7.7, 3.0, 6.1, 2.3),
+            (6.3, 3.4, 5.6, 2.4),
+            (6.4, 3.1, 5.5, 1.8),
+            (6.0, 3.0, 4.8, 1.8),
+            (6.9, 3.1, 5.4, 2.1),
+            (6.7, 3.1, 5.6, 2.4),
+            (6.9, 3.1, 5.1, 2.3),
+            (5.8, 2.7, 5.1, 1.9),
+            (6.8, 3.2, 5.9, 2.3),
+            (6.7, 3.3, 5.7, 2.5),
+            (6.7, 3.0, 5.2, 2.3),
+            (6.3, 2.5, 5.0, 1.9),
+            (6.5, 3.0, 5.2, 2.0),
+            (6.2, 3.4, 5.4, 2.3),
+            (5.9, 3.0, 5.1, 1.8)
+          ],
+          [ Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Setosa,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Versicolor,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica,
+            Virginica
+          ]
+        ),
+      exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float -> Float -> IrisClass))),
+      -- todo: kindaHacky
+      results = Map.empty
+    }
+
+data LamdaExecutionEnv = LamdaExecutionEnv
+  { -- For now these need to define all available functions and types. Generic functions can be used.
+    imports :: [Text],
+    -- Path to a CSV file containing the training dataset
+    trainingDataset :: FilePath,
+    -- Path to a CSV file containing the dataset results
+    trainingDatasetRes :: FilePath,
+    trainingData :: ([(Float, Float, Float, Float)], [IrisClass]),
+    exTargetType :: TypeRep,
+    -- todo: kindaHacky
+    results :: Map TypeRequester R
+  }
+
+instance Evaluator TypeRequester LamdaExecutionEnv where
+  fitness env tr = (results env) Map.! tr
+
+  calc env pop = do
+    let toAdd = NE.filter (\k -> not (Map.member k (results env))) pop
+    env <- loadTrainingData env
+    toInsert <- Hint.runInterpreter (evalResults env toAdd)
+    let insertPair (key, val) m = Map.insert key val m
+    let res = foldr insertPair (results env) (fromRight undefined toInsert)
+    return env {results = res}
+
+loadTrainingData :: LamdaExecutionEnv -> IO LamdaExecutionEnv
+loadTrainingData ex@LamdaExecutionEnv {trainingData = ([], [])} = do
+  csv <- B.readFile (trainingDataset ex)
+  let dat = (toList $ fromRight undefined $ decode NoHeader csv) :: [(Float, Float, Float, Float)]
+  csvRes <- B.readFile (trainingDatasetRes ex)
+  let decodedRes = decode NoHeader csvRes
+  let recsRes = (toList $ fromRight undefined decodedRes) :: [IrisClass]
+  return ex {trainingData = (dat, recsRes)}
+loadTrainingData lee@LamdaExecutionEnv {trainingData = (_ : _, _ : _)} = return lee
+loadTrainingData lee@LamdaExecutionEnv {trainingData = (_ : _, [])} = return undefined
+loadTrainingData lee@LamdaExecutionEnv {trainingData = ([], _ : _)} = return undefined
+
+evalResults :: LamdaExecutionEnv -> [TypeRequester] -> Hint.InterpreterT IO [(TypeRequester, R)]
+evalResults ex trs = mapM (evalResult ex) trs
+
+evalResult :: LamdaExecutionEnv -> TypeRequester -> Hint.InterpreterT IO (TypeRequester, R)
+evalResult ex tr = do
+  Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"]
+  Hint.unsafeSetGhcOption "-O2"
+  result <- Hint.interpret (T.unpack (toLambdaExpressionS tr)) (Hint.as :: Float -> Float -> Float -> Float -> IrisClass)
+  let res = map (\(a,b,c,d) -> result a b c d) (fst (trainingData ex))
+  let resAndTarget = (zip (snd (trainingData ex)) res)
+  let acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) :: R
+  let biasWellDistributed = (foldr (*) 1 (map (\ty -> (foldr (\ts s -> if ((snd ts) == ty) then s + 1 else s) 1 resAndTarget)) ([minBound..maxBound] :: [IrisClass]):: [R])) ** (1/3)
+  let biasSmall = exp ( - (fromIntegral (countTrsR tr)))
+  let score = acc + (biasWellDistributed/5.1) + (biasSmall)
+  return (tr, score)
+
+if' :: Bool -> a -> a -> a
+if' True e _ = e
+if' False _ e = e

src/LambdaCalculus.hs

@@ -62,21 +62,22 @@ exampleLE =
       weights =
         ExpressionWeights
           { lambdaSpucker = 1,
-            lambdaSchlucker = 1,
+            lambdaSchlucker = 2,
-            symbol = 1,
+            symbol = 2,
-            variable = 1,
+            variable = 10,
-            constant = 1
+            constant = 2
           }
     }
 
 type BoundVars = [TypeRep]
 
+
 -- we need a dynamic typ with a concept of equality here, should we want to interpret the result, instead of compiling it...
 type ConVal = Text
 
 -- LambdaSpucker - adds TypeRequester#1 as bound var and returns the result of TypeRequester#2
 
-data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord)
+data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show)
 
 asList :: LambdaExpression -> [TypeRequester]
 asList (LambdaSpucker tr1 tr2 _) = [tr1, tr2]
@@ -85,7 +86,7 @@ asList (Symbol _ trs _) = trs
 asList (Var _ _ trs _) = trs
 asList (Constan _) = []
 
-data TypeRequester = TR TypeRep (Maybe LambdaExpression) BoundVars deriving (Eq, Ord)
+data TypeRequester = TR TypeRep (Maybe LambdaExpression) BoundVars deriving (Eq, Ord, Show)
 
 toLambdaExpressionS :: TypeRequester -> Text
 toLambdaExpressionS (TR typeRep (Just lambdaExpression) boundVars) = "((" <> eToLambdaExpressionS lambdaExpression <> ") :: (" <> show typeRep <> "))"
@@ -163,7 +164,7 @@ doTypesMatch toGen available = elem toGen (available : (repeatedly (lastMay . ty
 
 genLambdaSpucker :: LambdaEnviroment -> Int -> TypeRep -> BoundVars -> RVar LambdaExpression
 genLambdaSpucker env@(LambdaEnviroment functions constants _ _ weights) depthLeft target boundVar = do
-  lamdaTypeLength <- uniform 1 3
+  lamdaTypeLength <- uniform 1 4
   lambaTypes <- replicateM lamdaTypeLength (randomElement (Map.keys constants))
   let lambaType = foldr1 mkFunTy lambaTypes
   lamdaVarTypeRequester <- genTypeRequester env depthLeft lambaType boundVar
@@ -260,7 +261,7 @@ instance Environment TypeRequester LambdaEnviroment where
 -- findIndicesWhere' (tr:trs) f indx = (findIndicesWhere tr f indx) ++ (findIndicesWhere' trs f (indx + countTrsR tr))
 
 replaceAtR :: Int -> TypeRequester -> TypeRequester -> TypeRequester
-replaceAtR 0 _ with = with
+replaceAtR 1 _ with = with
 replaceAtR i (TR tm (Just le) bV) with = TR tm (Just (replaceAt (i - 1) le with)) bV
 replaceAtR _ (TR _ Nothing _) _ = undefined
 
@@ -276,7 +277,7 @@ replaceInSubtreeWithIndex indexLeft (tr : trs) with = if countTrsR tr >= indexLe
 replaceInSubtreeWithIndex _ [] _ = undefined
 
 depthLeftAndTypeAtR :: TypeRequester -> Int -> Int -> (Int, TypeRequester)
-depthLeftAndTypeAtR t 0 depthLeft = ((depthLeft - 1), t)
+depthLeftAndTypeAtR t 1 depthLeft = ((depthLeft - 1), t)
 depthLeftAndTypeAtR (TR _ (Just le) _) indexLeft depthLeft = depthLeftAndTypeAt le (indexLeft - 1) (depthLeft - 1)
 depthLeftAndTypeAtR (TR _ Nothing _) indexLeft depthLeft = undefined
 
@@ -458,7 +459,7 @@ toLambdaExpressionShort (TR _ (Nothing) _) = "Invalid Lambda Epr"
 
 eToLambdaExpressionShort :: LambdaExpression -> Text
 eToLambdaExpressionShort (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester2 <> ") " <> toLambdaExpressionShort typeRequester1
-eToLambdaExpressionShort (LambdaSchlucker typeRequester boundVars) = "()\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester <> ")"
+eToLambdaExpressionShort (LambdaSchlucker typeRequester boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionShort typeRequester <> ")"
 eToLambdaExpressionShort (Symbol (valS) typeRequesters _) = valS <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
 eToLambdaExpressionShort (Var typeRep int typeRequesters _) = "l" <> showSanifid typeRep <> show int <> " " <> (unwords (map toLambdaExpressionShort typeRequesters))
 eToLambdaExpressionShort (Constan (valS)) = valS

src/Main.hs

@@ -8,7 +8,8 @@ import Pretty
 import Protolude hiding (for)
 import System.IO
 -- import Szenario212Pun
-import Szenario191
+-- import Szenario191
+import IrisDataset
 
 data Options = Options
   { iterations :: !N,
@@ -48,16 +49,18 @@ main :: IO ()
 main =
   execParser optionsWithHelp >>= \opts -> do
     hSetBuffering stdout NoBuffering
-    let env = AssignmentEnviroment (students prios, topics prios)
+    let env = irisLE
-    let selType = Tournament 20
+    let selType = Tournament 3
-    let run' = run prios env selType 20 (5 / 100) (populationSize opts) (steps (iterations opts)) :: Producer (Int, R) IO (Population Assignment)
+    let run' = run irisLEE env selType 40 (5 / 100) (populationSize opts) (steps (iterations opts)) :: Producer (Int, R) IO (Population TypeRequester)
     pop' <-
       runEffect (for run' logCsv)
-    let (res, _) = bests prios 5 pop'
+
-    mapM_ format res
+    irisLE <- calc irisLEE  pop'
+    let (res, _) = bests irisLE 5 pop'
+    mapM_ (format irisLE) res
   where
-    format s = do
+    format irisL s = do
-      let f = fitness prios s
+      let f = fitness irisL s
       putErrText $ show f <> "\n" <> pretty s
     logCsv = putText . csv
     csv (t, f) = show t <> " " <> show f