はてな使ったら負けだと思っている deriving Haskell

Stern-Brocot 木 を Haskell + Graphviz で

Graphviz, 数学, アルゴリズム | 20:34 |

個人的に今週は 世界 Graphviz 週間 なので、Haskell で試してみた。

題材は Stern-Brocot 木。元ネタは結城さんの 既約分数クイズ。[0,1]の有理数を既約分数で全て列挙するアルゴリズム。

まずGraphviz化とか考えずに書いてみたコードが以下。

data Frac = Int :%: Int
instance Show Frac where
  show (a :%: b) = show a ++ "/" ++ show b

(.+.) :: Frac -> Frac -> Frac
(a :%: b) .+. (c :%: d) = (a+c) :%: (b+d)

sternize (x:y:xs) = x:(x .+. y):sternize(y:xs)
sternize xs = xs

stern = iterate sternize [ 0 :%: 1, 1 :%: 1 ]

ちょっと欲が出て型とか定義してみた。演算子とか

まあ素直にタプル使えば当然もっっっと短かくなるだろうけど。

で、Graphviz 版。動作には fgl パッケージ のインストールが必要。

module Main where
import Control.Monad.State
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.NodeMap
import Data.Graph.Inductive.Graphviz
import Data.Graph.Inductive.Tree
import Data.List (sort)

import System.Environment (getArgs)
import System.Process
import System.IO


type MyGraph = Gr Frac ()

data Frac = Int :%: Int deriving Eq
instance Ord Frac where
  (a1:%:a2) <= (b1:%:b2) =  (a1*b2) <=  (b1*a2)

instance Show Frac where
  show (a :%: b) = show a ++ "/" ++ show b

(.+.) :: Frac -> Frac -> Frac
(a :%: b) .+. (c :%: d) = (a+c) :%: (b+d)

seed :: MyGraph
seed = mkGraph (zip [0..] [0 :%: 1, 1 :%: 1]) []

stern :: NodeMapM Frac () Gr MyGraph
stern = do  (_, gr) <- get
            sub $ sort $ map snd $ labNodes gr
            return gr
  where sub t@(x:y:xs) = do
          (d,n) <- insMapNodeM (x .+. y)
          insMapEdgesM [(x, n, ()), (y, n, ())]
          sub (y:xs)
        sub xs = return ()

toDot gr = graphviz gr "SternBrocotTree" (0,0) (0,0) Portrait

main = do args <- getArgs
          case args of
            (n:_) -> let src = toDot $ iterate (flip run_ stern) seed !! (read n)
                      in putStr src
            _     -> putStrLn "usage: stern [STEP] | dot -T[fmt] > file.fmt"

実行例。

./stern 4 | dot -Tjpg > stern5.jpg

で、こんなんが出来る。

欲を云えば、上の(0/0)と(1/1)は左右の端の方にレイアウトして左から右に小→大の順番に並んでる様にできたらよかったんだけど、まあ、そこは自動生成だし……と云うことで。

暇があったら調節してみる。

パイプつかわないでやるには main を下記に書き換えれば良い(フォーマットはjpg決め打ちになっちゃうけど)。

main = do args <- getArgs
          case args of
            (r:_) -> do let n = read r
                            src = toDot $ iterate (flip run_ stern) seed !! n
                        (din,dout,_,_) <- runInteractiveCommand "dot -Tjpg"
                        hPutStr din src
                        hClose din
                        jpg <- hGetContents dout
                        writeFile ("stern"++show n++".jpg") jpg
            _     -> putStrLn "usage: stern [STEP]"

これであとは

./stern 4

とやると stern4.jpg ができてるはず。

Haskell から GraphViz の使い方はちょっと癖があるけど、まあその解説は今度と云うことで……。

ところで、GraphViz で 分数を"1/2" じゃなくて "" みたいにちゃんとした数式っぽくタイプセットするにはどうすればいいんだろう？

ツイートする