cellar automata

README

not_so_slow.hs

Usage

    main :: Int -> Int -> Int -> IO ()
    main' rule len s

len : 最終行の長さ
s   : 出力の行数

Output

' ' : 0
'#' : 1
'.' : 計算していない


loop.hs
左右がつながっている

loop.hs

import Data.Bits
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector as V

toRule :: Int -> (Bool,Bool,Bool) -> Bool
toRule n = \(b2,b1,b0) -> testBit n (bs2i [b2,b1,b0])
  where
    b2i True = 1
    b2i False = 0
    bs2i = foldl (\acc b -> 2*acc + b2i b) 0

step :: ((Bool,Bool,Bool) -> Bool) -> U.Vector Bool -> U.Vector Bool
step rule xs = U.imap (\i _ -> rule (xs !!! (i-1), xs !!! i, xs !!! (i+1))) xs
  where
    v !!! i = v U.! (i `mod` U.length v)

run :: Int -> U.Vector Bool -> Int -> V.Vector (U.Vector Bool)
run rule ini s = V.iterateN s (step (toRule rule)) ini

run' :: Int -> Int -> Int -> V.Vector (U.Vector Bool)
run' rule len s = run rule initVect s
  where
    initVect = U.generate len (\i -> i == (len-1) `div` 2)

showResult :: V.Vector (U.Vector Bool) -> V.Vector String
showResult = V.map (U.toList . U.map (\b -> if b then '#' else ' '))

main' :: Int -> Int -> Int -> IO ()
main' rule len s = V.mapM_ putStrLn . showResult $ run' rule len s

main :: IO ()
main = main' 110 64 32

not_so_slow.hs

import Data.Bits
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector as V

toRule :: Int -> (Bool,Bool,Bool) -> Bool
toRule n = \(b2,b1,b0) -> testBit n (bs2i [b2,b1,b0])
  where
    b2i True = 1
    b2i False = 0
    bs2i = foldl (\acc b -> 2*acc + b2i b) 0

step :: ((Bool,Bool,Bool) -> Bool) -> U.Vector Bool -> U.Vector Bool
step rule xs = U.generate (U.length xs - 2)
  $ \i -> rule (xs U.! i, xs U.! (i+1), xs U.! (i+2))

run :: Int -> U.Vector Bool -> Int -> V.Vector (U.Vector Bool)
run rule ini s = V.iterateN s (step (toRule rule)) ini

run' :: Int -> Int -> Int -> V.Vector (U.Vector Bool)
run' rule len s = run rule initVect s
  where
    initVect = U.generate (len + 2*(s-1)) (\i -> i == s-1 + (len-1) `div` 2)

showResult :: V.Vector (U.Vector Bool) -> V.Vector String
showResult = V.imap (\i v -> replicate i '.' ++ showBs v)
-- showResult vs = V.imap (\i v -> drop (V.length vs - i) $ showBs v) vs
  where
    showBs = map (\b -> if b then '#' else ' ') . U.toList

main' :: Int -> Int -> Int -> IO ()
main' rule len s = V.mapM_ putStrLn . showResult $ run' rule len s

main :: IO ()
main = main' 110 64 32

Output

                                                              #                                                               
.                                                            ##                                                              
..                                                          ###                                                             
...                                                        ## #                                                            
....                                                      #####                                                           
.....                                                    ##   #                                                          
......                                                  ###  ##                                                         
.......                                                ## # ###                                                        
........                                              ####### #                                                       
.........                                            ##     ###                                                      
..........                                          ###    ## #                                                     
...........                                        ## #   #####                                                    
............                                      #####  ##   #                                                   
.............                                    ##   # ###  ##                                                  
..............                                  ###  #### # ###                                                 
...............                                ## # ##  ##### #                                                
................                              ######## ##   ###                                               
.................                            ##      ####  ## #                                              
..................                          ###     ##  # #####                                             
...................                        ## #    ### ####   #                                            
....................                      #####   ## ###  #  ##                                           
.....................                    ##   #  ##### # ## ###                                          
......................                  ###  ## ##   ######## #                                         
.......................                ## # ######  ##      ###                                        
........................              #######    # ###     ## #                                       
.........................            ##     #   #### #    #####                                      
..........................          ###    ##  ##  ###   ##   #                                     
...........................        ## #   ### ### ## #  ###  ##                                    
............................      #####  ## ### ###### ## # ###                                   
.............................    ##   # ##### ###    ######## #                                  
..............................  ###  ####   ### #   ##      ###                                 
...............................## # ##  #  ## ###  ###     ## #                                

very_very_slow.hs

import Data.Bits

toRule :: Int -> (Bool,Bool,Bool) -> Bool
toRule n = \(b2,b1,b0) -> testBit n (bs2i [b2,b1,b0])
  where
    b2i True = 1
    b2i False = 0
    bs2i = foldl (\acc b -> 2*acc + b2i b) 0

step :: ((Bool,Bool,Bool) -> Bool) -> (Int -> Bool) -> (Int -> Bool)
step rule xs = \n -> rule (xs (n-1), xs n, xs (n+1))

run :: Int -> (Int -> Bool) -> Int -> Int -> Int -> [[Bool]]
run rule ini line from to = map (\xs -> map xs [from..to]) . take line
  $ iterate (step (toRule rule)) ini

showBs :: [Bool] -> String
showBs = map (\b -> if b then '#' else ' ')

main :: IO ()
main = mapM_ (putStrLn . showBs) $ run 110 (==0) 16 (-31) 0