working generation of Lamda Individuals! \o/
This commit is contained in:
parent
b6c1c27224
commit
a470fcc997
|
@ -46,7 +46,7 @@ type R = Double
|
||||||
-- An Environment that Individuals of type i can be created from
|
-- An Environment that Individuals of type i can be created from
|
||||||
-- It stores all information required to create and change Individuals correctly
|
-- It stores all information required to create and change Individuals correctly
|
||||||
--
|
--
|
||||||
class (Eq e, Pretty e, Individual i) => Environment i e where
|
class (Pretty e, Individual i) => Environment i e where
|
||||||
-- |
|
-- |
|
||||||
-- Generates a completely random individual.
|
-- Generates a completely random individual.
|
||||||
--
|
--
|
||||||
|
|
35
src/Test.hs
35
src/Test.hs
|
@ -1,4 +1,3 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
@ -9,21 +8,35 @@
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
import Data.Random
|
||||||
|
import Data.Typeable
|
||||||
import qualified GA
|
import qualified GA
|
||||||
|
import qualified LambdaCalculus
|
||||||
import Protolude
|
import Protolude
|
||||||
import qualified Seminar
|
import qualified Seminar
|
||||||
import qualified LambdaCalculus
|
import System.Random.MWC (createSystemRandom)
|
||||||
import Data.Typeable
|
|
||||||
import qualified Type.Reflection as Ref
|
import qualified Type.Reflection as Ref
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
_ <- GA.runTests
|
--_ <- GA.runTests
|
||||||
_ <- Seminar.runTests
|
--_ <- Seminar.runTests
|
||||||
_ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Int->Int->Int->Text))))) :: Text)
|
--_ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Int -> Int -> Int -> Text))))) :: Text)
|
||||||
_ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Text))))) :: Text)
|
--_ <- putStrLn $ ((show (typeRepArgs (Ref.SomeTypeRep (Ref.TypeRep @(Text))))) :: Text)
|
||||||
_ <- putStrLn (LambdaCalculus.toLambdaExpressionShort LambdaCalculus.testIntToClassCorrect)
|
mwc <- createSystemRandom
|
||||||
_ <- putStrLn $ ((show (LambdaCalculus.res 1)) :: Text)
|
r <- sampleFrom mwc $ LambdaCalculus.new LambdaCalculus.exampleLE
|
||||||
_ <- putStrLn $ ((show (LambdaCalculus.res 2)) :: Text)
|
_ <- putStrLn $ LambdaCalculus.toLambdaExpressionS $ r
|
||||||
_ <- putStrLn $ ((show (LambdaCalculus.res 3)) :: Text)
|
r <- sampleFrom mwc $ LambdaCalculus.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 ()
|
return ()
|
||||||
|
|
||||||
|
if' :: Bool -> a -> a -> a
|
||||||
|
if' True x _ = x
|
||||||
|
if' False _ y = y
|
||||||
|
|
||||||
|
--f :: Int -> Int -> Int
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user