Hans/haga
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clean up, organize and document

Browse Source
This commit is contained in:
Johannes Merl 2024-04-22 14:33:40 +02:00
parent 5945016607
commit ea687a2fbb
25 changed files with 390 additions and 410 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
haga.cabal
View File

@ -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

17
lambda/README.md Normal file
View File

@ -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
```

9
lambda/lib/CommonDefinition.hs Normal file
View File

@ -0,0 +1,9 @@
{-# LANGUAGE NoImplicitPrelude #-}
module CommonDefinition where
import Protolude
if' :: Bool -> a -> a -> a
if' True e _ = e
if' False _ e = e

38
lambda/lib/LambdaDatasets/GermanDefinition.hs Normal file
View File

@ -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)

16
lambda/lib/LambdaDatasets/IrisDefinition.hs Normal file
View File

@ -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)

32
lambda/lib/LambdaDatasets/NurseryDefinition.hs Normal file
View File

@ -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)

35
src/GermanData.hs → lambda/src/LambdaDatasets/GermanData.hs
View File

@ -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 =

58
src/GermanDataset.hs → lambda/src/LambdaDatasets/GermanDataset.hs
View File

@ -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

15
src/IrisData.hs → lambda/src/LambdaDatasets/IrisData.hs
View File

@ -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)
]

58
src/IrisDataset.hs → lambda/src/LambdaDatasets/IrisDataset.hs
View File

@ -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)

25
src/NurseryData.hs → lambda/src/LambdaDatasets/NurseryData.hs
View File

@ -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 =

53
src/NurseryDataset.hs → lambda/src/LambdaDatasets/NurseryDataset.hs
View File

@ -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

28
src/Main.hs → lambda/src/Main.hs
View File

@ -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

8
src/GA.hs → lib/GA.hs
View File

@ -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

0
src/LambdaCalculus.hs → lib/LambdaCalculus.hs
View File

0
src/Pretty.hs → lib/Pretty.hs
View File

21
lib/Test.hs Normal file
View File

@ -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

18
src/Utils.hs → lib/Utils.hs
View File

@ -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]

2
run.sbatch
View File

@ -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

65
src-students/Main.hs Normal file
View File

@ -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

2
src/Seminar.hs → src-students/Seminar.hs
View File

@ -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

0
src/Szenario191.hs → src-students/Szenario191.hs
View File

21
src-students/Test.hs Normal file
View File

@ -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

177
src/IrisData.hs.template
View File

@ -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 =
[
]

39
src/Test.hs
View File

@ -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