sironekotoroの日記

Perl で楽をしたい

「良いコード/悪いコードで学ぶ設計入門」第4章 #ミノ駆動本

リスト4.1 変数tmpへの度重なる再代入

サンプルコードから書かれてないところを想像して書いていくの、楽しいですよね。

ってわけで、Perl で書いてみます。

これまでいろんな方法で Perl のオブジュエクト書いてきたけど、Function::Parameters でやります。

仮引数に型付けられるし。

型定義モジュールはこれ。前章の Money クラスの名前変えただけ。

ここクリックして展開

package MyType;
use strict;
use warnings;

use Type::Library -base;
use Type::Utils;
use Types::Standard -types;

# Character型
declare 'Character', as Object,
  where { ref $_ eq 'Character' },
  message { 'Characterクラスのみ受け付けます' };

1;
本文を参考に作ったCharacterクラスと、それを呼び出すスクリプト(`package main` 以降)。
#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

package Character;
use Carp qw/croak/;
use Mouse;
use lib qw/./;
use List::Util qw/max/;
use MyType qw/Character/;

has power => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    trigger  => sub { croak '0以上の値を設定してください', unless ( $_[0]->power >= 0 ) },
);

has weapon_attack => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    trigger  =>
      sub { croak '0以上の値を設定してください', unless ( $_[0]->weapon_attack >= 0 ) },
);

has speed => (
    is       => 'ro',
    isa      => 'Num',
    required => 1,
    trigger  => sub { croak '0以上の値を設定してください', unless ( $_[0]->speed >= 0 ) },
);

has defence => (
    is       => 'ro',
    isa      => 'Int',
    required => 1,
    trigger  => sub { croak '0以上の値を設定してください', unless ( $_[0]->defence >= 0 ) },
);

method damege( Character $enemy) {

    # メンバーの腕力と武器性能が基本攻撃力
    my $tmp = $self->power() + $self->weapon_attack();

    # メンバーのスピードで攻撃力を補正
    $tmp = $tmp * ( 1 + $self->speed() / 100 );

    #   攻撃力から敵の防御力を差し引いたのがダメージ
    $tmp = $tmp - ( $enemy->defence() / 2 );

    # ダメージ値が負数にならないよう補正
    $tmp = max( $tmp, 0 );

    return $tmp;
};

package main;

my $member = Character->new(
    power         => 1,
    weapon_attack => 10,
    speed         => 100,
    defence       => 10
);

my $enemy = Character->new(
    power         => 1,
    weapon_attack => 10,
    speed         => 100,
    defence       => 10
);

print $member->damege($enemy);    # 17

一つの変数に何回も何回も代入する再代入がよくない、というのは知っているし、経験もしている。

for 文の一時変数とか以外では避けるべきよね。

元のJava のコードで???となったのは、1f とか 100f という表記。

これってJava浮動小数リテラルの表記法なんですね。

わからなかったなぁ。

あと、Math.MaxPerlList::Utilmax 関数をそのまま使いました。

第3章の表3.3では値オブジェクトとして設計可能な値、概念の例というのがあり、そこではヒットポイントや攻撃力なんかも挙げられていました。

が、この先やるんだろうな・・・ってことで、ここではやっておりません。

リスト4.2 ローカル変数にfinalを付与すると再代入不可

Java で final なら、Perl は Readonly で。

お手軽で、見てわかりやすいのでReadonly使います。

おそいけど、まぁ、学習用だしヨシ!とします。

ちなみにコアモジュールだとばかり思ってたんですが、違うんですね。びっくりした。

$ corelist Readonly

Data for 2021-05-20
Readonly was not in CORE (or so I think)
use Readonly;
#(中略)

method damege( Character $enemy) {

    # メンバーの腕力と武器性能が基本攻撃力
    Readonly my $tmp => $self->power() + $self->weapon_attack();

    # メンバーのスピードで攻撃力を補正
    $tmp = $tmp * ( 1 + $self->speed() / 100 );

    # ここでエラー
    # Modification of a read-only value attempted 

このあとのリスト4.4, 4.5 のサンプルコードは productPrice の例になって、4章冒頭のサンプルコードからちょっとズレたような?

関数の引数にもfinalをつけましょう、というお話。

ここは3章でやりましたねというか、ここまでは3章でやったことの復習編みたいな感じ。

リスト4.6 攻撃力を表現するクラス

インスタンスの使い回しにより、意図せぬ変更が出ちゃったというお話。

Perlでもしっかり再現できました。

(package {} でクラスを囲ったり囲っていないのは、まだ自分のスタイルが見つからないから・・・)

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

package AttackPower {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };

    has value => (
        is       => 'rw' # 今回はrw、つまり可変で
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', if ( $_[0]->value < MIN ) },
    );

    1;
}

