遅延評価フラクタル - season's quarterly

以前Haskellの遅延評価で良い感じにフラクタルが描けないかなあと思ったことがあって、最近Haskellの本読んでたのでやった。

github.com

gloss

2Dグラフィクスライブラリは適当にglossを選んだ。以下を参考にした。

stack exec lazy-fractal-exeするときにuser error (unknown GLUT entry glutInit)と出たので、

Haskell with OpenGL. (Unknown GLUT entry glutInit) - Stack Overflow

に従ってfreeglut/bin/x64/freeglut.dllを.stack-work/install/hoge/bin/にコピーしてglut32.dllにrenameしたら動いた。

フラクタルの描画

シェルピンスキーのギャスケットを描く。遅延評価を使えば無限長のリストが定義できるので、解像度を明示することなくフラクタル図形を表現可能だ。

30行しかないので読んだ方が早い。

gasketは三角形からなる無限長のリストを返す。一番外側の三角形の頂点を$a, b ,c$、それぞれの対辺の中点を$midA, midB, midC$として、再帰呼び出しして良い感じにマージする。takeGasketはフラクタルの粒度と全体のサイズを引数として、無限長のリストの先頭から相当する要素を抜き出す。

mid :: Point -> Point -> Point
mid a b = do
    let (x1, y1) = a
    let (x2, y2) = b
    ((x1 + x2) / 2, (y1 + y2) / 2)

mix :: [a] -> [a] -> [a] -> [a]
mix [] [] [] = []
mix x y z = (head x) : (head y) : (head z) : mix (tail x) (tail y) (tail z)

triangle :: Point -> Point -> Point -> Picture
triangle a b c = line [a, b, c, a]

gasket :: Point -> Point -> Point -> [Picture]
gasket a b c = do
    let midA = mid b c
    let midB = mid c a
    let midC = mid a b

    let subA = gasket    a midC midB
    let subB = gasket midC    b midA
    let subC = gasket midB midA    c
    
    (triangle a b c) : (mix subA subB subC)

takeGasket :: Int -> Float -> [Picture]
takeGasket level len = do
    let num = sum [3^x | x <- [0..level]]
    take num (gasket (-len / 2, 0) (len / 2, 0) (0, len * sqrt 3 / 2))

あとはpicturesに渡してウィンドウを作るだけ。

main :: IO ()
main = display window white (pictures (takeGasket 10 300))

本当は宣言的(図形Aを、Aを半分に縮小したものを三つ集めたものとして記述)に書きたかったけど、その場合レベルを明示しないとそもそも形が定まらない可能性があり難しい。よって操作的(レベル$n$のフラクタルに付加してレベル$n+1$のフラクタルを描く)に書くしかない。コッホ雪片などは、曲線に関しては外形が定まらないため削除命令を追加するか、内部の図形に関しては突起を追加するように描けるので内と外で色を分けるなどの工夫が必要になる。