From 6435f4aca2720c693c6c61875aabd8bf430639b9 Mon Sep 17 00:00:00 2001 From: Johannes Merl Date: Mon, 4 Mar 2024 11:36:31 +0100 Subject: [PATCH] implement Iris dataset --- src/GA.hs | 10 +- src/IrisDataset.hs | 438 ++++++++++++++++++++++++++++++++++++++++++ src/LambdaCalculus.hs | 21 +- src/Main.hs | 19 +- 4 files changed, 464 insertions(+), 24 deletions(-) create mode 100644 src/IrisDataset.hs diff --git a/src/GA.hs b/src/GA.hs index 23d37b4..414d945 100644 --- a/src/GA.hs +++ b/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 @@ -170,7 +171,7 @@ reproduce :: Population i -> RVar (Population i) reproduce eval env selectT nParents pop = do - iParents <- select selectT nParents pop eval + iParents <-select selectT nParents pop eval iChildren <- NE.filter (`notElem` pop) <$> children env iParents let pop' = pop `NE.appendl` iChildren return pop' @@ -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 diff --git a/src/IrisDataset.hs b/src/IrisDataset.hs new file mode 100644 index 0000000..697cac3 --- /dev/null +++ b/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 diff --git a/src/LambdaCalculus.hs b/src/LambdaCalculus.hs index 4a35a0c..af9f98b 100644 --- a/src/LambdaCalculus.hs +++ b/src/LambdaCalculus.hs @@ -62,21 +62,22 @@ exampleLE = weights = ExpressionWeights { lambdaSpucker = 1, - lambdaSchlucker = 1, - symbol = 1, - variable = 1, - constant = 1 + lambdaSchlucker = 2, + symbol = 2, + variable = 10, + 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 diff --git a/src/Main.hs b/src/Main.hs index fbd99ec..b16c03e 100644 --- a/src/Main.hs +++ b/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 selType = Tournament 20 - let run' = run prios env selType 20 (5 / 100) (populationSize opts) (steps (iterations opts)) :: Producer (Int, R) IO (Population Assignment) + let env = irisLE + let selType = Tournament 3 + 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 - let f = fitness prios s + format irisL s = do + let f = fitness irisL s putErrText $ show f <> "\n" <> pretty s logCsv = putText . csv csv (t, f) = show t <> " " <> show f