PerlでStrategyパターン! (デザインパターン)

Perl初心者のためのPerlノートです!

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ WEBリーダー/ 燈明日記/ yahoo

◆ はじめに

本ページは、私がPerlを習得した時(いや習得中)のノートです。

ごく普通の言語(COBOL,C,Java,VB等)を知っている人が、Perlをやり始めるといろいろと悩むことがあります。

それは、

です。

本ページは、そのようなハードルを一つ一つクリアにしていけたらと思います。

そして、本ページが何かのお役に立てれば幸いです。では、ごゆっくりご覧ください。

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくPerlノート掲示板へご指摘ください。

◆ サイト最新情報

◆ コンテンツ

2008-03-22 PerlでStrategyパターン! (デザインパターン)

Perlでデザインパターン 第10弾(Strategyパターン)

Strategyパターンとは、戦略(アルゴリズム)をごっそりと交換できるようなパターンです。

たとえば、メモリ実装状態により、「メモリを使うアルゴリズム」か「ディスクを使うアルゴリズム」かを動的に切り分ける時に有効ですね。


一般的なStrategyパターンのクラス図
    +-----------------+          +-----------------+
    | Context         |o-------->| Strategy        |
    +-----------------+          +-----------------+
    | strategy        |          |                 |
    +-----------------+          +-----------------+
    | contextMethod   |          | strategyMethod  |
    +-----------------+          +--------+--------+
                                          #            
                                          |            
                           +--------------+--------------+ 
                           |                             | 
                  +--------+--------+           +--------+--------+ 
                  |ConcreteStrategy1|           |ConcreteStrategy2| 
                  +-----------------+           +-----------------+ 
                  |                 |           |                 | 
                  +-----------------+           +-----------------+ 
                  |strategyMethod   |           |strategyMethod   | 
                  +-----------------+           +-----------------+ 

サンプル

一番下で紹介している本の『Java言語で学ぶデザインパターン入門』に書かれているStrategパターンのJavaでのサンプルをPerlで書き換えてみました。


サンプルのクラス図
    +-----------------+          +-----------------+
    | Player          |o-------->| Strategy        |
    +-----------------+          +-----------------+
    | strategy        |          |                 |
    +-----------------+          +-----------------+
    | nextHand        |          | nextHand        |
    | win             |          | study           |
    | lose            |          +--------+--------+
    | even            |                   #            
    +-----------------+                   |            
                           +--------------+--------------+ 
                           |                             | 
                  +--------+--------+           +--------+--------+ 
                  |WinningStrategy  |           |ProbStrategy     | 
                  +-----------------+           +-----------------+ 
                  |                 |           |                 | 
                  +-----------------+           +-----------------+ 
                  |nextHand         |           |nextHand         | 
                  |study            |           |study            | 
                  +-----------------+           +-----------------+ 
Hand.pm
package Hand;
use strict;
use warnings;
use constant  HANDVALUE_GUU => 0;
use constant  HANDVALUE_CHO => 1;
use constant  HANDVALUE_PAA => 2;

my $name;
my $hand;
sub new {
    my $class = shift;
    my $handvalue = shift;
    my $self = {};
    $self->{handvalue} = $handvalue;
    return bless $self, $class;
}
BEGIN {
    $name = ["グー", "チョキ", "パー"];
    $hand = [&new('Hand', HANDVALUE_GUU), &new('Hand', HANDVALUE_CHO), &new('Hand', HANDVALUE_PAA)];
}
sub getHand {
    my $self = shift;
    my $handvalue = shift;
    return $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 $name->[$self->{handvalue}];
}
1;
Strategy.pm
package Strategy;
use strict;
use warnings;

sub nexthand { die "オーバーライド必須"; }
sub study { die "オーバーライド必須"; }
1;
WinningStrategy.pm
package WinningStrategy;
use strict;
use warnings;
use base 'Strategy';
use Hand;

sub new {
    my $class = shift;
    my $self = {};
    my $seed = shift;
    srand $seed;
    $self->{won} = 0;
    $self->{prevHand} = '';
    return bless $self, $class;
}
sub nexthand {
    my $self = shift;
    if (!$self->{won}) {
        $self->{prevHand} = Hand->getHand(int(rand(3)));
    }
    return $self->{prevHand};
}
sub study {
    my $self = shift;
    my $win = shift;
    $self->{won} = $win;
}
1;
ProbStrategy.pm
package ProbStrategy;
use strict;
use warnings;
use base 'Strategy';
use Hand;

