2008-09-27

CSS::Tiny::Styleについて

perl

CSS::Tiny::Styleについて、下記の問題にぶち当たった。

capnモジュールでインストールする際、Test::Perl::Criticの検査に引っかかる
属性名や擬似クラス名にハイフンやアンダースコアが入ると、きちんとパースされない

これらについて少し調べた。

Test::Perl::Criticに引っかかる件

エラーで指示されていた箇所のソースを見てみた。
まず三行目。

#Code before strictures are enabled at line 3, column 14. See page 429 of PBP. (Severity: 5)
package CSS::Tiny::Style;

use version; $VERSION = qv('0.0.3'); # 3行目

use warnings;
use strict;
use Carp;

このエラーメッセージが怒っているのは、strictプラグマの前にコードがあること。したがって、strictプラグマがuseされた後にコードを持っていくと、エラーメッセージが出なくなる。しかし、$VERSIONは、スコープの宣言がされてないのでstrictプラグマに引っかかる。versionモジュールの「BEST PRACTICES」を見るとour宣言してるのでそれに従う。

use warnings;
use strict;
use version; our $VERSION = qv('0.0.3');

もう一つのエラー。

# Stricture disabled at line 138, column 5.  See page 429 of PBP.  (Severity: 5)
no strict 'refs';

