Subscribed unsubscribe Subscribe Subscribe

HaskellとGtk2Hsとモナドとマンデルブロ集合

Haskell

先週研究室のM1のTくんがVC++マンデルブロ集合を表示するプログラムを作ってきた.これはHaskellで書き直さないと気が済まない.ということで書いてみた.モナドが難しくて丸一日費やした.

あらすじ

簡単にまとめると以下の通り.

マンデルブロ集合の計算

マンデルブロ集合の計算は簡単にできる.ここのページの通りに計算すると以下のようになる.

{- z = z^2 + c -}
mandelbrot :: (Num a1, Num (Complex a), RealFloat a) =>
              Complex a -> Complex a -> a1 -> a1
mandelbrot _ _ 0                   = 0
mandelbrot z c n | magnitude z > 2 = n
                 | otherwise       = mandelbrot (z^2+c) c (n-1)

この型宣言,:t mandelbrotしたものをそのまま書いている.この書き方はGHCの拡張機能を使っているらしい.このためコンパイル時に-fglasgow-extsが必要になる.

マンデルブロ集合のいくつかのバリエーションも一緒に作っておく.

{- z = z^3 + c -}
mandelbrot' :: (Num a1, Num (Complex a), RealFloat a) =>
               Complex a -> Complex a -> a1 -> a1
mandelbrot' _ _ 0                   = 0
mandelbrot' z c n | magnitude z > 2 = n
                  | otherwise       = mandelbrot' (z^3+c) c (n-1)

{- z = z^4 + c -}
mandelbrot'' :: (Num a1, Num (Complex a), RealFloat a) =>
                Complex a -> Complex a -> a1 -> a1
mandelbrot'' _  _ 0                  = 0
mandelbrot'' z c n | magnitude z > 2 = n
                   | otherwise       = mandelbrot'' (z^4+c) c (n-1)

