summaryrefslogtreecommitdiff
path: root/anonco/Main.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2018-07-11 12:57:18 -0700
committerBen Sima <ben@bsima.me>2018-07-11 12:57:18 -0700
commitb26eb3413979ddf8a676b604401f9853d5a342bc (patch)
tree4f4e7373f4b50353cf5c4b08fb2fde03d544f305 /anonco/Main.hs
parent781400254cf01bc564ddf96b68a4ba690424a264 (diff)
Rename to anonco
Diffstat (limited to 'anonco/Main.hs')
-rw-r--r--anonco/Main.hs62
1 files changed, 62 insertions, 0 deletions
diff --git a/anonco/Main.hs b/anonco/Main.hs
new file mode 100644
index 0000000..891fcf7
--- /dev/null
+++ b/anonco/Main.hs
@@ -0,0 +1,62 @@
+module Main where
+
+import System.Environment
+import Control.Monad
+import System.Random (newStdGen, randomRs)
+import Data.List.Split
+
+main :: IO ()
+main = do
+ args <- getArgs
+ case args of
+ [] -> putStrLn "Needs one argument"
+ (n:_) -> run (read n :: Int)
+
+-- | Run the cellular automata with a random seed.
+run :: Int -> IO ()
+run n = do
+ g <- newStdGen
+ let init = take n $ randomRs (0,1) g
+ run' init
+
+-- | Version of 'run' that allows for entering your own initial seed.
+run' :: [Int] -> IO ()
+run' init = do
+ let n = length init
+ 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)
+
+-- Here I'm using a sequence-based computation to find the next step. There is
+-- an arithmetic way to calculate it, but I can't find a good explanation of the
+-- arithmetic online. So, until I get a copy of Wolfram's book, I'll just stick
+-- with this; unfortunately I think the source of my bug is in the sequence
+-- logic :(
+
+next :: Int -> [Int] -> [Int]
+next n state = [left, center, right]
+ where
+ center = translate $ getLast n' state
+ right = translate $ getLast (n'+1) state
+ left = translate $ getLast (n'-1) state
+ n' = n+n
+
+getLast :: Int -> [a] -> [a]
+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 _ = 0