シェルピンスキーのギャスケット

ｐｂｍファイルでシェルピンスキーのギャスケットを描きます。
まずパスカルの三角形をつくります。

	import System.Environment
	pascal :: [Integer] -> [Integer]
	pascal l = 1:[x+y|x<-l|y<- tail l]++[1]
	pascalT :: [[Integer]]
	pascalT = scanl (\x _ -> pascal x) [1] [1..]
	pascalTri :: Int -> IO [[Integer]]
	pascalTri n = return $ take n pascalT
	getN = getArgs >>= \[n] -> return $ 2 ^ read n
	main = getN >>= pascalTri >>= mapM_ print

view raw pascal.hs hosted with ❤ by GitHub

---

$ runghc -XParallelListComp pascal.hs 3
[1]
[1,1]
[1,2,1]
[1,3,3,1]
[1,4,6,4,1]
[1,5,10,10,5,1]
[1,6,15,20,15,6,1]
[1,7,21,35,35,21,7,1]

---

奇数部を１、偶数部を０に置き換えます。

	import System.Environment
	pascal :: [Integer] -> [Integer]
	pascal l = 1:[x+y|x<-l|y<- tail l]++[1]
	pascalT :: [[Integer]]
	pascalT = scanl (\x _ -> pascal x) [1] [1..]
	pascalTri :: Int -> IO [[Integer]]
	pascalTri n = return $ take n pascalT
	getN = getArgs >>= \[n] -> return $ 2 ^ read n
	filt p xs = [if p x then '1' else '0'|x<-xs]
	filtAll p xs = return [filt p x|x<-xs]
	fill xs n = xs ++ replicate (n - length xs) '0'
	fillAll n = return . map (\x -> fill x n)
	unwords' :: [String] -> IO String
	unwords' = return . unwords
	main = do
	n <- getN
	str <- pascalTri n　>>=
	filtAll odd >>=
	fillAll n >>=
	unwords'
	let len = show n
	putStrLn ("P1 " ++ len ++ " " ++ len ++ " " ++ str)

view raw sierpinski.hs hosted with ❤ by GitHub

---

$ runghc -XParallelListComp sierpinski.hs 10 | display

描画には１０数秒かかります。

コンパイルすればほぼ一瞬で描画するようになります。

---

http://senjounosantafe.blogspot.com/2019/02/blog-post.html

上記のページに

Ｐｙｔｈｏｎ　のコードを出力し
Ｔｕｒｔｌｅ　グラフィックスで
シェルピンスキーのギャスケットを再帰的に描画するＨａｓｋｅｌｌのコードを置いています。

---

また１次元のセル・オートマトンにルール９０を適用することでもシェルピンスキーのギャスケットを描画できるそうです。

	import Data.Bits
	fs = replicate 31 '0' ++ "010" ++ replicate 31 '0'
	r s rule = let i = bToI (toBs s) in rule !! i
	where toBs = map (\x -> if x == '0' then False else True)
	loop l ll rule = do
	if length l == 2
	then ll
	else loop (tail l) (ll ++ [r (take 3 l) rule]) rule
	loop0 l n rule = do
	putStrLn l
	if n == 0 then return l
	else loop0 (last ll:ll++[head ll]) (n-1) rule
	where ll = loop l [] rule
	bToI :: [Bool] -> Int
	bToI bs = foldl (\x (y,z) -> if z then setBit x y else clearBit x y) (0::Int)
	$ zipWith (\a b -> (a,b)) [0 ..] $ reverse bs
	main = do
	loop0 fs 31 $ reverse "01011010"

view raw ca.hs hosted with ❤ by GitHub

---

実行例
$ runghc ca.hs

main を

main =  loop0 fs 31 $ reverse "11100001"

と書き換えるとルール２２５を描画します。

Intから２進数の文字列に変換するには
「2進、8進、10進、16進の各表現を相互に変換する」のページ

https://github.com/haskell-jp/recipe-collection/blob/master/%E6%95%B0%E5%80%A4/2%E9%80%B2%E3%80%818%E9%80%B2%E3%80%8110%E9%80%B2%E3%80%8116%E9%80%B2%E3%81%AE%E5%90%84%E8%A1%A8%E7%8F%BE%E3%82%92%E7%9B%B8%E4%BA%92%E3%81%AB%E5%A4%89%E6%8F%9B%E3%81%99%E3%82%8B.md


を参考に。

具体的には

ghci> import Numeric
ghci> import Data.Char
ghci> showIntAtBase 2 intToDigit 123 "" -- 123を2進数表記
"1111011"

ただし８桁になるように先頭にゼロを埋めること。

"1111011" -> "01111011"

---

参考ページ
Elementary Cellular Automata

http://atlas.wolfram.com/01/01/

---

その他のルールも適用可能にし精細な画像を描くにはこちら。

http://hhg2the-haskell.blogspot.com/2019/02/blog-post.html