my $history;
BEGIN {
    $history = [
        [1,1,1],
        [1,1,1],
        [1,1,1],
    ];
}
sub new {
    my $class = shift;
    my $self = {};
    my $seed = shift;
    srand $seed;
    $self->{prevHandValue} = 0;
    $self->{currentHandValue} = 0;
    return bless $self, $class;
}
sub nexthand {
    my $self = shift;
    my $bet = int(rand($self->getsum($self->{currentHandValue})));
    my $handvalue = 0;
    if ($bet < $history->[$self->{currentHandValue}]->[0]) {
        $handvalue = 0;
    } 
    elsif ($bet < $history->[$self->{currentHandValue}]->[0]+$history->[$self->{currentHandValue}]->[1]) {
        $handvalue = 1;
    }
    else {
        $handvalue = 2;
    }
    $self->{prevHandValue} = $self->{currentHandValue};
    $self->{currentHandValue} = $handvalue;
    return Hand->getHand($handvalue);
}
sub study {
    my $self = shift;
    my $win = shift;
    if ($win) {
        $history->[$self->{prevHandValue}]->[$self->{currentHandValue}]++;
    }
    else {
        $history->[$self->{prevHandValue}]->[($self->{currentHandValue}+1)%3]++;
        $history->[$self->{prevHandValue}]->[($self->{currentHandValue}+2)%3]++;
    }
}
sub getsum {
    my $self = shift;
    my $hv = shift;
    my $sum = 0;
    for my $i (0..2) {
        $sum += $history->[$hv]->[$i];
    }
    return $sum;
}
1;
Player.pm
package Player;
use strict;
use warnings;

sub new {
    my $class = shift;
    my $self = {};
    $self->{name} = shift;
    $self->{strategy} = shift;
    $self->{wincount} = 0;
    $self->{losecount} = 0;
    $self->{gamecount} = 0;
    return bless $self, $class;
}
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;
Main.pl
use strict;
use warnings;
use Player;
use WinningStrategy;
use ProbStrategy;

my @args = @ARGV;
if ($#ARGV != 1) {
    print "Usage: perl Main.pl randomseed1 randomseed2\n";
    print "Example: perl Main.pl 314 15\n";
    exit(0);
}
my $player1 = Player->new("Taro",WinningStrategy->new($args[0]));
my $player2 = Player->new("Hana",ProbStrategy->new($args[1]));
my ($nextHand1, $nextHand2);
for my $i (0..19) {
    $nextHand1 = $player1->nexthand();
    $nextHand2 = $player2->nexthand();
    if ($nextHand1->isStrongerThan($nextHand2)) {
        print "Winner ".$player1->tostring, "\n";
        $player1->win();
        $player2->lose();
    } 
    elsif ($nextHand2->isStrongerThan($nextHand1)) {
        print "Winner ".$player2->tostring, "\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";
実行結果
C:\Documents and Settings\dp\Strategy>perl Main.pl 314 15
Even...
Winner [Taro:1 games, 0 win, 0 lose]
Even...
Winner [Taro:3 games, 1 win, 0 lose]
Even...
Even...
Even...
Winner [Taro:7 games, 2 win, 0 lose]
Winner [Taro:8 games, 3 win, 0 lose]
Even...
Winner [Hana:10 games, 0 win, 4 lose]
Winner [Taro:11 games, 4 win, 1 lose]
Even...
Even...
Winner [Hana:14 games, 1 win, 5 lose]
Winner [Hana:15 games, 2 win, 5 lose]
Winner [Taro:16 games, 5 win, 3 lose]
Winner [Hana:17 games, 3 win, 6 lose]
Even...
Winner [Taro:19 games, 6 win, 4 lose]
Total result:
[Taro:20 games, 7 win, 4 lose]
[Hana:20 games, 4 win, 7 lose]

尚、本コンテンツは、結城先生の以下の本をかなり参考にしています。

Javaでデザインパターンを勉強したい人には、お勧めのご著書です!

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

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

◆ おすすめ Perl本

■ 続・初めてのPerl 改訂版

『初めてのPerl』の次ぎに読むと吉です。

結構いいですが・・・、初心者にはちょっと難しいかもです。

■ 結城浩のPerlクイズ

この本には、ちゃいちゃんパパの小話しが載っています(謎)。

ある程度、Perlを理解している人には、たまらない内容になっています。さすが結城先生だな!

結城浩のPerlクイズ

■ 新版Perl言語プログラミングレッスン入門編

実は、私はまだ読んでいませんが、結城先生の本なので良くないはずがありません。

新版Perl言語プログラミングレッスン入門編

■ CGI&Perlポケットリファレンス (Pocket reference)

この本は、非常に役に立ちます。ちょっと調べるのに最適です。サンプルも説明も的を射ています。

CGI&Perlポケットリファレンス (Pocket reference)

■ Perlベストプラクティス

一読の価値有りだと思います。

Perlベストプラクティス

■ プログラミングPerl〈VOLUME1〉

ご存知、Perl本の聖書、ラクダ本(上)です。

■ プログラミングPerl〈VOLUME2〉

ご存知、Perl本の聖書、ラクダ本(下)です。

◆ おわりに

最後に、本ページが、何かのお役に立てれば幸いです。

尚、ご感想、ご意見、誤字、脱字、間違い等がありましたら遠慮なくPerlノート掲示板へご指摘ください。

HTML/ CSS/ CGI-Perl/ JavaScript/ JavaApplet/ AccessUp/ Internet/ EnglishLearn/ ちゃいちゃん天使/ 天使メッセージ/ 飯田ワールド/ 結城ワールド/ プロフィール/ WEB相談室/ WEBアンテナ/ WEBリーダー/ 燈明日記/ yahoo

人のよいところをどんどん見つけよう