Merry Christmas!

この記事はPerl6 Advent Calender 2011、25日目の記事です。


ようやくここまで続いてきたAdvent Calendarも今日で終わりです。最終日は、今まで解説してきた文法を使って適当なプログラムを書いてみます。


(某学類誌に掲載した記事とあんまり変わらない内容です、そちらを先に読まれた方にはごめんなさい)

目標

次の仕様を満たすGraphクラスの実装を目指します。

  • 関数を渡して、そのグラフをビットマップで出力する
    • 実数を1つ渡して、実数が返ってくる関数(例: y = sin(x))
    • 実数を2つ渡して、真理値が返ってくる関数(例: x**2 + y**2 < 1)
  • 関数に定義域を指定できるようにする

Bitmapへの出力は拙作のBitmapクラスを継承します。用意されている機能は以下の通り。

method new (Int $width where { $_ > 0 } , Int $height where { $_ != 0 })
# コンストラクタ。引数には出力する画像のピクセル数を指定

method write (Str $file)
# 引数のファイル名への書き出し

method getpixel (Int $x where { 0 <= $_ < $!header.width },
  	 	   Int $y where { 0 <= $_ < $!header.height.abs })
# 指定した座標の色情報を取得

method setpixel (Int $x where { 0 <= $_ < $!header.width },
  	 	   Int $y where { 0 <= $_ < $!header.height.abs },
                   Int $b where { $_ ~~ 0..255 } , Int $g where { $_ ~~ 0..255 }, Int $r where { $_ ~~ 0..255 })
# 指定した座標の色情報を設定

method fill (Int $b where { $_ ~~ 0..255 }, Int $g where { $_ ~~ 0..255 }, Int $r where { $_ ~~ 0..255 }) 
# 画像全体を指定した色で塗りつぶす

実装

属性

まず描画する関数を保持する配列を用意する必要があります。また、描画する範囲を設定するための変数も用意しましょう。

has Code @.funcs
# 設定された関数を保持

has $.x_limit is rw = 1
has $.y_limit is rw = 1
# 画像端の座標を保持
# デフォルト値は1
関数の設定

描画する関数を受け取って格納するためのメソッドです。


このプログラムは二次元のグラフしか対象としないので、設定する関数が受け取る引数の数を1つ、または2つに制約します。関数オブジェクトの引数の個数を取得するにはarityメソッドを使います。

method set_func (Code $f where { $_.arity == 1|2 }) {
    @!funcs.push($f);
}
関数の描画

グラフの前に、座標軸を描画したい気がするので、オプションで動作を変えられる様にしましょう。この関数では画像を白で塗りつぶすだけで、実際の処理は別の関数でやります。

method draw (:$axis?) {
    self.fill(255,255,255);

    if $axis {
        self.draw_axis;
    }

    for @!funcs {
        self.calc($_);
    }
}

とりあえず軸の描画の部分はこんな感じで。高さと幅の中間を取って、ピクセルのデータを上書きしていきます。

method draw_axis {
    my $center_x = ($!header.width / 2).Int;
    my $center_y = ($!header.height / 2).Int;

    for ^$!header.height {
        self.setpixel($center_x, $_, 128, 128, 128);
        # グラフと被ると見辛いので灰色
    }

    for ^$!header.width {
        self.setpixel($_, $center_y, 128, 128, 128);
    }
}

次は実際の描画部分です。引数が1つの関数と2つの関数で処理を分けたいので、multi methodを使います。まずは1つの引数を取る方から。


コード中のコメントにある通り、座標を計算して関数に渡すという素直な実装になっています。この関数のキモはCATCHを使った例外処理で、描画した関数にwhereで定義域が設定してある場合、その外での呼び出しは例外が発生しますが、それを無視して次の座標に進むようになっています。

multi method calc (Code $f where { $_.arity == 1}) {
    my @val;
    my $width = $!header.width;
    my $height = $!header.height;

    for ^$width {
        my $x = -$!x_limit + (1 / ($width) * 2 * $!x_limit) * $_;
	# 画像上の座標をグラフ上の座標に変換

        @val = ($f($x.Num)).list;
	# x座標を関数に渡してy座標を計算

	CATCH { next; }
	# 定義域外での呼び出しエラーをキャッチ

        for @val -> $y {
            my $h = ($height / 2 + ($y * $height / (2 * $!y_limit))).Int;
            self.setpixel($_, $h, 0, 0, 0) if 0 <= $h < $height;
	    # y座標が画像の中に入っていればsetpixelに渡す
        }
    }
}

