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言語で学ぶデザインパターン入門