package Weapon {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };
    use lib qw/./;
    use MyType qw/AttackPower/;

    has attack_power => (
        is       => 'ro',
        isa      => 'AttackPower',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    1;
}

package main;
use feature qw/say/;

# 使い回す攻撃力インスタンス
my $attack_power = AttackPower->new( value => 10 );

# 武器A、武器Bにそれぞれ設定
# 同じ攻撃力だからええやろ、的な?
my $weaponA = Weapon->new( attack_power => $attack_power );
my $weaponB = Weapon->new( attack_power => $attack_power );

# 武器Aの攻撃力を25に設定
$weaponA->attack_power->value(25);

# 武器Aも「武器Bも」攻撃力が25になってしまった
say "Weapon A attack power:", $weaponA->attack_power->value();    # 25
say "Weapon B attack power:", $weaponB->attack_power->value();    # 25

Perl の場合にはリファレンスなんかでも同種の問題が起きたりしますね。

前章ではプロパティの値を更新したら、更新した値で新たなオブジェクトを返す、ってなことをやってたけど、今回のケースはそれでは防げないかな・・・あー、攻撃力を変更するってメソッドが必要か。

今回は直接プロパティ値を変更する場合のパターンなのね。

ということで、武器Aの攻撃力の変更が、武器Bに反映しないバージョンです。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

package AttackPower {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };

    has value => (
        is       => 'rw',    # 諸悪の根源
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak '', if ( $_[0]->value < MIN ) },
    );

    1;
}

package Weapon {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };
    use lib qw/./;
    use MyType qw/AttackPower/;

    has attack_power => (
        is       => 'ro',
        isa      => 'AttackPower',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    1;
}

package main;
use feature qw/say/;

# 使い回さない攻撃力インスタンス
my $attack_power_A = AttackPower->new( value => 10 );
my $attack_power_B = AttackPower->new( value => 10 );

# 武器A、武器Bにそれぞれ設定
my $weaponA = Weapon->new( attack_power => $attack_power_A );
my $weaponB = Weapon->new( attack_power => $attack_power_B );

# 武器Aの攻撃力を25に設定
$weaponA->attack_power->value(25);

# 武器Aの攻撃力の変更が、武器Bには及ばない
say "Weapon A attack power:", $weaponA->attack_power->value();    # 25
say "Weapon B attack power:", $weaponB->attack_power->value();    # 10

リスト4.21 武器を表現するクラス

先ほどは攻撃力の変更、今度は武器クラスWeaponも新しいWeaponオブジェクトを返すように変更。

これで、攻撃力も武器もインスタンスの使い回しは無くなりました。

いまのところ、Perlで仮引数を型付けして、かつ読み込み専用にするってのがわからないのと、今回の $increment はメソッドの中で手を加えることなく使われているので、Readonly処理はせずにやっていきます、

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

use lib qw/./;
use MyType;
use Readonly;

package AttackPower {
    use Carp qw/croak/;
    use Mouse;
    use constant { MIN => 0 };

    has value => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
        trigger  => sub {
            croak '0以上の値を設定してください',
              if ( $_[0]->value < MIN );
        },
    );

    # 攻撃力を強化する
    method rein_force( MyType::Int $increment ) {
        return AttackPower->new( value => $self->value + $increment );
    }

    # 攻撃力を0にする
    method disable() {
        return AttackPower->new( value => MIN );
    }

    1;
}

package Weapon {
    use Carp qw/croak/;
    use Mouse;
    use constant { MIN => 0 };

    has attack_power => (
        is       => 'ro',
        isa      => 'AttackPower',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    method rein_force( MyType::AttackPower $increment) {

        my $hoge = AttackPower->new( value => 0 );

        my $rein_forced = AttackPower->new(
            value => $self->attack_power->value + $increment->value );

        return Weapon->new( attack_power => $rein_forced );

    }

    1;
}

package main;
use feature qw/say/;

my $attack_power_A = AttackPower->new( value => 20 );
my $attack_power_B = AttackPower->new( value => 20 );

my $weapon_A = Weapon->new( attack_power => $attack_power_A );
my $weapon_B = Weapon->new( attack_power => $attack_power_B );

my $increment = AttackPower->new( value => 5 );

my $rein_forced_weapon_A = $weapon_A->rein_force($increment);

say "Weapon A attack power:", $weapon_A->attack_power->value;    # 20
say "Reinforced Weapon A attack power:",
  $rein_forced_weapon_A->attack_power->value;                    #25
say "Weapon B attack power:", $weapon_B->attack_power->value;    #20

はやくも bless 使ったPerlの素朴なオブジェクト指向へ回帰したい欲が湧いてきましたね。

リスト4.24 正しく動作するのか怪しげなロジック

ここらで中断してもいいかな〜、と思ったら次で最後のコードだったのでやります(フラグ)。

インスタンス変数を可変にする場合の注意点の例示コード。

ゲームのヒットポイントの処理です。

  • ヒットポイントは0以上
  • ヒットポイントが0になった場合、死亡状態にする

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

use lib qw/./;
use MyType;
use Readonly;

package HitPoint;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };

