diff options
| -rw-r--r-- | nerine.cabal | 2 | ||||
| -rw-r--r-- | src/Lattice.hs | 23 | ||||
| -rw-r--r-- | test/LatticeTest.hs | 37 | ||||
| -rw-r--r-- | test/Main.hs | 2 |
4 files changed, 64 insertions, 0 deletions
diff --git a/nerine.cabal b/nerine.cabal index 7592604..0e1695a 100644 --- a/nerine.cabal +++ b/nerine.cabal @@ -26,6 +26,7 @@ source-repository head library exposed-modules: Genome + Lattice Lib Mind other-modules: @@ -64,6 +65,7 @@ test-suite nerine-test main-is: Main.hs other-modules: GenomeTest + LatticeTest MindTest Paths_nerine autogen-modules: diff --git a/src/Lattice.hs b/src/Lattice.hs new file mode 100644 index 0000000..b69aa41 --- /dev/null +++ b/src/Lattice.hs @@ -0,0 +1,23 @@ +module Lattice + ( LatticeCell (..) + , Lattice + , LatticeRule + , updateLattice + ) where + + +data LatticeCell a b = LatticeCell { kind :: a, flags :: b } deriving (Show, Eq) +type Lattice a b = [[LatticeCell a b]] +type LatticeRule a b = Lattice a b -> Int -> Int -> LatticeCell a b + + +updateLattice :: (Enum a) => Lattice a b -> [LatticeRule a b] -> Lattice a b +updateLattice lattice rules = + let + mapRow = \(row, y) -> map + (\((LatticeCell k _), x) -> + let rule = rules !! (fromEnum k) + in rule lattice x y + ) + (zip row [0..]) + in map mapRow (zip lattice [0..]) diff --git a/test/LatticeTest.hs b/test/LatticeTest.hs new file mode 100644 index 0000000..a7d67d8 --- /dev/null +++ b/test/LatticeTest.hs @@ -0,0 +1,37 @@ +module LatticeTest (suite) where + +import Test.Tasty +import Test.Tasty.HUnit +import Lattice + +suite :: TestTree +suite = testGroup "lattice tests" $ + [ latticeGrowth + ] + + +data GrowKind = Empty | Plant deriving (Show, Enum, Eq) +data GrowFlags = None deriving (Show, Eq) + + +latticeGrowth :: TestTree +latticeGrowth = testCase "growth update rule" $ + let + plant = LatticeCell Plant None + empty = LatticeCell Empty None + lattice = [[ empty, empty, plant ]] + rules = + [ + -- empty + \l x y -> + if kind ((l !! y) !! (x+1)) == Plant + then LatticeCell Plant None + else LatticeCell Empty None + -- plant + , \_ _ _ -> LatticeCell Plant None + ] :: [LatticeRule GrowKind GrowFlags] + lattice' = updateLattice lattice rules + lattice'' = updateLattice lattice' rules + in do + lattice' @?= [[ empty, plant, plant ]] + lattice'' @?= [[ plant, plant, plant ]] diff --git a/test/Main.hs b/test/Main.hs index 907bbdd..24666a6 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -4,9 +4,11 @@ import Test.Tasty import qualified MindTest import qualified GenomeTest +import qualified LatticeTest main :: IO () main = defaultMain $ testGroup "all tests" $ [ MindTest.suite , GenomeTest.suite + , LatticeTest.suite ] |