From 4286ee36d95c7aedfe701733bd23b56603f051d9 Mon Sep 17 00:00:00 2001 From: Johannes Merl Date: Sun, 17 Mar 2024 18:14:52 +0100 Subject: [PATCH] iris ready --- src/GA.hs | 7 +-- src/IrisData.hs | 73 +++++++++++++-------------- src/IrisDataset.hs | 36 +++++++------- src/LambdaCalculus.hs | 111 ++++++++++++++++++++++++++++++++++-------- src/Main.hs | 18 ++++--- 5 files changed, 160 insertions(+), 85 deletions(-) diff --git a/src/GA.hs b/src/GA.hs index 2dffb69..6780fb9 100644 --- a/src/GA.hs +++ b/src/GA.hs @@ -31,6 +31,7 @@ import Data.Random import Pipes import Pretty import Protolude +import Protolude.Error import System.Random.MWC (create, createSystemRandom) import Test.QuickCheck hiding (sample, shuffle) import Test.QuickCheck.Instances () @@ -55,7 +56,7 @@ class (Pretty e, Individual i) => Environment i e | e -> i where -- Generates a random population of the given size. population :: e -> N -> RVar (Population i) population env n - | n <= 0 = undefined + | n <= 0 = error "nonPositive in population" | otherwise = NE.fromList <$> replicateM n (new env) mutate :: e -> i -> RVar i @@ -266,7 +267,7 @@ tournament1 :: RVar i tournament1 eval nTrnmnt pop -- TODO Use Positive for this constraint - | nTrnmnt <= 0 = undefined + | nTrnmnt <= 0 = error "nonPositive in tournament1" | otherwise = do paricipants <- withoutReplacement nTrnmnt pop return $ NE.head $ fst $ bests eval 1 paricipants @@ -279,7 +280,7 @@ withoutReplacement :: N -> Population i -> RVar (NonEmpty i) -withoutReplacement 0 _ = undefined +withoutReplacement 0 _ = error "0 in withoutReplacement" withoutReplacement n pop | n >= length pop = return pop | otherwise = fmap (NE.fromList) (shuffleNofM n (length pop) (NE.toList pop)) diff --git a/src/IrisData.hs b/src/IrisData.hs index d4d87ee..f62a237 100644 --- a/src/IrisData.hs +++ b/src/IrisData.hs @@ -17,41 +17,7 @@ instance ToRecord IrisClass irisTrainingData :: [((Float, Float, Float, Float), IrisClass)] irisTrainingData = - [ ((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) - ] - -irisTestData :: [((Float, Float, Float, Float), IrisClass)] -irisTestData = - [((6.7, 3.1, 4.4, 1.4), Versicolor), + [ ((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), @@ -170,4 +136,39 @@ irisTestData = ((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)] + ((6.0, 2.2, 4.0, 1.0), Versicolor) + ] + +irisTestData :: [((Float, Float, Float, Float), IrisClass)] +irisTestData = + [ ((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) + ] diff --git a/src/IrisDataset.hs b/src/IrisDataset.hs index e80a8d0..14634ca 100644 --- a/src/IrisDataset.hs +++ b/src/IrisDataset.hs @@ -24,6 +24,7 @@ import IrisData import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint import Protolude +import Protolude.Error import qualified Type.Reflection as Ref irisLE :: LambdaEnviroment @@ -34,9 +35,9 @@ irisLE = [ ((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 -> 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'"]) + ((Ref.SomeTypeRep (Ref.TypeRep @(Bool -> IrisClass -> IrisClass -> IrisClass))), ["if'","if'","if'","if'","if'","if'","if'","if'","if'","if'"]) ], constants = Map.fromList @@ -50,9 +51,9 @@ irisLE = ExpressionWeights { lambdaSpucker = 1, lambdaSchlucker = 1, - symbol = 1, - variable = 2, - constant = 1 + symbol = 30, + variable = 100, + constant = 5 } } @@ -61,14 +62,15 @@ 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", + training = True, trainingData = ( map fst irisTrainingData, map snd irisTrainingData ), + testData = + ( map fst irisTestData, + map snd irisTestData + ), exTargetType = (Ref.SomeTypeRep (Ref.TypeRep @(Float -> Float -> Float -> Float -> IrisClass))), -- todo: kindaHacky results = Map.empty @@ -77,11 +79,9 @@ irisLEE = 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, + training :: Bool, trainingData :: ([(Float, Float, Float, Float)], [IrisClass]), + testData :: ([(Float, Float, Float, Float)], [IrisClass]), exTargetType :: TypeRep, -- todo: kindaHacky results :: Map TypeRequester FittnesRes @@ -107,9 +107,11 @@ instance Evaluator TypeRequester LamdaExecutionEnv FittnesRes where let toAdd = NE.filter (\k -> not (Map.member k (results env))) pop 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) + let res = foldr insertPair (results env) (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 = mapM (evalResult ex) trs @@ -119,10 +121,10 @@ 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 res = map (\(a, b, c, d) -> result a b c d) (fst (dset ex)) + let resAndTarget = (zip (snd (dset ex)) res) let acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) :: Int - let biasSmall = exp (-(fromIntegral (countTrsR tr))) -- 0 (schlecht) bis 1 (gut) + let biasSmall = exp ((-(fromIntegral (countTrsR tr)))/1000) -- 0 (schlecht) bis 1 (gut) let fitness' = meanOfAccuricyPerClass resAndTarget let score = fitness' + (biasSmall - 1) return diff --git a/src/LambdaCalculus.hs b/src/LambdaCalculus.hs index 2feea34..ef4b64f 100644 --- a/src/LambdaCalculus.hs +++ b/src/LambdaCalculus.hs @@ -9,7 +9,7 @@ module LambdaCalculus where -import Data.List (foldr1, last) +import Data.List (foldr1, last, nub, intersect, (!!), (\\)) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Maybe @@ -20,6 +20,8 @@ import Data.Typeable import GA import Pretty import Protolude +import Protolude.Error +import Debug.Trace as DB import Test.QuickCheck hiding (sample, shuffle) import Test.QuickCheck.Monadic (assert, monadicIO) import qualified Type.Reflection as Ref @@ -92,7 +94,8 @@ toLambdaExpressionS :: TypeRequester -> Text toLambdaExpressionS (TR typeRep (Just lambdaExpression) boundVars) = "((" <> eToLambdaExpressionS lambdaExpression <> ") :: (" <> show typeRep <> "))" toLambdaExpressionS (TR _ (Nothing) _) = "Invalid Lambda Epr" --- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int | Constan ConVal +-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show) + eToLambdaExpressionS :: LambdaExpression -> Text eToLambdaExpressionS (LambdaSpucker typeRequester1 typeRequester2 boundVars) = "(\\l" <> showSanifid (last boundVars) <> show (count boundVars (last boundVars) - 1) <> " -> " <> toLambdaExpressionS typeRequester2 <> ") " <> toLambdaExpressionS typeRequester1 @@ -240,53 +243,119 @@ instance Environment TypeRequester LambdaEnviroment where nX _ = 3 -- todo! crossover1 env@(LambdaEnviroment _ _ _ maxDepth _) tr1 tr2 = do - return Nothing + let trCount = countTrsR tr1 + selectedIndex1 <- uniform 1 trCount + let (depthAt, selectedTr1@(TR _ _ bound1)) = depthLeftAndTypeAtR tr1 selectedIndex1 maxDepth + let indexes = findIndicesWhere tr2 (isCompatibleTr selectedTr1) 0 + if length indexes == 0 then return Nothing else (do + (selectedTr2@(TR _ _ bound2),selectedIndex2) <- randomElement indexes + selectedTr2 <- adaptBoundVars selectedTr2 bound1 + selectedTr1 <- adaptBoundVars selectedTr1 bound2 + let child1 = replaceAtR selectedIndex1 tr1 selectedTr2 + let child2 = replaceAtR selectedIndex2 tr2 selectedTr1 + return $ Just (child1, child2) + ) --- TODO: crossover! --- let trCount = countTrsR tr1 --- selectedIndex1 <- uniform 1 trCount --- let (depthAt, selectedTr1@(TR trep _ bound)) = depthLeftAndTypeAtR tr selectedTR maxDepth --- let indexes = findIndicesWhere tr2 ( == trep) --- if length indexes == 0 then return Nothing else (do --- (selectedTr2,selectedIndex2) <- randomElement indexes) -- helper +adaptBoundVars:: TypeRequester -> BoundVars -> RVar TypeRequester +adaptBoundVars tr@(TR _ _ bvOld) bvNew = do + newIndexMap <- generateConversionIndexMap bvOld bvNew + return $ convertTr tr bvOld bvNew newIndexMap --- findIndicesWhere:: TypeRequester -> (TypeRep -> Bool) -> Int -> [(TypeRequester, Int)] --- findIndicesWhere tr@(TR t lE _) filte indx = case lE of --- Just le -> (tr, indx+1):(findIndicesWhere' (asList le) filte (indx+1)) --- Nothing -> undefined +convertTr:: TypeRequester -> BoundVars -> BoundVars -> Map TypeRep (Int -> Int) -> TypeRequester +convertTr tr@(TR tRp (Just le) bvCurr) bvOld bvNew mapper = TR tRp (Just (convertLe le bvOld bvNew mapper)) (bvNew ++ (bvCurr \\ bvOld)) +convertTr _ _ _ _ = error "le Not Just (convertTr)" --- findIndicesWhere':: [TypeRequester] -> (TypeRep -> Bool) -> Int -> [(TypeRequester, Int)] --- findIndicesWhere' (tr:trs) f indx = (findIndicesWhere tr f indx) ++ (findIndicesWhere' trs f (indx + countTrsR tr)) + +-- data LambdaExpression = LambdaSpucker TypeRequester TypeRequester BoundVars | LambdaSchlucker TypeRequester BoundVars | Symbol ConVal [TypeRequester] BoundVars | Var TypeRep Int [TypeRequester] BoundVars | Constan ConVal deriving (Eq, Ord, Show) +convertLe:: LambdaExpression -> BoundVars -> BoundVars -> Map TypeRep (Int -> Int) -> LambdaExpression +convertLe (LambdaSpucker tr1 tr2 bvCurr) bvOld bvNew mapper = LambdaSpucker (convertTrf tr1) (convertTrf tr2) (bvNew ++ (bvCurr \\ bvOld)) + where convertTrf tr = convertTr tr bvOld bvNew mapper +convertLe (LambdaSchlucker tr bvCurr) bvOld bvNew mapper = LambdaSchlucker (convertTrf tr) (bvNew ++ (bvCurr \\ bvOld)) + where convertTrf tr = convertTr tr bvOld bvNew mapper +convertLe (Symbol cv trs bvCurr) bvOld bvNew mapper = Symbol cv (map convertTrf trs) (bvNew ++ (bvCurr \\ bvOld)) + where convertTrf tr = convertTr tr bvOld bvNew mapper +convertLe (Var varType varNumber trs bvCurr) bvOld bvNew mapper = Var varType ((fromMaybe identity (Map.lookup varType mapper)) varNumber) (map convertTrf trs) (bvNew ++ (bvCurr \\ bvOld)) + where convertTrf tr = convertTr tr bvOld bvNew mapper +convertLe le@(Constan _) _ _ _ = le + + +generateConversionIndexMap:: BoundVars -> BoundVars -> RVar (Map TypeRep (Int -> Int)) +generateConversionIndexMap bvOld bvNew = do + funcs <- mapM (\bT -> genMapper (count bvOld bT - 1) (count bvNew bT - 1)) (nub bvOld) + return $ Map.fromList $ zip (nub bvOld) funcs + +genMapper:: Int -> Int -> RVar (Int -> Int) +genMapper i j | i == j = return identity + | i < j = return $ \int -> if int <= i then int else int + (j-i) + | i > j = do + permutationForUnbound <- genPermutation i j + return $ genMapperRandomAssment i j permutationForUnbound + | otherwise = error "impossible case in genMapper" + +genMapperRandomAssment:: Int -> Int -> [Int] -> Int -> Int +genMapperRandomAssment i j permutationForUnbound int | int <= j = int + | int > i = int - (i-j) + | otherwise = permutationForUnbound !! (int - j - 1) + +genPermutation:: Int -> Int -> RVar [Int] +genPermutation i j = replicateM (i - j) (uniform 0 j) + +isCompatibleTr:: TypeRequester -> TypeRequester -> Bool +isCompatibleTr tr1@(TR trep1 _ bound1) tr2@(TR trep2 _ bound2) | trep1 == trep2 = allUsedBound (usedVars bound1 tr1) bound2 && allUsedBound (usedVars bound2 tr2) bound1 + | otherwise = False +allUsedBound :: BoundVars -> BoundVars -> Bool +allUsedBound used available = all (\x -> any (== x) available) used + + +usedVars :: BoundVars -> TypeRequester -> BoundVars +usedVars boundOld tr@(TR trep1 (Just (Var trp ind trs _)) _) = if any (== trp) boundOld && count boundOld trp > ind then trp : concatMap (usedVars boundOld) trs else concatMap (usedVars boundOld) trs +usedVars boundOld tr@(TR trep1 (Just le) _) = concatMap (usedVars boundOld) (asList le) +usedVars _ _ = error "Nothing in usedVars" + + +boundsConvertable:: BoundVars -> BoundVars -> Bool +boundsConvertable bv1 bv2 = length (nub bv2) == length (nub bv1) && length (intersect (nub bv1) bv2) == length (nub bv1) + + +findIndicesWhere:: TypeRequester -> (TypeRequester -> Bool) -> Int -> [(TypeRequester, Int)] +findIndicesWhere tr@(TR t lE _) filte indx = case lE of + Just le -> if filte tr then (tr, indx+1):(findIndicesWhere' (asList le) filte (indx+1)) else (findIndicesWhere' (asList le) filte (indx+1)) + Nothing -> error "Nothing in findIndicesWhere" + +findIndicesWhere':: [TypeRequester] -> (TypeRequester -> Bool) -> Int -> [(TypeRequester, Int)] +findIndicesWhere' [] _ _ = [] +findIndicesWhere' [tr] f indx = (findIndicesWhere tr f indx) +findIndicesWhere' (tr:trs) f indx = (findIndicesWhere tr f indx) ++ (findIndicesWhere' trs f (indx + countTrsR tr)) replaceAtR :: Int -> TypeRequester -> TypeRequester -> TypeRequester 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 +replaceAtR _ (TR _ Nothing _) _ = error "Nothing in replaceAtR" replaceAt :: Int -> LambdaExpression -> TypeRequester -> LambdaExpression replaceAt i le@(LambdaSpucker _ _ bv) with = LambdaSpucker (fromJust (head trs)) (last trs) bv where trs = replaceInSubtreeWithIndex i (asList le) with replaceAt i (LambdaSchlucker tr bv) with = LambdaSchlucker (replaceAtR i tr with) bv replaceAt i le@(Symbol cv _ bv) with = Symbol cv trs bv where trs = replaceInSubtreeWithIndex i (asList le) with replaceAt i le@(Var tr ix _ bv) with = Var tr ix trs bv where trs = replaceInSubtreeWithIndex i (asList le) with -replaceAt _ (Constan _) _ = undefined +replaceAt _ (Constan _) _ = error "Nothing in replaceAt" replaceInSubtreeWithIndex :: Int -> [TypeRequester] -> TypeRequester -> [TypeRequester] replaceInSubtreeWithIndex indexLeft (tr : trs) with = if countTrsR tr >= indexLeft then (replaceAtR indexLeft tr with) : trs else tr : (replaceInSubtreeWithIndex (indexLeft - countTrsR tr) trs with) -replaceInSubtreeWithIndex _ [] _ = undefined +replaceInSubtreeWithIndex _ [] _ = error "Index not found in replaceInSubtreeWithIndex" depthLeftAndTypeAtR :: TypeRequester -> Int -> Int -> (Int, TypeRequester) 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 +depthLeftAndTypeAtR (TR _ Nothing _) indexLeft depthLeft = error "Nothing in depthLeftAndTypeAtR" depthLeftAndTypeAt :: LambdaExpression -> Int -> Int -> (Int, TypeRequester) depthLeftAndTypeAt le indexLeft depthLeft = depthLeftAndTypeInSubtreeWithIndex (asList le) indexLeft depthLeft depthLeftAndTypeInSubtreeWithIndex :: [TypeRequester] -> Int -> Int -> (Int, TypeRequester) depthLeftAndTypeInSubtreeWithIndex (tr : trs) indexLeft depthLeft = if countTrsR tr >= indexLeft then depthLeftAndTypeAtR tr indexLeft depthLeft else depthLeftAndTypeInSubtreeWithIndex trs (indexLeft - countTrsR tr) depthLeft -depthLeftAndTypeInSubtreeWithIndex [] indexLeft depthLeft = undefined +depthLeftAndTypeInSubtreeWithIndex [] indexLeft depthLeft = error "Index not found in depthLeftAndTypeInSubtreeWithIndex" countTrsR :: TypeRequester -> Int countTrsR tr@(TR t lE _) = case lE of diff --git a/src/Main.hs b/src/Main.hs index 8b6c09b..bd012a6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,6 +10,8 @@ import System.IO -- import Szenario212Pun -- import Szenario191 import IrisDataset +import Debug.Trace as DB +import qualified Data.Map.Strict as Map data Options = Options { iterations :: !N, @@ -24,7 +26,7 @@ options = ( long "iterations" <> short 'i' <> metavar "N" - <> value 1000 + <> value 500 <> help "Number of iterations" ) <*> option @@ -32,7 +34,7 @@ options = ( long "population-size" <> short 'p' <> metavar "N" - <> value 50 + <> value 100 <> help "Population size" ) @@ -52,12 +54,12 @@ main = let env = irisLE let selType = Tournament 3 let run' = run irisLEE env selType 40 (5 / 100) (populationSize opts) (steps (iterations opts)) - pop' <- - runEffect (for run' logCsv) - - irisLE <- calc irisLEE pop' - let (res, _) = bests irisLE 5 pop' - mapM_ (format irisLE) res + pop' <- runEffect (for run' logCsv) + irisLEE' <- calc irisLEE pop' + let (res, _) = bests irisLEE' 5 pop' + let irisLEE' = irisLEE {training = False} + irisLEE' <- calc irisLEE' res + mapM_ (format irisLEE') res where format irisL s = do let f = fitness' irisL s