diff --git a/haga.cabal b/haga.cabal index 74b1ed2..adcdb34 100644 --- a/haga.cabal +++ b/haga.cabal @@ -1,4 +1,4 @@ -cabal-version: 2.2 +cabal-version: 3.4 name: haga version: 0.1.0.0 synopsis: Simplistic genetic algorithms library @@ -43,23 +43,25 @@ library , text , wl-pprint-text default-language: Haskell2010 - ghc-options: -Wall -Wno-name-shadowing -Wno-orphans -threaded -rtsopts -O2 - hs-source-dirs: src + ghc-options: -Wall -Wno-name-shadowing -Wno-orphans -O2 + hs-source-dirs: lib, lambda/lib + other-modules: CommonDefinition exposed-modules: GA - , Seminar - , Pretty - , Szenario191 , LambdaCalculus - , NurseryDataset - , NurseryData + , Pretty , Utils -executable haga + , LambdaDatasets.NurseryDefinition + , LambdaDatasets.GermanDefinition + , LambdaDatasets.IrisDefinition + +executable haga-lambda build-depends: base , bytestring , cassava , containers , extra , hint + , haga , monad-loops , MonadRandom , mwc-random @@ -78,16 +80,32 @@ executable haga , wl-pprint-text default-language: Haskell2010 ghc-options: -Wall -Wno-name-shadowing -Wno-orphans -threaded -rtsopts -O2 - hs-source-dirs: src + hs-source-dirs: lambda/src main-is: Main.hs - other-modules: GA - , Seminar - , Pretty + other-modules: LambdaDatasets.NurseryDataset + , LambdaDatasets.NurseryData + , LambdaDatasets.GermanDataset + , LambdaDatasets.GermanData + , LambdaDatasets.IrisDataset + , LambdaDatasets.IrisData + +executable haga-students + build-depends: base + , extra + , haga + , optparse-applicative + , protolude + , pipes + , QuickCheck + , quickcheck-instances + , random-fu + , text + default-language: Haskell2010 + ghc-options: -Wall -Wno-name-shadowing -Wno-orphans -threaded -rtsopts -O2 + hs-source-dirs: src-students + main-is: Main.hs + other-modules: Seminar , Szenario191 - , LambdaCalculus - , NurseryDataset - , NurseryData - , Utils executable haga-test build-depends: base @@ -96,6 +114,7 @@ executable haga-test , cassava , containers , extra + , haga , hint , monad-loops , MonadRandom @@ -115,13 +134,5 @@ executable haga-test , wl-pprint-text default-language: Haskell2010 ghc-options: -Wall -Wno-name-shadowing -Wno-orphans -threaded -rtsopts -O2 - hs-source-dirs: src + hs-source-dirs: lib main-is: Test.hs - other-modules: GA - , Seminar - , Pretty - , Szenario191 - , LambdaCalculus - , NurseryDataset - , NurseryData - , Utils diff --git a/lambda/README.md b/lambda/README.md new file mode 100644 index 0000000..2668dbe --- /dev/null +++ b/lambda/README.md @@ -0,0 +1,17 @@ +# Why this split: + + +The Module(s) used when evaluating individuals has to be in an external library to make Hint work. so we split the lamda-calculus command program in a library we need to expose in the main library and the implementation. + +Sadly, ghc / ghci / cabal can not properly make a public, internal library available to ghci (and, with that, Hint). Should this ever change: +``` +library haga-lambda-lib + visibility: public + build-depends: base + , protolude + default-language: Haskell2010 + ghc-options: -Wall -Wno-orphans -O2 + hs-source-dirs: lambda/lib + other-modules: CommonDefinition + exposed-modules: LambdaDatasets.NurseryDefinition +``` diff --git a/lambda/lib/CommonDefinition.hs b/lambda/lib/CommonDefinition.hs new file mode 100644 index 0000000..67e120e --- /dev/null +++ b/lambda/lib/CommonDefinition.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module CommonDefinition where + +import Protolude + +if' :: Bool -> a -> a -> a +if' True e _ = e +if' False _ e = e diff --git a/lambda/lib/LambdaDatasets/GermanDefinition.hs b/lambda/lib/LambdaDatasets/GermanDefinition.hs new file mode 100644 index 0000000..45e7a75 --- /dev/null +++ b/lambda/lib/LambdaDatasets/GermanDefinition.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module LambdaDatasets.GermanDefinition + ( module LambdaDatasets.GermanDefinition, + module CommonDefinition, + ) where + + +import Protolude +import CommonDefinition + +data GermanClass = Accept | Deny deriving (Eq, Generic, Show, Enum, Bounded) + +data AccountStatus = AccountInDebt | NoAccount | LowAccountBalance | HighAccountBalanceOrRegular deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data CreditHistory = HistoryGood | HistoryGoodHere | HistoryGoodSoFar | DelaysInHistory | CreditsExist deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Purpose = OldCar | NewCar | FunitureOrEquipment | Tech | Appliances | Repairs | Education | Retraining | Business | Other deriving (Eq, Generic, Show, Enum, Bounded) + +data Savings = UnknownOrNone | SmallSavings | NormalSavings | GoodSavings | GreatSavings deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data EmploymentStatus = NotEmployed | ShortTermEmployed | MediumTermEmployed | LongTermEmployed | VeteranEmployed deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data StatusAndSex = MaleAndSeperated | FemaleAndSeperatedOrMarried | MaleAndSingle | FemaleAndSingle | MaleAndWidowedOrMarried deriving (Eq, Generic, Show, Enum, Bounded) + +data OtherDebtors = NoOtherDebtors | CoApplicant | Guarantor deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Property = UnknownOrNoProperty | RealEstate | Savings | CarOrOther deriving (Eq, Generic, Show, Enum, Bounded) + +data OtherPlans = PlansAtBank | PlansAtStores | NoOtherPlans deriving (Eq, Generic, Show, Enum, Bounded) + +data Housing = Renting | OwningRecidency | ResidingForFree deriving (Eq, Generic, Show, Enum, Bounded) + +data Job = UnemployedOrUnskilledNonResident | UnskilledResident | Skilled | HighlySkilled deriving (Eq, Generic, Show, Enum, Bounded, Ord) diff --git a/lambda/lib/LambdaDatasets/IrisDefinition.hs b/lambda/lib/LambdaDatasets/IrisDefinition.hs new file mode 100644 index 0000000..965ef47 --- /dev/null +++ b/lambda/lib/LambdaDatasets/IrisDefinition.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module LambdaDatasets.IrisDefinition + ( module LambdaDatasets.IrisDefinition, + module CommonDefinition, + ) where + +import Protolude +import CommonDefinition + +data IrisClass = Setosa | Virginica | Versicolor deriving (Eq, Generic, Show, Enum, Bounded) + diff --git a/lambda/lib/LambdaDatasets/NurseryDefinition.hs b/lambda/lib/LambdaDatasets/NurseryDefinition.hs new file mode 100644 index 0000000..2e6fd2e --- /dev/null +++ b/lambda/lib/LambdaDatasets/NurseryDefinition.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module LambdaDatasets.NurseryDefinition + ( module LambdaDatasets.NurseryDefinition, + module CommonDefinition, + ) where + +import Protolude +import CommonDefinition + +data NurseryClass = NotRecommend | Recommend | VeryRecommend | Priority | SpecPriority deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Parents = Usual | Pretentious | GreatPret deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data HasNurs = ProperNurs | LessProperNurs | ImproperNurs | CriticalNurs | VeryCritNurs deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Form = CompleteFamilyForm | CompletedFamilyForm | IncompleteFamilyForm | FosterFamilyForm deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Children = OneChild | TwoChilds | ThreeChilds | MoreChilds deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Housing = ConvenientHousing | LessConvHousing | CriticalHousing deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Finance = ConvenientFinance | InconvFinance deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Social = NotProblematicSocial | SlightlyProblematicSocial | ProblematicSocial deriving (Eq, Generic, Show, Enum, Bounded, Ord) + +data Health = NotRecommendHealth |RecommendedHealth | PriorityHealth deriving (Eq, Generic, Show, Enum, Bounded, Ord) + diff --git a/src/GermanData.hs b/lambda/src/LambdaDatasets/GermanData.hs similarity index 99% rename from src/GermanData.hs rename to lambda/src/LambdaDatasets/GermanData.hs index 7571498..760bc2d 100644 --- a/src/GermanData.hs +++ b/lambda/src/LambdaDatasets/GermanData.hs @@ -1,36 +1,13 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module GermanData where +module LambdaDatasets.GermanData + ( module LambdaDatasets.GermanDefinition, + module LambdaDatasets.GermanData, + ) +where import Protolude - -data GermanClass = Accept | Deny deriving (Eq, Generic, Show, Enum, Bounded) - -data AccountStatus = AccountInDebt | NoAccount | LowAccountBalance | HighAccountBalanceOrRegular deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data CreditHistory = HistoryGood | HistoryGoodHere | HistoryGoodSoFar | DelaysInHistory | CreditsExist deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Purpose = OldCar | NewCar | FunitureOrEquipment | Tech | Appliances | Repairs | Education | Retraining | Business | Other deriving (Eq, Generic, Show, Enum, Bounded) - -data Savings = UnknownOrNone | SmallSavings | NormalSavings | GoodSavings | GreatSavings deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data EmploymentStatus = NotEmployed | ShortTermEmployed | MediumTermEmployed | LongTermEmployed | VeteranEmployed deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data StatusAndSex = MaleAndSeperated | FemaleAndSeperatedOrMarried | MaleAndSingle | FemaleAndSingle | MaleAndWidowedOrMarried deriving (Eq, Generic, Show, Enum, Bounded) - -data OtherDebtors = NoOtherDebtors | CoApplicant | Guarantor deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Property = UnknownOrNoProperty | RealEstate | Savings | CarOrOther deriving (Eq, Generic, Show, Enum, Bounded) - -data OtherPlans = PlansAtBank | PlansAtStores | NoOtherPlans deriving (Eq, Generic, Show, Enum, Bounded) - -data Housing = Renting | OwningRecidency | ResidingForFree deriving (Eq, Generic, Show, Enum, Bounded) - -data Job = UnemployedOrUnskilledNonResident | UnskilledResident | Skilled | HighlySkilled deriving (Eq, Generic, Show, Enum, Bounded, Ord) +import LambdaDatasets.GermanDefinition germanTrainingData :: [((AccountStatus, Int, CreditHistory, Purpose, Int, Savings, EmploymentStatus, Int, StatusAndSex, OtherDebtors, Int, Property, Int, OtherPlans, Housing, Int, Job, Int, Bool, Bool), GermanClass)] germanTrainingData = diff --git a/src/GermanDataset.hs b/lambda/src/LambdaDatasets/GermanDataset.hs similarity index 84% rename from src/GermanDataset.hs rename to lambda/src/LambdaDatasets/GermanDataset.hs index e13e087..23d174f 100644 --- a/src/GermanDataset.hs +++ b/lambda/src/LambdaDatasets/GermanDataset.hs @@ -4,10 +4,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module GermanDataset +module LambdaDatasets.GermanDataset ( module LambdaCalculus, - module GermanDataset, - module GermanData, + module LambdaDatasets.GermanDataset, + module LambdaDatasets.GermanData, module GA, ) where @@ -19,7 +19,7 @@ import Data.Random.Distribution.Uniform import qualified Data.Text as T import Data.Tuple.Extra import GA -import GermanData +import LambdaDatasets.GermanData import LambdaCalculus import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint @@ -29,8 +29,8 @@ import System.Random.MWC (createSystemRandom) import qualified Type.Reflection as Ref import Utils -germanLE :: LambdaEnviroment -germanLE = +lE :: LambdaEnviroment +lE = LambdaEnviroment { functions = Map.fromList @@ -90,18 +90,18 @@ germanLE = weights = ExpressionWeights { lambdaSpucker = 1, - lambdaSchlucker = 1, + lambdaSchlucker = 2, symbol = 30, variable = 10, constant = 5 } } -germanLEE :: LamdaExecutionEnv -germanLEE = +lEE :: LamdaExecutionEnv +lEE = LamdaExecutionEnv { -- For now these need to define all available functions and types. Generic functions can be used. - imports = ["GermanDataset"], + imports = ["LambdaDatasets.GermanDefinition"], training = True, trainingData = ( map fst (takeFraktion 0.8 germanTrainingData), @@ -115,15 +115,15 @@ germanLEE = results = Map.empty } -shuffledGermanLEE :: IO LamdaExecutionEnv -shuffledGermanLEE = do +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 = ["GermanDataset"], + imports = ["LambdaDatasets.GermanDefinition"], training = True, trainingData = ( map fst (takeFraktion 0.8 itD), @@ -177,21 +177,17 @@ dset :: LamdaExecutionEnv -> ([(AccountStatus, Int, CreditHistory, Purpose, Int, 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 - -evalResult :: LamdaExecutionEnv -> TypeRequester -> Hint.InterpreterT IO (TypeRequester, FittnesRes) -evalResult ex tr = do +evalResults ex trs = do Hint.setImports $ (map T.unpack (imports ex)) ++ ["Protolude"] Hint.unsafeSetGhcOption "-O2" - result <- Hint.interpret (T.unpack (toLambdaExpressionS tr)) (Hint.as :: AccountStatus -> Int -> CreditHistory -> Purpose -> Int -> Savings -> EmploymentStatus -> Int -> StatusAndSex -> OtherDebtors -> Int -> Property -> Int -> OtherPlans -> Housing -> Int -> Job -> Int -> Bool -> Bool -> GermanClass) - let 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)) - let resAndTarget = (zip (snd (dset ex)) res) - let acc = (foldr (\ts s -> if ((fst ts) == (snd ts)) then s + 1 else s) 0 resAndTarget) / fromIntegral (length resAndTarget) - let biasSmall = exp ((-(fromIntegral (countTrsR tr))) / 1000) -- 0 (schlecht) bis 1 (gut) - let fitness' = meanOfAccuricyPerClass resAndTarget - let score = fitness' + (biasSmall - 1) - return - ( tr, + 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', @@ -202,7 +198,11 @@ evalResult ex tr = do 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) -if' :: Bool -> a -> a -> a -if' True e _ = e -if' False _ e = e diff --git a/src/IrisData.hs b/lambda/src/LambdaDatasets/IrisData.hs similarity index 96% rename from src/IrisData.hs rename to lambda/src/LambdaDatasets/IrisData.hs index 8ad64e8..5a0f00f 100644 --- a/src/IrisData.hs +++ b/lambda/src/LambdaDatasets/IrisData.hs @@ -4,17 +4,15 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module IrisData where +module LambdaDatasets.IrisData + ( module LambdaDatasets.IrisDefinition, + module LambdaDatasets.IrisData, + ) +where -import Data.Csv +import LambdaDatasets.IrisDefinition import Protolude -data IrisClass = Setosa | Virginica | Versicolor deriving (Eq, Generic, Show, Enum, Bounded) - -instance FromRecord IrisClass - -instance ToRecord IrisClass - irisTrainingData :: [((Float, Float, Float, Float), IrisClass)] irisTrainingData = [ ((6.7, 3.1, 4.4, 1.4), Versicolor), @@ -168,4 +166,3 @@ irisTrainingData = ((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/lambda/src/LambdaDatasets/IrisDataset.hs similarity index 80% rename from src/IrisDataset.hs rename to lambda/src/LambdaDatasets/IrisDataset.hs index ba97d4d..160c416 100644 --- a/src/IrisDataset.hs +++ b/lambda/src/LambdaDatasets/IrisDataset.hs @@ -4,10 +4,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module IrisDataset +module LambdaDatasets.IrisDataset ( module LambdaCalculus, - module IrisDataset, - module IrisData, + module LambdaDatasets.IrisDataset, + module LambdaDatasets.IrisData, module GA, ) where @@ -21,7 +21,7 @@ import qualified Data.Text as T import Data.Tuple.Extra import GA import LambdaCalculus -import IrisData +import LambdaDatasets.IrisData import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint import Protolude @@ -29,8 +29,8 @@ import Utils import Protolude.Error import qualified Type.Reflection as Ref -irisLE :: LambdaEnviroment -irisLE = +lE :: LambdaEnviroment +lE = LambdaEnviroment { functions = Map.fromList @@ -59,11 +59,11 @@ irisLE = } } -irisLEE :: LamdaExecutionEnv -irisLEE = +lEE :: LamdaExecutionEnv +lEE = LamdaExecutionEnv { -- For now these need to define all available functions and types. Generic functions can be used. - imports = ["IrisDataset"], + imports = ["LambdaDatasets.IrisDataset"], training = True, trainingData = ( map fst (takeFraktion 0.8 irisTrainingData), @@ -77,14 +77,14 @@ irisLEE = results = Map.empty } -shuffledIrisLEE :: IO LamdaExecutionEnv -shuffledIrisLEE = do +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 = ["IrisDataset"], + imports = ["LambdaDatasets.IrisDataset"], training = True, trainingData = ( map fst (takeFraktion 0.8 itD), @@ -138,21 +138,17 @@ 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 - -evalResult :: LamdaExecutionEnv -> TypeRequester -> Hint.InterpreterT IO (TypeRequester, FittnesRes) -evalResult ex tr = do +evalResults ex trs = 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 (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) / fromIntegral (length resAndTarget) - let biasSmall = exp ((-(fromIntegral (countTrsR tr)))/1000) -- 0 (schlecht) bis 1 (gut) - let fitness' = meanOfAccuricyPerClass resAndTarget - let score = fitness' + (biasSmall - 1) - return - ( tr, + 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', @@ -163,8 +159,10 @@ evalResult ex tr = do totalSize = countTrsR tr } ) - -if' :: Bool -> a -> a -> a -if' True e _ = e -if' False _ e = e - + 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) diff --git a/src/NurseryData.hs b/lambda/src/LambdaDatasets/NurseryData.hs similarity index 99% rename from src/NurseryData.hs rename to lambda/src/LambdaDatasets/NurseryData.hs index 4532aa6..9569a06 100644 --- a/src/NurseryData.hs +++ b/lambda/src/LambdaDatasets/NurseryData.hs @@ -4,27 +4,14 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module NurseryData where +module LambdaDatasets.NurseryData + ( module LambdaDatasets.NurseryDefinition, + module LambdaDatasets.NurseryData, + ) +where import Protolude - -data NurseryClass = NotRecommend | Recommend | VeryRecommend | Priority | SpecPriority deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Parents = Usual | Pretentious | GreatPret deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data HasNurs = ProperNurs | LessProperNurs | ImproperNurs | CriticalNurs | VeryCritNurs deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Form = CompleteFamilyForm | CompletedFamilyForm | IncompleteFamilyForm | FosterFamilyForm deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Children = OneChild | TwoChilds | ThreeChilds | MoreChilds deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Housing = ConvenientHousing | LessConvHousing | CriticalHousing deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Finance = ConvenientFinance | InconvFinance deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Social = NotProblematicSocial | SlightlyProblematicSocial | ProblematicSocial deriving (Eq, Generic, Show, Enum, Bounded, Ord) - -data Health = NotRecommendHealth |RecommendedHealth | PriorityHealth deriving (Eq, Generic, Show, Enum, Bounded, Ord) +import LambdaDatasets.NurseryDefinition nurseryTrainingData :: [((Parents, HasNurs, Form, Children, Housing, Finance, Social, Health), NurseryClass)] nurseryTrainingData = diff --git a/src/NurseryDataset.hs b/lambda/src/LambdaDatasets/NurseryDataset.hs similarity index 89% rename from src/NurseryDataset.hs rename to lambda/src/LambdaDatasets/NurseryDataset.hs index f9ea26f..4ddbe77 100644 --- a/src/NurseryDataset.hs +++ b/lambda/src/LambdaDatasets/NurseryDataset.hs @@ -4,10 +4,10 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE NoImplicitPrelude #-} -module NurseryDataset +module LambdaDatasets.NurseryDataset ( module LambdaCalculus, - module NurseryDataset, - module NurseryData, + module LambdaDatasets.NurseryDataset, + module LambdaDatasets.NurseryData, module GA, ) where @@ -19,7 +19,7 @@ import Data.Random.Distribution.Uniform import qualified Data.Text as T import Data.Tuple.Extra import GA -import NurseryData +import LambdaDatasets.NurseryData import LambdaCalculus import qualified Language.Haskell.Interpreter as Hint import qualified Language.Haskell.Interpreter.Unsafe as Hint @@ -29,8 +29,8 @@ import System.Random.MWC (createSystemRandom) import qualified Type.Reflection as Ref import Utils -nurseryLE :: LambdaEnviroment -nurseryLE = +lE :: LambdaEnviroment +lE = LambdaEnviroment { functions = Map.fromList @@ -74,52 +74,55 @@ 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 = 7, + maxDepth = 8, weights = ExpressionWeights - { lambdaSpucker = 2, - lambdaSchlucker = 1, + { lambdaSpucker = 1, + lambdaSchlucker = 2, symbol = 30, variable = 20, constant = 5 } } -nurseryLEE :: LamdaExecutionEnv -nurseryLEE = +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 = ["NurseryDataset"], + imports = ["LambdaDatasets.NurseryDefinition"], training = True, trainingData = - ( map fst (takeFraktion (2/3) nurseryTrainingData), - map snd (takeFraktion (2/3) nurseryTrainingData) + ( map fst (takeFraktion trainingFraction nurseryTrainingData), + map snd (takeFraktion trainingFraction nurseryTrainingData) ), testData = - ( map fst (dropFraktion (2/3) nurseryTrainingData), - map snd (dropFraktion (2/3) nurseryTrainingData) + ( 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 } -shuffledNurseryLEE :: IO LamdaExecutionEnv -shuffledNurseryLEE = do +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 = ["NurseryDataset"], + imports = ["LambdaDatasets.NurseryDefinition"], training = True, trainingData = - ( map fst (takeFraktion (2/3) itD), - map snd (takeFraktion (2/3) itD) + ( map fst (takeFraktion trainingFraction itD), + map snd (takeFraktion trainingFraction itD) ), testData = - ( map fst (dropFraktion (2/3) itD), - map snd (dropFraktion (2/3) itD) + ( 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 @@ -194,7 +197,3 @@ evalResult ex tr result = ( tr, fitness' = meanOfAccuricyPerClass resAndTarget score = fitness' + (biasSmall - 1) - -if' :: Bool -> a -> a -> a -if' True e _ = e -if' False _ e = e diff --git a/src/Main.hs b/lambda/src/Main.hs similarity index 69% rename from src/Main.hs rename to lambda/src/Main.hs index 38e1cef..c78346e 100644 --- a/src/Main.hs +++ b/lambda/src/Main.hs @@ -7,9 +7,9 @@ import Pipes import Pretty import Protolude hiding (for) import System.IO --- import Szenario212Pun --- import Szenario191 -import NurseryDataset +-- import LambdaDatasets.IrisDataset +-- import LambdaDatasets.NurseryDataset +import LambdaDatasets.GermanDataset import Debug.Trace as DB import qualified Data.Map.Strict as Map @@ -26,7 +26,7 @@ options = ( long "iterations" <> short 'i' <> metavar "N" - <> value 5000 + <> value 1500 <> help "Number of iterations" ) <*> option @@ -51,19 +51,19 @@ main :: IO () main = execParser optionsWithHelp >>= \opts -> do hSetBuffering stdout NoBuffering - nurseryLEE <- shuffledNurseryLEE - let env = nurseryLE + lEE <- shuffledLEE + let env = lE let selType = Tournament 3 - let run' = run nurseryLEE env selType 120 (5 / 100) (populationSize opts) (steps (iterations opts)) + let run' = run lEE env selType 120 (5 / 100) (populationSize opts) (steps (iterations opts)) pop' <- runEffect (for run' logCsv) - nurseryLEE' <- calc nurseryLEE pop' - let (res, _) = bests nurseryLEE' 5 pop' - let nurseryLEE' = nurseryLEE {training = False} - nurseryLEE' <- calc nurseryLEE' res - mapM_ (format nurseryLEE') res + lEE' <- calc lEE pop' + let (res, _) = bests lEE' 5 pop' + let lEE' = lEE {training = False} + lEE' <- calc lEE' res + mapM_ (format lEE') res where - format nurseryL s = do - let f = fitness' nurseryL s + format l s = do + let f = fitness' l s putErrText $ show f <> "\n" <> pretty s logCsv = putText . csv csv (t, f) = show t <> " " <> show f diff --git a/src/GA.hs b/lib/GA.hs similarity index 96% rename from src/GA.hs rename to lib/GA.hs index 6780fb9..9c422c3 100644 --- a/src/GA.hs +++ b/lib/GA.hs @@ -93,9 +93,15 @@ class (Individual i, Fitness r) => Evaluator i e r | i -> e r where fitness :: e -> i -> R fitness env i = getR ( fitness' env i) + -- | + -- An more complete fitness object, used to include more info to the output of the current fitness. + -- You can e.g. track individual size with this. fitness' :: e -> i -> r - -- TODO kinda hacky?!? + -- | + -- here, fitness values for the next generation can be calculated at once, and just once, using any monadic action, if necessary. + -- It is guaranteed that the e passed to fitness is the result of a calc function, where the individual was part of the Population passed. + -- It may be smart to reuse known results between invocations. calc :: e -> Population i -> IO e calc eval _ = do return eval diff --git a/src/LambdaCalculus.hs b/lib/LambdaCalculus.hs similarity index 100% rename from src/LambdaCalculus.hs rename to lib/LambdaCalculus.hs diff --git a/src/Pretty.hs b/lib/Pretty.hs similarity index 100% rename from src/Pretty.hs rename to lib/Pretty.hs diff --git a/lib/Test.hs b/lib/Test.hs new file mode 100644 index 0000000..cf20809 --- /dev/null +++ b/lib/Test.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Main where + +import qualified GA +import Protolude + +main :: IO () +main = do + _ <- GA.runTests + return () + +if' :: Bool -> a -> a -> a +if' True x _ = x +if' False _ y = y diff --git a/src/Utils.hs b/lib/Utils.hs similarity index 76% rename from src/Utils.hs rename to lib/Utils.hs index 3f6bb50..1c36e95 100644 --- a/src/Utils.hs +++ b/lib/Utils.hs @@ -23,14 +23,18 @@ geomeanOfDistributionAccuracy results = geomean $ map (distributionAccuracyForCl distributionAccuracyForClass :: (Eq r) => [(r, r)] -> r -> R distributionAccuracyForClass results clas = (1 - (min 1 (fromIntegral (abs ((length (inResClass results clas)) - (length (inClass results clas)))) / fromIntegral (length (inClass results clas))))) * 100 -mean :: (Show f, Floating f) => [f] -> f -mean values = (sum values) * (1 / (fromIntegral (length values))) +mean :: (Show f, RealFloat f) => [f] -> f +mean values = (sum filteredValues) * (1 / (fromIntegral (length filteredValues))) + where + filteredValues = filter (not . isNaN) values -geomean :: (Show f, Floating f) => [f] -> f -geomean values = (product values) ** (1 / (fromIntegral (length values))) +geomean :: (Show f, RealFloat f) => [f] -> f +geomean values = (product filteredValues) ** (1 / (fromIntegral (length filteredValues))) + where + filteredValues = filter (not . isNaN) values accuracyInClass :: (Eq r) => [(r, r)] -> r -> R -accuracyInClass results clas = if fromIntegral (length (inClass results clas)) == 0 then 100 else ((accuracy' (inResClass results clas)) * 100) / fromIntegral (length (inClass results clas)) +accuracyInClass results clas = ((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) @@ -46,11 +50,11 @@ repeatedly f x = case f x of Nothing -> [] Just y -> y : repeatedly f y -contains :: (Eq a, Foldable t ) => t a -> a -> Bool +contains :: (Eq a, Foldable t) => t a -> a -> Bool contains list val = any (== val) list count :: (Eq a) => [a] -> a -> Int -count [] find = 0 +count [] _ = 0 count ys find = length xs where xs = [xs | xs <- ys, xs == find] diff --git a/run.sbatch b/run.sbatch index 1833c89..50fe9db 100755 --- a/run.sbatch +++ b/run.sbatch @@ -6,4 +6,4 @@ #SBATCH --error=./output/error_run_%j.txt #SBATCH --nodelist=oc-compute02 #SBATCH --mem=3G -srun nix develop --command stack --no-nix --system-ghc --no-install-ghc run haga +srun nix develop --command stack --no-nix --system-ghc --no-install-ghc run haga-lambda diff --git a/src-students/Main.hs b/src-students/Main.hs new file mode 100644 index 0000000..387ab5f --- /dev/null +++ b/src-students/Main.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} + +import Options.Applicative +import Pipes +import Pretty +import Protolude hiding (for) +import System.IO +import Seminar +import Szenario191 + +data Options = Options + { iterations :: !N, + populationSize :: !N + } + +options :: Parser Options +options = + Options + <$> option + auto + ( long "iterations" + <> short 'i' + <> metavar "N" + <> value 1500 + <> help "Number of iterations" + ) + <*> option + auto + ( long "population-size" + <> short 'p' + <> metavar "N" + <> value 400 + <> help "Population size" + ) + +optionsWithHelp :: ParserInfo Options +optionsWithHelp = + info + (helper <*> options) + ( fullDesc + <> progDesc "Run a GA" + <> header "haga - Haskell implementations of EAs" + ) + +main :: IO () +main = + execParser optionsWithHelp >>= \opts -> do + hSetBuffering stdout NoBuffering + let seminarEE = prios + let env = AssignmentEnviroment (students seminarEE, topics seminarEE) + let selType = Tournament 3 + let run' = run seminarEE env selType 120 (5 / 100) (populationSize opts) (steps (iterations opts)) + pop' <- runEffect (for run' logCsv) + seminarEE' <- calc seminarEE pop' + let (res, _) = bests seminarEE' 5 pop' + seminarEE' <- calc seminarEE' res + mapM_ (format seminarEE') res + where + format seminarL s = do + let f = fitness' seminarL s + putErrText $ show f <> "\n" <> pretty s + logCsv = putText . csv + csv (t, f) = show t <> " " <> show f diff --git a/src/Seminar.hs b/src-students/Seminar.hs similarity index 98% rename from src/Seminar.hs rename to src-students/Seminar.hs index 643c95a..a7c56e6 100644 --- a/src/Seminar.hs +++ b/src-students/Seminar.hs @@ -127,8 +127,6 @@ instance Environment Assignment AssignmentEnviroment where -- Borrowed from TSP: Crossover cuts the parents in two and swaps them (if this -- does not create an invalid offspring). -- - -- TODO Assumes that both individuals are based on the same priorities. - -- crossover1 e assignment1 assignment2 = do let l = fromIntegral $ min (length assignment1) (length assignment2) :: Double x <- uniform 0 l diff --git a/src/Szenario191.hs b/src-students/Szenario191.hs similarity index 100% rename from src/Szenario191.hs rename to src-students/Szenario191.hs diff --git a/src-students/Test.hs b/src-students/Test.hs new file mode 100644 index 0000000..94d2431 --- /dev/null +++ b/src-students/Test.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module Main where + +import Protolude +import qualified Seminar + +main :: IO () +main = do + _ <- Seminar.runTests + return () + +if' :: Bool -> a -> a -> a +if' True x _ = x +if' False _ y = y diff --git a/src/IrisData.hs.template b/src/IrisData.hs.template deleted file mode 100644 index e5db1c4..0000000 --- a/src/IrisData.hs.template +++ /dev/null @@ -1,177 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module IrisData where - -import Data.Csv -import Protolude - -data IrisClass = Setosa | Virginica | Versicolor deriving (Eq, Generic, Show, Enum, Bounded) - -instance FromRecord IrisClass - -instance ToRecord IrisClass - -irisData :: [((Float, Float, Float, Float), IrisClass)] -irisData = - [ - ((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), - ((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), - ] - -irisTestData :: [((Float, Float, Float, Float), IrisClass)] -irisTestData = - [ - - ] diff --git a/src/Test.hs b/src/Test.hs deleted file mode 100644 index 0f21e57..0000000 --- a/src/Test.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE NoImplicitPrelude #-} - -module Main where - -import Data.Random -import Data.Typeable -import qualified GA -import qualified LambdaCalculus -import Protolude -import qualified Seminar -import System.Random.MWC (createSystemRandom) -import qualified Type.Reflection as Ref - -main :: IO () -main = do - -- _ <- GA.runTests - -- _ <- Seminar.runTests - -- _ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int -> Text))))) :: Text) - -- _ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Text))))) :: Text) - mwc <- createSystemRandom - r <- sampleFrom mwc $ GA.new LambdaCalculus.exampleLE - _ <- putStrLn $ LambdaCalculus.toLambdaExpressionS $ r - r <- sampleFrom mwc $ GA.new LambdaCalculus.exampleLE - _ <- putStrLn $ LambdaCalculus.toLambdaExpressionS $ r - -- _ <- putStrLn (LambdaCalculus.toLambdaExpressionShort LambdaCalculus.testIntToClassCorrect) - -- _ <- putStrLn $ ((show (LambdaCalculus.res 1)) :: Text) - -- _ <- putStrLn $ ((show (LambdaCalculus.res 2)) :: Text) - -- _ <- putStrLn $ ((show (LambdaCalculus.res 3)) :: Text) - return () - -if' :: Bool -> a -> a -> a -if' True x _ = x -if' False _ y = y