has amount => (
    is       => 'rw',
    isa      => 'Int',
    required => 1,
    trigger  => sub { croak '', unless ( $_[0] ) },
);

package Member;
use Carp qw/croak/;
use Mouse;
use Readonly;
use constant { MIN => 0 };

has hit_point => (
    is       => 'rw',
    isa      => 'Int',
    required => 1,
    trigger  => sub { croak '', unless ( $_[0] ) },
);

has states => (
    is       => 'rw',
    isa      => 'Str',
    required => 1,
    trigger  => sub { croak '', unless ( $_[0] ) },
);

# ダメージを受ける
method damege( MyType::HitPoint $damege_amount) {

    $self->hit_point( $self->hit_point - $damege_amount->amount );

}

package main;
use feature qw/say/;

my $member = Member->new( hit_point => 100, states => 'Normal' );

# ダメージのインスタンス化
my $damege = HitPoint->new( amount => 20 );

# ダメージを受ける
$member->damege($damege);

# 現在のヒットポイント
say $member->hit_point;    # 80

# 致命的なダメージのインスタンス化
my $critical_hit = HitPoint->new( amount => 100 );

# ダメージを受ける
$member->damege($critical_hit);

# 現在のヒットポイント
say $member->hit_point;    # -20

まだ、死亡判定入れてないのでヒットポイントがマイナスになったりします。

こちらが死亡判定を入れたもの・・・なのですが、ちょっと変えています。

先のコードでは3章とか4章の前半に従って値オブジェクトを使ってヒットポイントとかを設定していたんですが、それだとこの節の趣旨(インスタンス変数を可変にする)に合わないかなぁ?

ということで掲載コードに近く、数値を数値のまま(オブジェクトに包まずに)引数として渡すコードに書き換えてます。

ダメージ計算メソッドをMemberクラスからHitPointクラスに移し、HitPointクラスにヒットポイントがゼロかどうかの判定メソッドを追加してます。

これで状態変化も実装できました。

ここクリックして展開

!/usr/bin/env perl

use strict; use warnings; use Function::Parameters;

use lib qw/./; use MyType; use Readonly; use feature qw/say/;

package HitPoint; use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 }; use List::Util qw/max/;

has amount => ( is => 'rw', isa => 'Int', required => 1, trigger => sub { croak 'お前はもう死んでいる', if ( $_[0]->amount < MIN ) }, );

ダメージ計算

method damege( MyType::Int $damege_amount) {

Readonly my $next_amount => $self->amount - $damege_amount;
$self->amount( max( MIN, $next_amount ) );

}

ヒットポイントがゼロだったら1(true)

method is_zero() { return 1 if $self->amount == 0; }

package Member; use Carp qw/croak/; use Mouse; use Readonly; use constant { MIN => 0 };

has hit_point => ( is => 'rw', isa => 'Int', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, );

has states => ( is => 'rw', isa => 'Str', required => 1, trigger => sub { croak '', unless ( $_[0] ) }, );

ダメージを受ける

method damege( MyType::Int $damege_amount) {

# ダメージ判定をHitPointクラスのdamegeメソッドに投げる
my $hit_point = HitPoint->new( amount => $self->hit_point );
$hit_point->damege($damege_amount);

# ダメージ後のヒットポイントをセット
$self->hit_point( $hit_point->amount );

# 状態を変更
if ( $hit_point->is_zero ) {
    $self->states('dead');
}

}

package main; use feature qw/say/;

my $member = Member->new( hit_point => 100, states => 'normal' );

ダメージを受ける

my $dameged = $member->damege(20);

現在のヒットポイント

printf( "ヒットポイント:%s 状態:%s\n", $member->hit_point, $member->states );

ヒットポイント:80 状態:normal

致命的なダメージを受ける

my $critical_hit = $member->damege(200);

現在のヒットポイント

printf( "ヒットポイント:%s 状態:%s\n", $member->hit_point, $member->states );

ヒットポイント:0 状態:dead

ただまぁ、せっかく学習したことなので、値オブジェクトに包むやつもやってみます。

あと、掲載コードの以下のところはわからなかった。

状態をリストで管理?うーんわからん。

final States states;
//中略
states.add(StateType.dead)

・・・あ、states 複数形だ。

そうか、死亡状態はともかく、「毒と石化」とか複数状態を併発することってあるものな。

モルボルみたいな。

せっかくだからここも実装してみよ。

まず状態変化のクラス States を作って・・・そして謎のこだわりを発揮した結果、めちゃ時間かかった。日を跨いでしまった。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use Function::Parameters;

