fix copied GeneInt

This commit is contained in:
Rowan Torbitzky-Lane 2025-01-16 15:07:08 -06:00
commit 72d6562542
11 changed files with 174 additions and 66 deletions

1
.gitignore vendored
View File

@ -1,3 +1,4 @@
dist-*
*$py.class
**/*.DS_Store
**/*__pycache__

105
HushGP.cabal Normal file
View 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

View File

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

View File

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

View File

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

View File

@ -1,3 +1,2 @@
:set stop :list
:set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m "
:load Main

View File

@ -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
View 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
View 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."

View File

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