PBPでは、no strictは許していないみたい。CSS::Tiny::Styleでは、下記のように関数を呼び出したいからno strictしている。

    for (qw/tag id class/) {
        my $sub = "_$_";

        next unless (my $val = &$sub($sel));  # strict 'ref'では禁止されている関数呼び出し

これをやらなければno strictする必要はなくなる。もし面倒だったりどうしても必要な場合は、下記のように記述すれば、Test::Perl::Criticの検査の対象とならなくなる。

 no strict 'refs'; ## no critic

以上の対処で、Test::Perl::Criticの検査に通るかどうかを下記のプログラムを書いて確かめた。

#!/usr/bin/perl
use strict;
use Test::More;

eval { require Test::Perl::Critic; Test::Perl::Critic->import(-profile => 't/perlcriticrc') };
plan skip_all => "Test::Perl::Critic is not installed." if $@;
all_critic_ok("CSS/Tiny/");

okもらった。

1..1
ok 1 - Test::Perl::Critic for "CSS/Tiny/Style.pm"

きちんとパースされない件

セレクタにアンダースコアやハイフンが入ると、
CSS::Tiny::Styleの_sel_arrメソッドの下記の部分で無限ループが起こる。

    while ($_) {
        my ($tag, $op);


        s/([a-zA-Z0-9.\#\*]+)\s*$//; $tag = $1;
        $op  = $1 if (s/(\s*[+>]*\s*)$//);


        push @d, $tag if $tag;

        for ($op) {
            /\+/    && do { push @d, 'left';    last; };
            /\>/    && do { push @d, 'parent';  last; };
            /^\s+$/ && do { push @d, 'lineage'; last; };
        }
    }

「s/([a-zA-Z0-9.\#\*]+)\s*$//;」の部分で、ハイフンとアンダースコアがマッチしないようになっている。マッチしたものは削除していき、$_が空になったらループを抜け出すようになっているので、無限ループになる。例えば「hato_uhouho」というセレクタがあったら「hato」だけがマッチし、2回目以降のループでは、$_の値は「_uhouho」になるので、ずっとマッチしない。
ということで、単純にハイフンとアンダースコアにマッチするように下記のように書き換えた。

s/([a-zA-Z0-9.\#\*_-]+)\s*$//; $tag = $1;

これで一応、無限ループは回避された。
しかし、ちゃんと動くかどうかはまだ確認していない。
もう少し、CSS::Tinyを細かく読んでことにする。

2008-09-27

DoCoMoCSSモジュールのインストールメモ

perl

DoCoMoCSSモジュールは「cpan DoCoMoCSS」の一発でインストールできなかった。
このモジュールをインストールする前に下記のモジュールをインストールする必要があった。

HTML::Element
CSS::Tiny::Style

HTML::Elementはcpanコマンドで簡単に入るが、CSS::Tiny::Styleはcpanコマンドでは入らなかった。
まずTest::Perl::Criticが入っていないとエラーが出る。
Test::Perl::Criticは、対象としているperlプログラムがPBPに準拠しているかどうかを検査するモジュールである。
このモジュールをインストールして、再びcpanでCSS::Tiny::Styleをインストールすると、Test::Perl::Criticの検査に引っかかって、エラーが出る。
Test::Perl::Criticのエラーメッセージは下記の通り。

Code before strictures are enabled at line 3, column 14. See page 429 of PBP. (Severity: 5)
Stricture disabled at line 136, column 5. See page 429 of PBP. (Severity: 5)

エラーが出ている箇所については、下記の本の429ページを見れ、と出ている。

Perlベストプラクティス

作者: Damian Conway,クイープ
出版社/メーカー: オライリー・ジャパン
発売日: 2006/08/24
メディア: 大型本
購入: 11人クリック: 153回
この商品を含むブログ (155件) を見る

この本を持っていないので確認できず。
cpanからだと、この検査に引っかかってしまうので、
普通にソース取ってきてコンパイルしてインストールした。
この時点で、「cpan DoCoMoCSS」でDoCoMoCSSモジュールがインストールできた。

2008-08-11

MapReduce::Lite Part.2

MapReduce Moose

前回

うお、リンク貼ると自動的にトラックバックを送信するようになってたのか。恐れ多い事してもうた。

mapreduce

mapreduceメソッドの中では、do_map,do_reduceが順に呼び出されている。

do_map( $spec );
do_reduce( $spec );

これらのメソッドを順に見ていく。

do_map

MapReduce::Liteでは、分散処理を実際に行なうのではなく、スレッドでシミュレーションしている。do_mapでは、まずスレッド間で共用するキューを次のようにして生成する。

my $quere = Thread::Queue::Any->new;

このキューには、ファイルの一行一行が格納されていく。実際のコードは以下のようになっている。

for my $in (@{$spec->inputs}) {
   my $iter = $in->iterator;
   while ( $iter->has_next ) {
      $queue->enqueue([ $in->file => $iter->next ]);
   }

$in->iteratorは、MapReduce::Lite::FileIteratorを生成して、そのリファレンスを返す。MapReduce::Lite::FileIteratorでは、has_nextとnextを定義している。has_nextは、ハンドルがEOFを指しているかどうかで真偽を返している。

sub has_next {
   shift->handle->eof ? 0 : 1;
}

nextは、ファイルの一行を読み込んで、改行を取り除いたものを返す。

sub next {
   my $line = shift->handle->getline;
   chomp $line;
   $line;
}

キューには、<ファイル名,一行のデータ>の形式でエンキューされていく。

$queue->enqueue([ $in->file => $iter->next ]);

ここに入ったデータが複数のスレッドに取り出されていき、処理される。
mapperには、シャッフル時に使用するReducerの数がセットされる。

$in->mapper->num_reducers( $spec->out->num_tasks );

$spec->out->num_tasksには、mainパッケージで3にセットされている。次にスレッドが起動されていく。

for (my $i = 0; $i < $spec->num_threads; $i++) {
   threads->create(map_thread => $queue, $in->mapper);
}
$_->join for threads->list;

スレッドは、$spec->num_threads個だけ起動する。このサンプルコードでは、特に設定されていないので、デフォルトの５になっている。
スレッド起動時には、エントリポイントとしてmap_threadメソッドが指定される。引数は($queue, $in->mapper)となっている。
map_threadでは、$queueからデータを取り出し、mapper(Analog::Mapper)にデータを渡している。これは各スレッドで、キューが空になるまで繰り返される。

while(my $left = $queue->pending) {
   my ($task) = $queue->dequeue;
   $mapper->map(@$task);
}

キューが空になるとそれぞれのスレッドで、$mapper->doneが呼び出されてファイルがクローズされる。
呼び出し元(do_map)では

$_->join for threads->list;

で、スレッドがすべて終了するまで待機している。mapの出力結果は「./tmp」に「R(id).dat」の形で一時的に保存される。

do_reduce

do_reduceでは、まずmapの出力ファイルを読み込む。出力ファイルの読み込みは、MapReduce::Lite::Conduitを用いて行なわれる。

my $conduit = MapReduce::Lite::Conduit->new(
   intermidate_dir => $spec->intermidate_dir,
);
$conduit->consume($r);

consumeメソッドで実際にファイル読み込みを行なっている。以下は、渡されたグループidを元に、対応しているファイルをオープンしている部分になる。

sub consume {
   my ($self, $id) = validate_pos(@_, 1, { type => SCALAR });
  
   my $file = $self->intermidate_dir->file(sprintf "R%d.dat", $id);
   my $handle = $file->open('r') or return;

オープンされたファイルのハンドルは、MapReduce::Lite::FileIteratorに渡されて、このパッケージを介してファイルの中身を読み込まれる。

my $iter = MapReduce::Lite::FileIterator->new(handle => $handle);
while ($iter->has_next) {
   $self->csv->parse( $iter->next );
   $self->put( $self->csv->fields );
}

データは、%MapReduce::Lite::FileIterator::dataに読み込まれる。読み込みが終了すると、一時ファイルは削除される。

$file->remove or die "Can't remove %s: %s", $file, $!;

do_reduceでは、ここで読み込まれたデータが、スレッド間共用のキューに格納される。

my $queue = Thread::Queue::Any->new;
my $iter = $conduit->iterator;
while( $iter->has_next ) {
   $queue->enqueue([ $iter->next ]);
}

そして、mapのときと同じようにスレッドが起動されてReduceが行なわれる。

for(my $i = 0; $i < $spec->num_threads; $i++) {
   threads->create(reduce_thread => $queue, $spec->out->reducer);
}

sub reduce_thread {
   my ($queue, $reducer) = validate_pos(@_, 1, 1);

   while (my $left = $queue->pending) {
       my ($task) = $queue->dequeue;
       $reducer->reduce(@$task);
   }
}

以上がMapReduce::Liteの流れ。

参考文献

伊藤直也 "Recent Perl World: 第14回「Hi, Moose!! モダンなオブジェクトシステムを実現する」" Web+DB press vol.45
伊藤直也 "Recent Perl World: 第11回「Perlでマルチスレッドプログラミング」" Web+DB press vol.42
http://perldoc.jp/docs/perl/5.8.3/threads.pod
http://perldoc.perl.org/Thread/Queue.html

2008-08-10

MapReduce::Lite

MapReduce Moose

id:naoyaさんが書いたMapReduce::Liteのコードを読んでみた。
http://d.hatena.ne.jp/naoya/20080511/1210506301
このエントリーにあるapacheのアクセスログを解析するサンプルコードを辿っていく。

MapReduce::Lite

mainパッケージから辿っていく。まずはシミュレーションの設定をしていく記述がある。

my $spec = MapReduce::Lite::Spec->new(intermidate_dir => "./tmp");

ここで、オブジェクト生成時に値を設定されているintermidate_dirは、以下のように定義されている。

has intermidate_dir => (
   is => 'rw',
   does => 'Directory',
   coerce => 1,
   required => 1,
);

この値に付いて、強制方変換の設定が「MapReduce::Lite::Types」の中に書かれている。

subtype 'Directory'
   => as 'Object'
   => where { $_->isa('Path::Class::Dir') };

これによってObject型の下位の型として新しくFileという型を作った。File型かどうかのチェック条件は「where { $_->isa('Path::Class::Dir') }」で定義される。次に

coerce 'File'
   => from 'Str'
   => via { Path::Class::File->new($_);

これにより文字列が渡されたときにPath::Class::Fileに変換するという設定をしている。
つまりintermidate_dirに文字列を渡すと、内部で文字列からPath::Class::File型に変換されてintermidate_dirに格納されるということになる。ここでintermidate_dirに設定されるパスは、Mapの結果である中間ファイルを置くディレクトリをどこにするかを指しているものになる。
次にcreate_inputメソッドで、一つの解析対象ファイルに対して「MapReduce::Lite::Spec::Input」を生成する。create_inputメソッドのコードは以下のようになっている。

sub create_input  {
   my $self = shift;
   my $in = MapReduce::Lite::Spec::Input->new(
      intermidate_dir => $self->intermidate_dir
   );
   $self->inputs->push($in);
   return $in;
}

一つの解析対象ファイルに対して「MapReduce::Lite::Spec::Input」を生成して、そのリファレンスをinputsに格納している。生成したオブジェクトのリファレンスを返して、呼び出し元(つまりmainパッケージ内)で、解析対象ファイルのパスとMapを設定している。

for (@ARGV) {
   my $in = $spec->create_input;
   $in->file($_);
   $in->mapper('Analog::Mapper');
}

fileは、intermidate_dirと同じように強制型変換が行なわれている。mapperではmapとしてAnalog::Mapperパッケージが指定されている。mapperにどのパッケージを渡すかによって、どういったmapを行なうかを指定できるようになっている。サンプルコードで指定されているAnalog::Mapperパッケージは、以下のようになっている。

package Analog::Mapper;
use Moose;
with 'MapReduce::Lite::Mapper';

sub map {
   my ($self, $key, $value) = @_;
   my @elements = split /\s+/, $value;
   if ($elements[8]) {
       $self->emit($elements[8], 1);
   }
}

Analog::Mapperは、MapReduce::Lite::Mapperを継承して、mapメソッドを定義している。Analog::Mapperのmapメソッドは、スペース区切りでくるデータを分割して、Apacheのステータスコードを取り出す処理を行なっている。取り出されたステータスコードは、

<ステータスコード,1>

という形でemitされる。emitメソッドは、次のようになっている。

sub emit {
   my ($self, $key, $value) = validate_pos(@_,1,1,1);
   my  $id = $self->partitioning_function->($key, $self->num_reducers);
   $self->intermidate_buffers($id)->put($key, $value);
}

３行目で用いられているpartioning_functionには、無名関数のコードリファレンスが格納されている。

has partitioning_function => (
   is => 'rw',
   isa => 'CodeRef',
   lazy => 1,
   default => sub {
      return sub {
         my ($key, $R) = @_;
         length($key) % $R;
      }
   }
}

この関数は「シャッフル」にあたる部分で、$keyの長さをnum_reducersで割った時の余りによってグルーピングしている。partioning_functionからは、グループのidが返され、idに対応するグループに<キー,値>が格納される。格納される際にintermidate_buffersメソッドが呼び出されるが、メソッドフックがかけられている。
intermidate_buffersが呼び出される前に以下のコードが呼び出される。

before 'intermidate_buffers' => sub {
   my ($self, $R) = validate_pos(@_, 1, { type => SCALAR } );
   unless ( $self->_files->[$R]) {
      my $file = $self->intermidate_dir->file( sprintf "$%d.dat", $R );
      my $handle = $file->open('>>');
         or confess sprintf "Can't create an intermidate file: %s", $!;
      $self->files->[$R] = MapReduce::Lite::Mapper::Out->new(
         handle => $handle,
         flash_size => 1024, # FIXME
      );
   }
};

グループ$Rに対応する一時ファイルがないとき、新しく作成するように処理している。intermidate_buffersは、Pass::Class::Fileの参照を返しているので、Rubyライクに連続でputメソッドを呼び出して、<キー,値>で記録している。
　
mainパッケージに戻る。
　
Mapの設定が終わったら今度はReduceの設定が行なわれる。

$spec->out->reducer('Analog::Reducer');

reducerにどのようなパッケージを指定するかによって、どういったReduceを行なうかを設定する事ができるようになっている。サンプルコードでは、Analog::Reducerパッケージが指定されている。Analog::Reducerパッケージは以下のようになっている。

package Analog::Reducer;
use Moose;
with 'MapReduce::Lite::Reducer';

sub reduce {
   my ($self, $key, $value) = @_;
   $self->emit($key, $value->size);
}

Analog::Reducerは「MapReduce::Lite::Reducer」を継承して、reduceメソッドを定義している。Analog::Reduceのreduceは、<キー,値の長さ(1の数)>をemitしている。「MapReduce::Lite::Reducer」のemitは、<キー,値>の形で渡ってきたものを

キー => 値

の形で出力するようになっている。

sub emit {
   my ($self, $key, $value) = validate_pos(@_, 1, 1, 1);
   printf "%s => %s\n", $key, $value;
}

MapReduce::Lite::ReducerはさらにMapReduce::Lite::Role::Emitterを継承している。このパッケージは、emitをインタフェースとしている抽象クラスになっている。
mainパッケージでは、この後

$spec->out->num_tasks(3);

で、何個のReduceを並列で実行するかを指定している。
以上でMapReduceのシミュレーション設定が完了した。$specを渡して次のようにMapReduceを実行する。

MapReduce($spec);

次回、MapReduceの中身について見ていく。

2008-08-09

シンボルテーブル

perl パッケージ

perlでは名前空間を「パッケージ」と呼ぶ。パッケージが基本ブロックとなり、この上にモジュールやクラスという上位概念が構築される。すべてのコードは特定のパッケージに属している。パッケージに属していないように見えるものも実は「mainパッケージ」に属している。下記のコードは「mainパッケージ」に属している。

#!/usr/bin/perl
use strict;
use warnings;

our $test;

print *test{PACKAGE} . "\n"; # main

package宣言以降のすべての識別子は、カレントパッケージに属するシンボルテーブルに登録される。シンボルテーブルの名前は

%パッケージ名:

となっている。シンボルの名前がキーとなっている。mainパッケージの場合のシンボルテーブルの名前は、

%main:
#または
%:

となる。

package MyTest;

our $test;

sub print {
   print "Test\n";
}

このコードでの「$test」と「sub print」は、シンボルテーブル「%MyTest:」に格納される（mainを省略せずに書くと「%main:MyTest:」となる）。
つまり「package」は、どのシンボルテーブルに所属するのかを宣言するために使用していると言える。従って、下記のように同じパッケージでもバラバラに書ける。

package MyTest;
our $test;
sub print {
   print "Test\n";
}

package MyTest2;
our $test2;


package MyTest;
our $test3;

mainシンボルテーブル

以下のものは、強制的にmainシンボルテーブルに格納される。

英文字以外の変数($!,?,_)
STDIN,STDOUT,STDERR,ARGV,ARGOUT,ENV,INC,SIG

下記のコードで、mainシンボルテーブルに格納されているシンボルを見てみた。

foreach my $key (sort keys %main::) {
    print "$key\n";
}

出力結果

ARNING_BITS
!
"
$
+
-
/
0
:
@
ARGV
BEGIN
CORE:
Carp:
DB:
DynaLoader:
ENV
Exporter:
INC
IO:
Internals:
PerlIO:
Regexp:
SIG
STDERR
STDIN
STDOUT
UNIVERSAL:
_
_

参考文献

[1]Larry Wall, Tom Christiansen, Jon Orwant "プログラミング Perl VOLUME 1 「10章パッケージ」"

2008-08-09

Strategyパターン

Moose

増補改訂版Java言語で学ぶデザインパターン入門

作者: 結城浩
出版社/メーカー: ソフトバンククリエイティブ
発売日: 2004/06/19
メディア: 大型本
購入: 51人クリック: 762回
この商品を含むブログ (397件) を見る

StrategyパターンのjavaサンプルコードをMooseで書いてみた。

サンプルは、じゃんけんの手を出す戦略をstrategyパターンで書いている。

まずHandクラス。

package Hand;
use Moose;
use MooseX::ClassAttribute;
use Jcode;

use constant {
    HANDVALUE_GUU => 0,
    HANDVALUE_CHO => 1,
    HANDVALUE_PAA => 2,
};

class_has hand => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub {
	return [
	    Hand->new( handvalue => HANDVALUE_GUU ),
	    Hand->new( handvalue => HANDVALUE_CHO ),
	    Hand->new( handvalue => HANDVALUE_PAA ),
	    ];
    }
    );

has name => (
    is => 'ro',
    isa => 'ArrayRef',
    default => sub {
	return [
	    'グー',
	    'チョキ',
	    'パー',
	    ];
    }
    );

has handvalue => (
    is => 'rw',
    isa => 'Int',
    required => 1,
    );

sub getHand {
    my $handvalue = shift;
    return __PACKAGE__->hand->[$handvalue];
}

sub isStrongerThan {
    my $self = shift;
    my $h = shift;

    return ($self->fight($h) == 1);
}

sub isWeakerThan {
    my $self = shift;
    my $h = shift;

    return ($self->fight($h) == -1);
}

sub fight {
    my $self = shift;
    my $h = shift;

    if ($self->{handvalue} == $h->{handvalue}) {
	return 0;
    } 
    elsif (($self->{handvalue} + 1) % 3 == $h->{handvalue}) {
	return 1;
    }
    else {
	return -1;
    }
}

sub toString {
    my $self = shift;
    return jcode($self->name->[$self->{handvalue}])->euc;
}

1;

ここでは「MooseX::ClassAttribute」を使って、下記のようにしてクラス変数を定義した。

class_has hand => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub {
	return [
	    Hand->new( handvalue => HANDVALUE_GUU ),
	    Hand->new( handvalue => HANDVALUE_CHO ),
	    Hand->new( handvalue => HANDVALUE_PAA ),
	    ];
    }
    );

次にStrategyインタフェースを定義し、これを継承した「WinningStrategy」と「ProbStrategy」を定義する。

package Strategy;
use Moose::Role;
use Hand;

requires qw/nextHand study/;

package WinningStrategy;
use Moose;
use Hand;
with 'Strategy';

has won => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has prevHand => (
    is => 'rw',
    isa => 'Object',
    );
 
sub nextHand {
    my $self = shift;

    if (!$self->{won}) {
	my $rand = int(rand 3);
	$self->{prevHand} = Hand::getHand($rand);

    }

    return $self->{prevHand};
}
    
sub study {
    my $self = shift;
    my $win = shift;

    $self->{won} = $win;
}

package ProbStrategy;
use Moose;
use Hand;
with Strategy;

has prevHandValue => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has currentHandValue => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has history => (
    is => 'rw',
    isa => 'ArrayRef',
    default => sub {
	return [
	    [ 1, 1, 1, ],
	    [ 1, 1, 1, ],
	    [ 1, 1, 1, ],
	    ];
    },
    );

sub nextHand {
    my $self = shift;
    
    my $bet = rand getSum($self,$self->currentHandValue);
    my $handvalue = 0;

    if ($bet < $self->history->[$self->currentHandValue]->[0]) {
	$handvalue = 0;
    }
    elsif ($bet < $self->history->[$self->currentHandValue]->[0] + $self->history->[$self->currentHandValue]->[1]) {
	$handvalue = 1;
    } 
    else {
	$handvalue = 2;
    }

    $self->{prevHandValue} = $self->{currentHandValue};
    $self->{currentHandValue} = $handvalue;
    return Hand::getHand($handvalue);
}

sub getSum {
    my $self = shift;
    my $hv = shift;

    my $sum = 0;
    for (my $i = 0; $i < 3; $i++) {
	$sum += $self->history->[$hv]->[$i];
    }
    
    return $sum;
}

sub study {
    my $self = shift;
    my $win = shift;

    if ($win) {
	$self->history->[$self->prevHandValue]->[$self->currentHandValue]++;
    } else {
	$self->history->[$self->prevHandValue]->[($self->currentHandValue + 1) % 3]++;
	$self->history->[$self->prevHandValue]->[($self->currentHandValue + 2) % 3]++;
    }
}
    
1;

WinningStrategyは、「勝ったときに出した手を、次にまた出す。勝てなかったら、次はランダムに手を出す」といった戦略になっている。
ProbStrategyは、「過去の勝ち負けの履歴を使って、それぞれの手を出す確率を変える」といった戦略になっている。

次にPlayerクラス。

package Player;
use Moose;
use Strategy;

has name => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

has strategy => (
    is => 'rw',
    isa => 'Object',
    required => 1,
    );

has wincount => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has losecount => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

has gamecount => (
    is => 'rw',
    isa => 'Int',
    default => 0,
    );

sub nextHand {
    my $self = shift;
    return $self->strategy->nextHand();
}

sub win {
    my $self = shift;

    $self->strategy->study(1);
    $self->{wincount}++;
    $self->{gamecount}++;
}

sub lose {
    my $self = shift;
    
    $self->strategy->study(0);
    $self->{losecount}++;
    $self->{gamecount}++;
}

sub even {
    my $self = shift;

    $self->{gamecount}++;
}

sub toString {
    my $self = shift;
    return '[' . $self->{name} . ':' . $self->{gamecount} . 'games, ' . $self->{wincount} . ' win, ' . $self->{losecount} . ' lose' . ']';
}

1;

Playerは、名前と戦略が渡されてインスタンスが生成される。このインスタンス生成時に戦略が切り替えられる。
以下が、実行プログラムと実行結果。

#!/usr/bin/perl
use strict;
use warnings;
use Player;
use Strategy;

my $player1 = Player->new( name => 'Taro', strategy => WinningStrategy->new);
my $player2 = Player->new( name => 'Hana', strategy => ProbStrategy->new);

for (my $i = 0; $i < 10000; $i++) {

    my $nextHand1 = $player1->nextHand();
    my $nextHand2 = $player2->nextHand();

    if ($nextHand1->isStrongerThan($nextHand2)) {
	print 'Winner:' . $player1->name . "\n";
	$player1->win();
	$player2->lose();
    } elsif ($nextHand2->isStrongerThan($nextHand1)) {
	print 'Winner:' . $player2->name . "\n";
	$player1->lose();
	$player2->win();
    } else {
	print "Even...\n";
	$player1->even();
	$player2->even();
    }

    print "Total result:\n";
    print $player1->toString() . "\n";
    print $player2->toString() . "\n";
}

exit;

〜略〜
Total result:
[Taro:9996games, 3091 win, 3494 lose]
[Hana:9996games, 3494 win, 3091 lose]
Winner:Hana
Total result:
[Taro:9997games, 3091 win, 3495 lose]
[Hana:9997games, 3495 win, 3091 lose]
Winner:Hana
Total result:
[Taro:9998games, 3091 win, 3496 lose]
[Hana:9998games, 3496 win, 3091 lose]
Winner:Hana
Total result:
[Taro:9999games, 3091 win, 3497 lose]
[Hana:9999games, 3497 win, 3091 lose]
Even...
Total result:
[Taro:10000games, 3091 win, 3497 lose]
[Hana:10000games, 3497 win, 3091 lose]

デザインパターンの概要

戦略ごとに「WinningStrategy」と「ProbStrategy」が定義された。これらのクラスは「Strategy」クラスを継承することで、インターフェースを統一された。例では「nextHand()」と「study()」がインタフェースだった。戦略クラスを利用する「Player」クラスは、

$strategy->nextHand();
$strategy->study();

で呼び出している。ここで「$strategy」に、「WinningStrategy」のインスタンスか「ProbStrategy」のインスタンスを入れることによって、じゃんけんの戦略が切り替えられるようになっている。

参考文献

結城浩 "増強改訂版 Java言語で学ぶデザインパターン入門"
伊藤直也 "Recent Perl World: 第14回「Hi, Moose!! モダンなオブジェクトシステムを実現する」" Web+DB press vol.45
hakobe "初めてのMoose" http://www.slideshare.net/hakobe/moose
"Perl オブジェクト指向プログラミング" http://www.slideshare.net/hakobe/moose
http://trac.mizzy.org/public/wiki/MooseXClassAttribute

2008-08-02

Template Method

Moose

増補改訂版Java言語で学ぶデザインパターン入門

作者: 結城浩
出版社/メーカー: ソフトバンククリエイティブ
発売日: 2004/06/19
メディア: 大型本
購入: 51人クリック: 762回
この商品を含むブログ (397件) を見る

perlのMooseとデザインパターンの勉強として、こちらの本の第三章「Template Method」に載っているサンプルプログラムをperlのMooseで書いてみた。

AbstractDisplayクラス

package AbstractDisplay;
use Moose::Role;
requires qw/open print close/;

sub display {
    my $self = shift;
    $self->open;
    for (1 .. 5) {
	$self->print;
    }
    $self->close;
}

AbstractDisplayクラスは、displayメソッドで、open,print,closeのそれぞれのメソッドの呼び出し方を定義している。open,print,closeメソッドの定義については、継承先に任せている。
Mooseで抽象クラスを作るには、

use Moose::Role;

と書き、packageを定義する。
抽象メソッドを指定するには、

requires qw/open print close/;

と書く。これにより、継承先ではopen,print,closeメソッドを定義するように強制できる。定義しないとコンパイルエラーになる。

CharDisplayクラスとStringDisplayクラス

AstractDisplayクラスを継承して、それぞれ違う動作をするCharDisplayクラスとStringDisplayクラスを定義する。まずはCharDisplayクラス。

package CharDisplay;
use Moose;
with 'AbstractDisplay';

has ch => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

sub open {
    print "<<";
}

sub print {
    my $self = shift;
    print $self->ch;
}

sub close {
    print ">>\n";
}


package main;

my $o_char = CharDisplay->new(ch => "t");
$o_char->display;

実行結果がこちら。

<>

AbstractDisplayクラスの継承は、

with 'AbstractDisplay';

という記述で行なう。
charDisplayクラスでは、ch属性をhasで定義している。

has ch => (
   is => 'rw', # この属性は読み書き機能
   isa => 'Str', # この属性に設定できる型はStr(文字列)だけである
   required => 1, # オブジェクト生成時に値をセットする必要がある
);

これは「アトリビュート(属性)コンストラクタ」と呼ばれ、属性について制限がかけられる。ここでは「required => 1」に指定されているので、オブジェクト生成時に

my $o_char = CharDisplay->new( ch => 't' );

と行った感じで、ch属性の値をセットしている。

次にStringDisplayクラスの実装。

package StringDisplay;
use Moose;
with 'AbstractDisplay';

has string => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

sub open {
    my $self = shift;
    $self->printLine();
}

sub print {
    my $self = shift;
    print '|' . $self->string . '|' . "\n";
}

sub close {
    my $self = shift;
    $self->printLine();
}

sub printLine {
    my $self = shift;
    
    my $width = length $self->string;

    print '+';
    for (1 .. $width) {
	print '-';
    }
    print "+\n";
}

package main;

my $o_string = StringDisplay->new(string => "hato test");
$o_string->display;

実行結果は、

+

hato test

hato test

hato test

hato test

hato test

+

以上。

デザインパターンを実装すると、なんか気持ちいいな。

参考文献

結城浩 "増強改訂版 Java言語で学ぶデザインパターン入門"
伊藤直也 "Recent Perl World: 第14回「Hi, Moose!! モダンなオブジェクトシステムを実現する」" Web+DB press vol.45