2引数の関数は、x座標とy座標を渡した時に条件を満たすかどうかを返すものとします。画像上の座標とグラフ上の座標がきちんと対応しないため、線のグラフは殆ど描けませんが、「範囲に入るかどうか」という関数だと大体綺麗に描けます。

multi method calc (Code $f where { $_.arity == 2 }) {
    my $width = $!header.width;
    my $height = $!header.height;

    for ^$width -> $w {
        my $x = -$!x_limit + (1 / ($width) * 2 * $!x_limit) * $w;

        for ^$height -> $h {
            my $y = -$!y_limit + (1 / ($height) * 2 * $!y_limit) * $h;
             self.setpixel($h, $w, 0, 0, 0) if $f($x, $y);

            CATCH { next; }
        }
    }
}
ソースコードまとめ

今まで書いてきたメソッドを纏めると、こんな感じになります。

use v6;
use Bitmap;

class Graph is Bitmap {

    has Code @.funcs;
    has Header $.header;
    has $.x_limit is rw = 1;
    has $.y_limit is rw = 1;

    method set_func (Code $f where { $_.arity == 1|2 }) {
        @!funcs.push($f);
    }

    method draw (:$axis?) {

        self.fill(255,255,255);

        if $axis {
            self.draw_axis;
        }

        for @!funcs {
            self.calc($_);
        }
    }

    method draw_axis {
        my $center_x = ($!header.width / 2).Int;
        my $center_y = ($!header.height / 2).Int;

        for ^$!header.height {
            self.setpixel($center_x, $_, 128, 128, 128);
        }

        for ^$!header.width {
            self.setpixel($_, $center_y, 128, 128, 128);
        }
    }

    multi method calc (Code $f where { $_.arity == 1}) {
        my @val;
        my $width = $!header.width;
        my $height = $!header.height;

        for ^$width {
            my $x = -$!x_limit + (1 / ($width) * 2 * $!x_limit) * $_;
            # 画像上の座標をグラフ上の座標に変換

            @val = ($f($x.Num)).list;
            # x座標を関数に渡してy座標を計算

            CATCH { next; }
            # 定義域外での呼び出しエラーをキャッチ

            for @val -> $y {
                my $h = ($height / 2 + ($y * $height / (2 * $!y_limit))).Int;
                self.setpixel($_, $h, 0, 0, 0) if 0 <= $h < $height;
                # y座標が画像の中に入っていればsetpixelに渡す
            }
        }
    }

    multi method calc (Code $f where { $_.arity == 2 }) {
        my $width = $!header.width;
        my $height = $!header.height;

        for ^$width -> $w {
            my $x = -$!x_limit + (1 / ($width) * 2 * $!x_limit) * $w;

            for ^$height -> $h {
                my $y = -$!y_limit + (1 / ($height) * 2 * $!y_limit) * $h;
                self.setpixel($h, $w, 0, 0, 0) if $f($x, $y);

                CATCH { next; }
            }
        }
    }

}

newメソッドなんかはBitmapクラスのをそのまま流用してますので、そちらをご覧ください。

使ってみる

newに画像のサイズを渡した後は、set_funcで関数を設定します。drawで描画を実行して、writeにファイル名を指定して書き出しですね。

  • 1引数の場合
my $g = Graph.new(200,200);
$g.set_func: *.sin;
$g.x_limit = 2;
$g.y_limit = 2;
$g.draw(:axis).Str;
$g.write("graph.bmp");


  • 2引数の場合
my $g = Graph.new(200,200);
$g.set_func: do -> $x, $y { $x ** 2 + $y ** 2 < 0.3 };
$g.x_limit = 2;
$g.y_limit = 2;
$g.draw(:axis).Str;
$g.write("graph.bmp");

どちらも上手く動いているようです。

まとめ

さて、ようやく12月のカレンダーに全て穴があきました。人数の少ない中、この無茶な企画に付き合って頂いたyoshimuraくん、uasiさん、ぜっぱちさん、risouさん、そして(居るか判らないけど)読んで頂いた読者の皆さん、本当にありがとうございました。特にuasiさんには私の記事の中で間違っている箇所を幾つも指摘して頂き、とても助かりました。重ねて感謝を。


このAdvent CalendarでPerl6に興味を持ってくれた方が1人でも居れば、無理言って立ち上げた甲斐があったかと思います。
Perl6の世界はまだ始まったばかりです。これから開発が進めば、もっと素敵で刺激的な大地が待っている事でしょう。まだ見ぬPerl6の魅力、これからも一緒に見届けて行きませんか?


Merry Christmas for all Perl6 Mongers!!

おまけ

今年もPerl6のコーディングコンテストが行われるようです。優勝者には100ユーロ相当の書籍が贈られるようですので、皆さん奮って参加しましょう!