Add simspace

Theres a bug, need Wolfram's book to get into the math of it, I can't
find a good explanation of the actual math anywhere (the wikipedia page
is pretty bad)

1 files changed, 46 insertions, 0 deletions

diff --git a/simspace/Main.hs b/simspace/Main.hs
new file mode 100644
index 0000000..07d2705
--- /dev/null
+++ b/simspace/Main.hs
@@ -0,0 +1,46 @@
+module Main where
+
+import System.Environment
+import Control.Monad
+import System.Random (getStdGen, randomRs)
+import Data.List.Split
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+        [] -> putStrLn "Needs one argument"
+        (n:_) -> run (read n :: Int)
+
+run :: Int -> IO ()
+run n = do
+    g <- getStdGen
+    let init = take n $ randomRs (0,1) g
+    let zeros = take n $ repeat 0
+    let result = takeWhile' (/= zeros) $ chunksOf n $ compute n init
+    forM_ result $ \r -> putStrLn $ show r
+
+takeWhile' :: (a -> Bool) -> [a] -> [a]
+takeWhile' _ [] = []
+takeWhile' p (x:xs) = x : if p x then takeWhile' p xs else []
+
+compute :: Int -> [Int] -> [Int]
+compute n state = state ++ compute n (next n state)
+
+next n state = [left, center, right]
+    where
+        center = translate $ getLast n state
+        right = translate $ getLast (n+1) state
+        left = translate $ getLast (n-1) state
+
+getLast n ls = drop (length ls - n) ls
+
+translate [0,0,0] = 0
+translate [0,0,1] = 1
+translate [0,1,0] = 1
+translate [0,1,1] = 1
+translate [1,0,0] = 0
+translate [1,0,1] = 1
+translate [1,1,0] = 1
+translate [1,1,1] = 0
+translate _ = 1