use lib qw/./;
use MyType;
use Readonly;
use feature qw/say/;

package States {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use List::Util qw/first uniq/;

    has states => (
        is       => 'ro',
        isa      => 'ArrayRef[Str]',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    method update( MyType::States $before_states) {

        # 追加される前のステータス
        # 今回追加されたステータス
        # まぜる
        Readonly my @added_states =>
          ( @{ $before_states->states }, @{ $self->states } );

        # ユニーク化
        Readonly my @uniqued_states => uniq @added_states;

        # dead があれば dead だけにする
        if ( first { $_ eq 'dead' } @uniqued_states ) {
            return States->new( states => ['dead'] );
        }

        # normal 以外の状態があれば、normalを削除する
        if ( grep { $_ !~ /normal/ } @uniqued_states ) {

            return States->new(
                states => [ grep { $_ !~ /normal/ } @uniqued_states ] );
        }

    }

    method show() {
        return join " ", @{ $self->states }
    }

}

package HitPoint {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };
    use List::Util qw/max/;

    has amount => (
        is       => 'rw',
        isa      => 'Int',
        required => 1,
        trigger  => sub { croak 'お前はもう死んでいる', if ( $_[0]->amount < MIN ) },
    );

    # ダメージ計算
    method damege( MyType::HitPoint $damege) {

        Readonly my $next_amount => $self->amount - $damege->amount;

        Readonly my $hit_point => $self->amount( max( MIN, $next_amount ) );

        return HitPoint->new( amount => $hit_point );
    }

    # ヒットポイントがゼロだったら1(true)
    method is_zero() {

        return 1 if $self->amount == 0;
    }
}

package Member {
    use Carp qw/croak/;
    use Mouse;
    use Readonly;
    use constant { MIN => 0 };

    has hit_point => (
        is       => 'rw',
        isa      => 'HitPoint',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    has states => (
        is       => 'rw',
        isa      => 'States',
        required => 1,
        trigger  => sub { croak '', unless ( $_[0] ) },
    );

    # ダメージを受ける
    method damege( MyType::HitPoint $damege, MyType::States $states ) {

        # ダメージ判定をHitPointクラスのdamegeメソッドに投げ、
        # HitPointオブジェクトで受ける
        my $dameged_hit_point = $self->hit_point->damege($damege);

        # ヒットポイントゼロならガード節で処理を終わらせる
        if ( $dameged_hit_point->is_zero ) {
            return Member->new(
                hit_point => $dameged_hit_point,
                states    => States->new( states => ['dead'] ),
            );
        }

        # ダメージ前のステータス
        my $before_states = $self->states;

        # ダメージ後のステータス判定
        my $dameged_status = $states->update($before_states);

        return Member->new(
            hit_point => $dameged_hit_point,
            states    => $dameged_status,
        );
    }

}

package main;
use feature qw/say/;

my $member = Member->new(
    hit_point => HitPoint->new( amount => 100 ),
    states    => States->new( states => ['normal'] ),
);

# 初期状態
# 現在のヒットポイント
# ヒットポイント:100 状態:normal
printf(
    "ヒットポイント:%s 状態:%s\n",
    $member->hit_point->amount,
    $member->states->show,
);

# ダメージで減るヒットポイント
my $poison_damege = HitPoint->new( amount => 20 );

# ダメージによるステータス変化
my $poison_states = States->new( states => ['poison'] );

# ダメージを受けた後に、Memberオブジェクトを受け取る
my $poisond_member = $member->damege( $poison_damege, $poison_states );

# 現在のヒットポイント
# ヒットポイント:80 状態:poison
printf(
    "ヒットポイント:%s 状態:%s\n",
    $poisond_member->hit_point->amount,
    $poisond_member->states->show,
);

# 毒を受けたメンバーが石化ダメージ
# ダメージで減るヒットポイント
my $stone_damege = HitPoint->new( amount => 30 );

# ダメージによるステータス変化
my $stone_states = States->new( states => ['stone'] );

# ダメージを受けた後に、Memberオブジェクトを受け取る
my $stoned_member = $poisond_member->damege( $stone_damege, $stone_states );

# 現在のヒットポイント
# ヒットポイント:50 状態:poison stone
printf(
    "ヒットポイント:%s 状態:%s\n",
    $stoned_member->hit_point->amount,
    $stoned_member->states->show,
);

# 致命的なダメージ
my $critical_damege = HitPoint->new( amount => 200 );

# 致命的なダメージを受ける
my $critical_dameged_member =
  $stoned_member->damege( $critical_damege, States->new( states => ['normal'] ),
  );

# 現在のヒットポイント
# ヒットポイント:0 状態:dead
printf(
    "ヒットポイント:%s 状態:%s\n",
    $critical_dameged_member->hit_point->amount,
    $critical_dameged_member->states->show,
);