{- z = z'^2 + c -}
mandelbrot''' :: (Num a1, Num (Complex a), RealFloat a) =>
                 Complex a -> Complex a -> a1 -> a1
mandelbrot''' _ _ 0   = 0
mandelbrot''' z c n
    | magnitude z > 2 = n
    | otherwise       = mandelbrot''' ((conjugate z)^2 + c) c (n-1)

パラメータで渡せるようにした方が良いのかな? まあいいか.

Gtk2Hs

HaskellGUIライブラリはWxHaskellとこのGtk2Hsが代表格のようだ.GTK+は何度か使ったことがあるのでGtk2Hsを使うことにする.

Gtk2Hsのホームページを見るとCairoで簡単にお絵かきができることがわかった.CairoGhci.hsを落としてghciで利用すれば,

run $ moveTo 200 200 >> setLineWidth 20 >> curveTo 200 0 100 200 0 0 >> stroke

とするだけで絵が描ける.

コードを見てみると,moveToやstrokeなどの各コマンドはRenderというモナドとして実装されているようで,>>とか>>=で結合したものをrunする*1ことでI/O処理される.うーん,良くできているもんだ.

HaskellでGlade

CairoGhci.hsは簡単にするためにウィンドウではなくダイアログボックスを使っている.これではまともなアプリケーションぽくないので,Gladeを使って書き直す.GladeかGazpachoでGladeファイルを作って,サンプルに倣って次のように読み込む.

run :: Render () -> IO ()
run action = do
  initGUI
  xmlM <- xmlNew "Canvas.glade"
  let xml = case xmlM of
              (Just xml) -> xml
              Nothing    -> error "can't find the glade file \"Canvas.glade\" in the current directory."
  window <- xmlGetWidget xml castToWindow "window1"
  window `windowSetTitle` "Test"
  window `onDestroy` mainQuit
  canvas <- xmlGetWidget xml castToDrawingArea "drawingarea1"
  canvas `onSizeRequest` return (Requisition 500 500)
  canvas `onExpose` updateCanvas canvas action
  button <- xmlGetWidget xml castToButton "button1"
  button `onClicked` mainQuit
  widgetShowAll window
  mainGUI

これで土台も完成.runの引数actionにコマンドを並べるだけでお絵かきが簡単にできる.

GDKをCairoのように

しかし,Cairoはベクターグラフィックス用のライブラリなので,今回のようなマンデルブロ集合を表示するには向かない*2GTK+ではラスタグラフィックス用にGDKが用意されているのでこちらを使うことにする.

と,ここで問題発生.GDKのライブラリGraphics.UI.Gtk.GdkはCairoと違ってRenderモナドではなく,素のIOモナドとなっていて,各関数でウィンドウとグラフィックコンテキストを引きずり回す必要がある.デモプログラム集Cairo版Gdk版を見比べれば一目瞭然.

Cairoでは

updateCanvas canvas text (Expose { eventArea=rect }) = do
  win <- drawingAreaGetDrawWindow canvas
  (width',height') <- drawingAreaGetSize canvas
  let width  = realToFrac width'
      height = realToFrac height'

  -- Draw using the cairo api
  renderWithDrawable win $ do
    setSourceRGB 1 0 0
    setLineWidth 20
    setLineCap LineCapRound
    setLineJoin LineJoinRound

    moveTo 30 30
    lineTo (width-30) (height-30)
    lineTo (width-30) 30
    lineTo 30 (height-30)
    stroke

となっていたものがGdkでは

updateCanvas :: DrawingArea -> PangoLayout -> Event -> IO Bool
updateCanvas canvas text (Expose { eventArea=rect }) = do
  win <- drawingAreaGetDrawWindow canvas
  (width,height) <- drawingAreaGetSize canvas
  gc <- gcNew win
  gcSetValues gc $ newGCValues {
    foreground = Color 65535 0 0,
    capStyle = CapRound,
    lineWidth  = 20,
    joinStyle = JoinRound
  }
  drawLines win gc [(30,30),(width-30,height-30),(width-30,30),(30,height-30)]
  ...

となり,コマンドごとにwinとgcを引きずってしまっている.このため先ほどのCairoGhci.hsのReaderモナドのように描画コマンドの柔軟な結合ができない.さてどうしよう.

Gtk2Hsのアーカイブ内のCairoのところモナドのすべてをみるとこういうときはReaderモナドを使ってwinとgcを暗に持って回るのが定石らしい.

すでにIOモナドであるGdkの関数をReaderモナドと合成してCairoと同じくRenderモナドにしたい.まずはGdkとRenderを宣言する.

data Gdk = Gdk { window :: G.DrawWindow, gc :: G.GC }
newtype Render m = Render { runRender :: ReaderT Gdk IO m }
    deriving (Functor, Monad, MonadIO, MonadReader Gdk)

Renderはとてもややこしい.Cairo用のファイルからそのまま取ってきた.正直Functorとかいろいろよくわからない.

で,次にIOモナドとReaderモナドを合成するためにliftIOを使って各種の関数を定義する.

drawPoint :: Int -> Int -> Render ()
drawPoint x y = do
  w <- asks window
  gc <- asks gc
  liftIO $ G.drawPoint w gc (x,y)

drawSquare :: Bool -> Int -> Int -> Int -> Int -> Render ()
drawSquare fill px py qx qy = do
  w <- asks window
  gc <- asks gc
  liftIO $ G.drawRectangle w gc fill px py qx qy 

こんな感じでGDKもCairoと同じように各コマンドを自由に結合できるようになる.

mainなど

今まで作ったものをモジュールにして,まずいところをアドホックにちょこちょこ直してmainに取りかかる.mainではrunとdrawMandelbrot以外は呼びたくない.できたものは以下の通り.

main :: IO ()
main = run (600,600) $ drawMandelbrot 100 600

drawMandelbrot :: Int -> Int -> Painter
drawMandelbrot times size = do
  mapM_ draw $ assocs $ mandelbrotArray times size
    where draw :: ((Int,Int),Int) -> Painter
          draw ((x,y),n) | n == 0    = drawPointWithColor p (0,0,0)
                         | otherwise = drawPointWithColor p (0xffff,0xffff,0xffff)
            where p = (x+300,y+300)

runの第一引数とか各所のマジックナンバーがイヤン.あとで直す.

マルチスレッド

動かしてみるとわかるが,この計算は非常に重い.このため,図の表示が終わるまで閉じるボタンも表示されないし,ウィンドウが固まってしまう.そこでFAQサンプルを参考にしてforkIOをぶち込んだ.ちなみにネイティブスレッドのforkOSを使うと

The program 'mandelbrot' received an X Window System error.
This probably reflects a bug in the program.
The error was 'BadLength (poly request too large or internal Xlib length erro'.
  (Details: serial 16261 error_code 16 request_code 32 minor_code 0)
  (Note to programmers: normally, X errors are reported asynchronously;
   that is, you will receive the error a while after causing it.
   To debug your program, run it with the --sync command line
   option to change this behavior. You can then get a meaningful
   backtrace from your debugger if you break on the gdk_x_error() function.)

というメッセージを残しお亡くなりになる.

できあがり


ということでできたコードをmaoeのページに置いておく.実行には

  • GHC
  • Gtk2Hs (Gladeを有効にしたもの)

が必要.

今後手をつけたいのは

  • 遅い.assocsのせい? 並列処理できないの? とにかくもう少し早くしたい.
  • アドホックな修正を綺麗に直したい.
  • 白黒じゃなくてカラフルにしたいよね.
  • せっかくフラクタル図形なのに拡大できないのはちょっとね.

などなど.

追加ギャラリー



*1:内部ではrenderWithDrawableが呼ばれている.

*2:マンデルブロ集合の表示は座標の各点について計算し,ラスタ画像を出力するため.