fix copied GeneInt
This commit is contained in:
commit
72d6562542
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,3 +1,4 @@
|
||||
dist-*
|
||||
*$py.class
|
||||
**/*.DS_Store
|
||||
**/*__pycache__
|
||||
|
105
HushGP.cabal
Normal file
105
HushGP.cabal
Normal file
@ -0,0 +1,105 @@
|
||||
cabal-version: 3.4
|
||||
-- The cabal-version field refers to the version of the .cabal specification,
|
||||
-- and can be different from the cabal-install (the tool) version and the
|
||||
-- Cabal (the library) version you are using. As such, the Cabal (the library)
|
||||
-- version used must be equal or greater than the version stated in this field.
|
||||
-- Starting from the specification version 2.2, the cabal-version field must be
|
||||
-- the first thing in the cabal file.
|
||||
|
||||
-- The name of the package.
|
||||
name: HushGP
|
||||
|
||||
-- The package version.
|
||||
-- PVP summary: +-+------- breaking API changes
|
||||
-- | | +----- non-breaking API additions
|
||||
-- | | | +--- code changes with no API change
|
||||
version: 0.1.0.0
|
||||
|
||||
-- A short (one-line) description of the package.
|
||||
synopsis: A PushGP implementation in Haskell.
|
||||
|
||||
-- The package author(s).
|
||||
author: Taylor
|
||||
|
||||
-- An email address to which users can send suggestions, bug reports, and patches.
|
||||
maintainer: behindthebrain@zoho.eu
|
||||
|
||||
category: Data
|
||||
build-type: Simple
|
||||
|
||||
common warnings
|
||||
ghc-options: -Wall
|
||||
|
||||
library
|
||||
-- Import common warning flags.
|
||||
import: warnings
|
||||
|
||||
-- Modules exported by the library.
|
||||
exposed-modules: Push, GP
|
||||
|
||||
-- Modules included in this library but not exported.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends:
|
||||
base ^>=4.18.2.1, containers
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: src
|
||||
|
||||
-- Base language which the package is written in.
|
||||
default-language: GHC2021
|
||||
|
||||
executable HushGP
|
||||
-- Import common warning flags.
|
||||
import: warnings
|
||||
|
||||
-- .hs or .lhs file containing the Main module.
|
||||
main-is: Main.hs
|
||||
|
||||
-- Modules included in this executable, other than Main.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends:
|
||||
base ^>=4.18.2.1,
|
||||
HushGP
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: app
|
||||
|
||||
-- Base language which the package is written in.
|
||||
default-language: GHC2021
|
||||
|
||||
test-suite HushGP-test
|
||||
-- Import common warning flags.
|
||||
import: warnings
|
||||
|
||||
-- Base language which the package is written in.
|
||||
default-language: GHC2021
|
||||
|
||||
-- Modules included in this executable, other than Main.
|
||||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
||||
-- The interface type and version of the test suite.
|
||||
type: exitcode-stdio-1.0
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: test
|
||||
|
||||
-- The entrypoint to the test suite.
|
||||
main-is: Main.hs
|
||||
|
||||
-- Test dependencies.
|
||||
build-depends:
|
||||
base ^>=4.18.2.1,
|
||||
HushGP
|
25
Makefile
25
Makefile
@ -7,26 +7,27 @@ help: # Show help for each of the commented Makefile recipes.
|
||||
run: target/Main.out # Runs your compiled main code.
|
||||
./target/Main.out
|
||||
|
||||
target/Main.out: src/*
|
||||
ghc -g -fprof-auto -prof -Wall src/*.hs -o target/Main.out
|
||||
target/Main.out: src/* app/*
|
||||
ghc -g -fprof-auto -prof -Wall app/*.hs src/*.hs -o target/Main.out
|
||||
@rm -f src/*.o src/*.hi
|
||||
|
||||
test: tests/*.hs # Runs unit tests.
|
||||
runghc -i./src/ tests/Main.hs
|
||||
test: # Runs unit tests.
|
||||
runghc -i./src/ test/Main.hs
|
||||
|
||||
format: src/* # Formats code using ormolu.
|
||||
ormolu --mode inplace src/*.hs tests/*.hs
|
||||
format: # Formats code using ormolu.
|
||||
ormolu --mode inplace app/*.hs src/*.hs test/*.hs
|
||||
|
||||
hlint: src/*.hs # HLint for lint suggestions.
|
||||
hlint: # HLint for lint suggestions.
|
||||
hlint src/*.hs
|
||||
|
||||
stan: src/*.hs # Stan for more optimization suggestions.
|
||||
ghc -fwrite-ide-info src/*.hs -o target/temp.out
|
||||
stan: # Stan for more optimization suggestions.
|
||||
ghc -fwrite-ide-info app/*.hs src/*.hs -o target/temp.out
|
||||
stan --hiedir src/
|
||||
rm -f target/temp.out src/*.hi src/*.o src/*.hie
|
||||
rm -f target/temp.out src/*.hi src/*.o src/*.hie app/*.o app/*.hi app/*.hie
|
||||
|
||||
clean: # Cleans up all the generated logfiles and outfiles.
|
||||
@rm -rf *.out *.o *.hi
|
||||
@rm -rf target/*
|
||||
@rm -rf */*.out */*.o */*.hi
|
||||
@rm -rf */*/*.out */*/*.o */*/*.hi
|
||||
@rm -rf */*.out */*.o */*.hi */*.hie
|
||||
@rm -rf */*/*.out */*/*.o */*/*.hi */*.hie
|
||||
@rm -rf dist-*
|
||||
|
@ -2,7 +2,7 @@
|
||||
A PushGP implementation in Haskell
|
||||
|
||||
## Tasks
|
||||
* [ ] refactor Gene to contain *Gene to Gene* for naming consistency.
|
||||
* [ ] Post minimal core of exec to haskell discourse for advice about speed optimization.
|
||||
* [x] Do test-driven development on this one.
|
||||
* [x] Write tests for every function.
|
||||
* [x] tests/ are just copied from make-grade, need to write for this project.
|
||||
|
@ -1,3 +1,3 @@
|
||||
:set stop :list
|
||||
:set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m "
|
||||
:load Main ../src/Push ../src/GP
|
||||
:load Main ../src/GP ../src/Push
|
@ -1,3 +1,2 @@
|
||||
:set stop :list
|
||||
:set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m "
|
||||
:load Main
|
||||
|
48
src/Push.hs
48
src/Push.hs
@ -4,27 +4,27 @@ module Push where
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Debug.Trace (trace, traceStack)
|
||||
-- import Debug.Trace (trace, traceStack)
|
||||
|
||||
-- The exec stack must store heterogenous types,
|
||||
-- and we must be able to detect that type at runtime.
|
||||
-- One solution is for the exec stack to be a list of [Gene].
|
||||
-- The parameter stack could be singular [Gene] or multiple [atomic] types.
|
||||
data Gene
|
||||
= IntGene Int
|
||||
| FloatGene Float
|
||||
| BoolGene Bool
|
||||
| StringGene String
|
||||
= GeneInt Int
|
||||
| GeneFloat Float
|
||||
| GeneBool Bool
|
||||
| GeneString String
|
||||
| StateFunc (State -> State)
|
||||
| PlaceInput String
|
||||
| Close
|
||||
| Block [Gene]
|
||||
|
||||
instance Eq Gene where
|
||||
IntGene x == IntGene y = x == y
|
||||
FloatGene x == FloatGene y = x == y
|
||||
BoolGene x == BoolGene y = x == y
|
||||
StringGene x == StringGene y = x == y
|
||||
GeneInt x == GeneInt y = x == y
|
||||
GeneFloat x == GeneFloat y = x == y
|
||||
GeneBool x == GeneBool y = x == y
|
||||
GeneString x == GeneString y = x == y
|
||||
PlaceInput x == PlaceInput y = x == y
|
||||
Close == Close = True
|
||||
StateFunc x == StateFunc y = True -- This line is probably not the best thing to do
|
||||
@ -32,10 +32,10 @@ instance Eq Gene where
|
||||
_ == _ = False
|
||||
|
||||
instance Show Gene where
|
||||
show (IntGene x) = "Int: " <> show x
|
||||
show (FloatGene x) = "Float: " <> show x
|
||||
show (BoolGene x) = "Bool: " <> show x
|
||||
show (StringGene x) = "String: " <> x
|
||||
show (GeneInt x) = "Int: " <> show x
|
||||
show (GeneFloat x) = "Float: " <> show x
|
||||
show (GeneBool x) = "Bool: " <> show x
|
||||
show (GeneString x) = "String: " <> x
|
||||
show (StateFunc func) = "Func: unnamed"
|
||||
show (PlaceInput x) = "In: " <> x
|
||||
show Close = "Close"
|
||||
@ -140,7 +140,7 @@ instructionExecDup state = state
|
||||
instructionExecDoRange :: State -> State
|
||||
instructionExecDoRange state@(State {exec = (e1 : es), int = (i0 : i1 : is), ..}) =
|
||||
if increment i0 i1 /= 0
|
||||
then state {exec = e1 : Block [IntGene (i1 + increment i0 i1), IntGene i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is}
|
||||
then state {exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is}
|
||||
else state {exec = e1 : es, int = i1 : is}
|
||||
where
|
||||
increment :: Int -> Int -> Int
|
||||
@ -154,14 +154,14 @@ instructionExecDoCount :: State -> State
|
||||
instructionExecDoCount state@(State {exec = (e1 : es), int = (i1 : is), ..}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is}
|
||||
else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is}
|
||||
instructionExecDoCount state = state
|
||||
|
||||
instructionExecDoTimes :: State -> State
|
||||
instructionExecDoTimes state@(State {exec = (e1 : es), int = (i1 : is), ..}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is}
|
||||
else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is}
|
||||
instructionExecDoTimes state = state
|
||||
|
||||
instructionExecWhile :: State -> State
|
||||
@ -190,10 +190,10 @@ instructionExecWhen state = state
|
||||
-- Optionally, split this off into independent functions
|
||||
instructionParameterLoad :: State -> State
|
||||
instructionParameterLoad state@(State {parameter = (p : ps), ..}) = case p of
|
||||
(IntGene val) -> state {int = val : int}
|
||||
(FloatGene val) -> state {float = val : float}
|
||||
(BoolGene val) -> state {bool = val : bool}
|
||||
(StringGene val) -> state {string = val : string}
|
||||
(GeneInt val) -> state {int = val : int}
|
||||
(GeneFloat val) -> state {float = val : float}
|
||||
(GeneBool val) -> state {bool = val : bool}
|
||||
(GeneString val) -> state {string = val : string}
|
||||
instructionParameterLoad state = state
|
||||
|
||||
-- Loads a genome into the exec stack
|
||||
@ -214,10 +214,10 @@ interpretExec :: State -> State
|
||||
interpretExec state@(State {exec = [], ..}) = state {exec = []}
|
||||
interpretExec state@(State {exec = (e : es), ..}) =
|
||||
case e of
|
||||
(IntGene val) -> interpretExec state {exec = es, int = val : int}
|
||||
(FloatGene val) -> interpretExec (state {exec = es, float = val : float})
|
||||
(BoolGene val) -> interpretExec (state {exec = es, bool = val : bool})
|
||||
(StringGene val) -> interpretExec (state {exec = es, string = val : string})
|
||||
(GeneInt val) -> interpretExec state {exec = es, int = val : int}
|
||||
(GeneFloat val) -> interpretExec (state {exec = es, float = val : float})
|
||||
(GeneBool val) -> interpretExec (state {exec = es, bool = val : bool})
|
||||
(GeneString val) -> interpretExec (state {exec = es, string = val : string})
|
||||
(StateFunc func) -> interpretExec $ func state {exec = es}
|
||||
(Block block) -> interpretExec (state {exec = block ++ es})
|
||||
(PlaceInput val) -> interpretExec (state {exec = (input Map.! val) : es})
|
||||
|
3
test/.ghci
Normal file
3
test/.ghci
Normal file
@ -0,0 +1,3 @@
|
||||
:set stop :list
|
||||
:set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m "
|
||||
:load Main ../src/GP ../src/Push
|
26
test/Main.hs
Normal file
26
test/Main.hs
Normal file
@ -0,0 +1,26 @@
|
||||
import Control.Exception (assert)
|
||||
import GP
|
||||
import Push
|
||||
|
||||
intTestFunc :: String -> [Int] -> [Gene] -> State -> IO ()
|
||||
intTestFunc name goal genome startState =
|
||||
let state = loadProgram genome startState
|
||||
in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.")
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
intTestFunc "instructionIntAdd" [8] [GeneInt 6, GeneInt 2, StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionIntSub" [4] [GeneInt 6, GeneInt 2, StateFunc instructionIntSub] emptyState
|
||||
intTestFunc "instructionIntMul" [12] [GeneInt 6, GeneInt 2, StateFunc instructionIntMul] emptyState
|
||||
intTestFunc "instructionIntDiv" [3] [GeneInt 6, GeneInt 2, StateFunc instructionIntDiv] emptyState
|
||||
intTestFunc "instructionExecIf" [6, 5] [GeneBool True, StateFunc instructionExecIf, Block [GeneInt 5, GeneInt 6], Block [GeneInt 7, GeneInt 8]] emptyState
|
||||
intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, GeneInt 4, StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionExecDoRange" [12] [GeneInt 2, Block [GeneInt 4, GeneInt 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionExecDoCount" [8] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoTimes], GeneInt 69] emptyState
|
||||
intTestFunc "instructionExecDoTimes" [70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecWhile, GeneInt 70] emptyState
|
||||
intTestFunc "instructionExecWhile" [70, 70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecDoWhile, GeneInt 70] emptyState
|
||||
intTestFunc "instructionExecDoWhile" [71] [GeneBool True, StateFunc instructionExecWhen, GeneInt 71] emptyState
|
||||
|
||||
let loadedState = loadProgram [GeneBool False, StateFunc instructionExecWhen, GeneInt 71] emptyState
|
||||
assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test."
|
@ -1,27 +0,0 @@
|
||||
import Control.Exception (assert)
|
||||
import GP
|
||||
import Push
|
||||
|
||||
intTestFunc :: String -> [Int] -> [Gene] -> State -> IO ()
|
||||
intTestFunc name goal genome startState =
|
||||
let state = loadProgram genome startState
|
||||
in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.")
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
intTestFunc "instructionIntAdd" [8] [IntGene 6, IntGene 2, StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionIntSub" [4] [IntGene 6, IntGene 2, StateFunc instructionIntSub] emptyState
|
||||
intTestFunc "instructionIntMul" [12] [IntGene 6, IntGene 2, StateFunc instructionIntMul] emptyState
|
||||
intTestFunc "instructionIntDiv" [3] [IntGene 6, IntGene 2, StateFunc instructionIntDiv] emptyState
|
||||
intTestFunc "instructionExecIf" [6, 5] [BoolGene True, StateFunc instructionExecIf, Block [IntGene 5, IntGene 6], Block [IntGene 7, IntGene 8]] emptyState
|
||||
intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, IntGene 4, StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionExecDoRange" [12] [IntGene 2, Block [IntGene 4, IntGene 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionExecDoCount" [8] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState
|
||||
intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoTimes], IntGene 69] emptyState
|
||||
intTestFunc "instructionExecDoTimes" [70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecWhile, IntGene 70] emptyState
|
||||
intTestFunc "instructionExecWhile" [70, 70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecDoWhile, IntGene 70] emptyState
|
||||
intTestFunc "instructionExecDoWhile" [71] [BoolGene True, StateFunc instructionExecWhen, IntGene 71] emptyState
|
||||
|
||||
let loadedState = loadProgram [BoolGene False, StateFunc instructionExecWhen, IntGene 71] emptyState
|
||||
assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test."
|
Loading…
x
Reference in New Issue
Block a user