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

ＨａｓｋｅｌｌにもＴｕｒｔｌｅグラフィックスがあります。
ただどうしてもインストールできませんでした。

そこでＨａｓｋｅｌｌでＰｙｔｈｏｎのコードを出力します。

	import Turtle
	import System.Environment
	th = pi/3
	sg a b c n = do
	if n == 0
	then return ()
	else do
	tri a' b' c' "white" True
	sg a a' c' (n-1)
	sg a' b b' (n-1)
	sg c' b' c (n-1)
	where a' = mp a b
	b' = mp b c
	c' = mp c a
	getN :: IO Int
	getN = do
	a:[] <- getArgs
	return $ read a
	main = do
	n <- getN
	tStart
	penUp
	shape "turtle"
	let a = (-200,-200)
	let b = (200,-200)
	let c = (0,200*tan(th)-200)
	setPos a
	penDown
	tri a b c "black" True
	penUp
	sg a b c n
	tEnd

view raw t.hs hosted with ❤ by GitHub

	module Turtle where
	import Data.Complex
	tStart = do
	putStrLn "from turtle import *"
	putStrLn "t=Turtle()"
	speed n = putStrLn $ "t.speed(" ++ show n ++ ")"
	shape t = putStrLn $ "t.shape('" ++ t ++ "')"
	tEnd = putStrLn "done()"
	penUp = putStrLn "t.penup()"
	penDown = putStrLn "t.pendown()"
	forward x = putStrLn $ "t.forward(" ++ show x ++ ")"
	right x = putStrLn $ "t.right(" ++ show x ++ ")"
	left x = putStrLn $ "t.left(" ++ show x ++ ")"
	setPos x = putStrLn $ "t.setpos(" ++ show x ++ ")"
	polygon pp@(p:ps) color True = do
	putStrLn $ "t.fillcolor('" ++ color ++ "')"
	putStrLn "t.begin_fill()"
	mapM_ putStrLn coms
	putStrLn "t.end_fill()"
	where coms = ["t.setpos"++pos(x) | x <- ps']
	ps' = pp ++ [p]
	polygon pp@(p:ps) color _ = do
	putStrLn $ "t.pencolor('" ++ color ++ "')"
	mapM_ putStrLn coms
	where coms = ["t.setpos"++pos(x) | x <- ps']
	ps' = pp ++ [p]
	pos x = "("++ show x ++ ")"
	tri a b c color t = polygon [a,b,c] color t
	mp (x,y) (x',y') = let (a :+ b ) = (c0 + c1) / 2 in (a,b)
	where c0 = x :+ y
	c1 = x' :+ y'
	dot True = putStrLn "t.forward(1)" >> putStrLn "t.dot(1)"
	dot _ = putStrLn "t.forward(1)"
	lf = do
	putStrLn "t.setx(0)"
	putStrLn "t.setheading(270)"
	putStrLn "t.forward(1)"
	putStrLn "t.setheading(0)"

view raw Turtle.hs hosted with ❤ by GitHub

---

再帰深度１の場合、次のようなコードを生成します。

$ runghc t.hs 1 > a
$ cat a
from turtle import *
t=Turtle()
t.penup()
t.shape('turtle')
t.setpos((-200.0,-200.0))
t.pendown()
t.fillcolor('black')
t.begin_fill()
t.setpos((-200.0,-200.0))
t.setpos((200.0,-200.0))
t.setpos((0.0,146.41016151377534))
t.setpos((-200.0,-200.0))
t.end_fill()
t.penup()
t.fillcolor('white')
t.begin_fill()
t.setpos((0.0,-200.0))
t.setpos((100.0,-26.794919243112332))
t.setpos((-100.0,-26.794919243112332))
t.setpos((0.0,-200.0))
t.end_fill()
done()

pythonにパイプします。

$ cat a | python

直接Ｐｙｔｈｏｎにパイプしても可。

$ runghc t.hs 6 | python

再帰深度は５〜７が適当です。(深度を深くとってＰｙｔｈｏｎの起動まで時間がかかる場合はコンパイルします）

６の場合の実行結果

---

カメの軌跡で描くこともできます。

コードはこちら

	import Turtle
	import System.Environment
	sg2 x n = do
	mapM_ (\_ -> do forward x
	left 120
	if n == 0 then return ()
	else sg2 (x / 2) (n -1))
	[1,2,3]
	getN :: IO Int
	getN = do
	a:[] <- getArgs
	return $ read a
	main = do
	n <- getN
	tStart
	shape "blank"
	speed 0
	penUp
	let a = (-200,-200)
	setPos a
	penDown
	sg2 360 n
	tEnd

view raw t2.hs hosted with ❤ by GitHub

実行例の再帰深度は５。カメの動きはのろめ。
繰り返しの中に再帰が埋め込まれているので少し複雑なコードになっています。

ついでにコッホ曲線も。

コードは

	import Turtle
	koch l d i = do
	if i == 0
	then do
	setheading d
	forward l
	left 60
	forward l
	right 120
	forward l
	left 60
	forward l
	return ()
	else do
	koch (l/3) d (i-1)
	koch (l/3) (d + 60) (i-1)
	koch (l/3) (d - 60) (i-1)
	koch (l/3) d (i-1)
	main = do
	tStart
	shape "turtle"
	speed "1"
	penUp
	let a = (-200, 0)
	setPos a
	penDown
	koch 120 0 4
	tEnd

view raw koch.hs hosted with ❤ by GitHub

---

またランダムな要素を取り入れると

のような画像が得られる。自然の海岸線に見えなくもない。（いくつか描画してみていかにもそれらしいものを選んでいます）
そのためのコードはこちら

	import Data.Complex
	import System.Environment
	import System.Random
	import Turtle
	rotate d a b = (cos d :+ sin d) * (b - a) + a
	iDiv m n a b = (m * a + n * b) / (m + n)
	r :: IO Int
	r = do
	n <- getStdRandom (randomR (0,1))
	return n
	peak a b = do
	n <- r
	if n== 0
	then return $ rotate d60 a b
	else return $ rotate d60' a b
	d60 = pi / 3
	d60' = pi / 3 * (-1)
	toI :: IO Int
	toI = getArgs >>= \(n:_) -> return $ read n
	koch c0 c1 i = do
	let p1 = iDiv 2 1 c0 c1
	let p3 = iDiv 1 2 c0 c1
	p2 <- peak p1 p3
	if i == 0
	then do
	penUp
	setPos' c0
	penDown
	mapM_ setPos' [p1,p2,p3,c1]
	return ()
	else do
	koch c0 p1 (i - 1)
	koch p1 p2 (i - 1)
	koch p2 p3 (i - 1)
	koch p3 c1 (i - 1)
	where setPos' x = setPos (realPart x, imagPart x)
	main = do
	tStart
	shape "turtle"
	speed "0"
	penUp
	let a = (-200) :+ 0
	let b = 200 :+ 0
	i <- toI
	koch a b i
	tEnd

view raw koch2.hs hosted with ❤ by GitHub

---

複素数と平面図形に関する公式は
https://examist.jp/category/mathematics/complex-plane/
を参照しました。

---

ちなみに、マンデルブローの「The Misbehavior of Markets」に掲載されている画像はこちら。

---

スクラッチでも再帰は書けるらしい。

「こういうプログラムを再帰って言うんだ。
すこしむつかしいけど、おぼえておこう。」

---

シェルピンスキーのギャスケットをスクラッチで描くページはいくつかありますが、
最初に参照したページをあげておきます。

https://i-learn.jp/article/3302

---

こちらも参照下さい。http://hhg2the-haskell.blogspot.com/2017/10/blog-post_75.html