Created
February 27, 2015 03:12
-
-
Save cmcenearney/676d32daf84eb68b81d9 to your computer and use it in GitHub Desktop.
GameOfLife.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {- | |
| adapted frm https://github.com/psfblair/ConwayLife/blob/master/LifeCore/Life.fs | |
| -} | |
| module GameOfLife where | |
| import Data.Set | |
| import qualified Data.Set as Set | |
| import Test.Hspec | |
| import Test.HUnit | |
| type Cell = (Int,Int) | |
| type Generation = Set Cell | |
| type LiveCells = Set Cell | |
| type IsAlive = Bool | |
| type LiveNeighborCount = Int | |
| type CellState = (Cell, IsAlive, LiveNeighborCount) | |
| survives :: CellState -> Bool | |
| survives (c,i,n) | |
| | n == 3 = True | |
| | i && n == 2 = True | |
| | otherwise = False | |
| neighborhood :: Cell -> Set Cell | |
| neighborhood (cx,cy) = Set.fromList [(x,y) | x <- [cx-1..cx+1], y <- [cy-1..cy+1]] | |
| neighbors :: Cell -> Set Cell | |
| neighbors c = Set.delete c (neighborhood c) | |
| cellState :: LiveCells -> Cell -> CellState | |
| cellState ls c = | |
| let n = Set.size $ Set.intersection (neighbors c) ls | |
| a = Set.member c ls | |
| in (c,a,n) | |
| nextGen :: Generation -> Generation | |
| nextGen g = | |
| let allCells = Set.foldl (\acc s -> Set.union acc s) Set.empty $ Set.map neighborhood g | |
| cellStates = Set.map (cellState g) allCells | |
| survivors = Set.toList $ Set.filter survives cellStates | |
| in Set.fromList $ [c | (c,_,_) <- survivors] | |
| {- | |
| Still lifes | |
| -} | |
| block = Set.fromList [(1,1),(1,2),(2,1),(2,2)] :: Generation | |
| beehive = Set.fromList [(1,2),(2,1),(3,1),(2,3),(3,3),(4,2)] :: Generation | |
| loaf = Set.fromList [(1,3),(2,2),(3,1),(4,2),(4,3),(3,4),(2,4)] :: Generation | |
| boat = Set.fromList [(1,2),(1,3),(2,1),(2,3),(3,2)] :: Generation | |
| {- | |
| Blinkers | |
| -} | |
| blinker = Set.fromList[(1,2),(2,2),(3,2)] :: Generation | |
| blinker' = Set.fromList[(2,1),(2,2),(2,3)] :: Generation | |
| beacon = Set.fromList[(1,1),(1,2),(2,1),(2,2),(3,3),(3,4),(4,3),(4,4)] :: Generation | |
| beacon' = Set.fromList[(1,1),(1,2),(2,1),(3,4),(4,3),(4,4)] :: Generation | |
| toad = Set.fromList[(1,2),(2,2),(3,2),(2,3),(3,3),(4,3)] :: Generation | |
| toad' = Set.fromList[(2,1),(1,2),(1,3),(3,4),(4,2),(4,3)] :: Generation | |
| {- | |
| Gliders | |
| -} | |
| glider = Set.fromList[(1,1),(2,1),(3,1),(3,2),(2,3)] :: Generation | |
| shiftX :: Int -> Generation -> Generation | |
| shiftX n g = Set.map (\(x,y) -> (x+n, y)) g | |
| shiftY :: Int -> Generation -> Generation | |
| shiftY n g = Set.map (\(x,y) -> (x, y+n)) g | |
| xGens :: Int -> Generation -> Generation | |
| xGens 0 g = g | |
| xGens x g = xGens (x - 1) (nextGen g) | |
| main :: IO () | |
| main = hspec spec | |
| spec :: Spec | |
| spec = do | |
| describe "Game Of Life" $ do | |
| context "still lifes" $ do | |
| it "block is a still life" $ do | |
| nextGen block `shouldBe` block | |
| it "beehive is a still life" $ do | |
| nextGen beehive `shouldBe` beehive | |
| it "loaf is a still life" $ do | |
| nextGen loaf `shouldBe` loaf | |
| it "boat is a still life" $ do | |
| nextGen boat `shouldBe` boat | |
| context "blinkers" $ do | |
| it "blinker oscillates with period 2" $ do | |
| nextGen blinker `shouldBe` blinker' | |
| it "beacon oscillates with period 2" $ do | |
| nextGen beacon `shouldBe` beacon' | |
| it "toad oscillates with period 2" $ do | |
| nextGen toad `shouldBe` toad' | |
| context "gliders" $ do | |
| it "classic glider has period 4 and travels diagonally" $ do | |
| let glider' = shiftY (-1) $ shiftX 1 glider | |
| xGens 4 glider `shouldBe` glider' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment