sironekotoroの日記

Perl で楽をしたい

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

リスト7.1 「牢屋の鍵」の所持を調べるコード

まずは例示コードを愚直に。

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use constant { false => !!0, true => !!1 };

my $has_prison_key = false;

my @items = qw(steal_sword iron_mail pearl_ring prison_key);
for my $item (@items) {
    if ( $item eq 'prison_key' ) {
        $has_prison_key = true;
        last;
    }
}

say $has_prison_key;    # 1;

7.2 anyMatchメソッド

例示コードは Java なので anyMatch の紹介なのだけど、うちは Perl で書いているので

  • 標準で使える
  • リストや配列から一致するもので引っ張って来られる

という例示コードの条件を満たすなると、grep ですかね。

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use constant { false => !!0, true => !!1 };

my $has_prison_key = false;

my @items = qw(steal_sword iron_armor pearl_ring prison_key);

$has_prison_key = grep { $_ eq 'prison_key' } @items;

say $has_prison_key;    # 1

ただ、コレクション処理、ということであれば Perl では標準で入っている List::Util を使うのが良いでしょう。

ありがちな関数はだいたい入ってます。

List::Util は Perl のバージョンが上がるごとに使える関数が増えているので、 id:xtetsuji さんの記事で補足しておくと良いでしょう。

qiita.com

なお、Perl をインストールすると List::Util の他にも便利モジュールが入ってきます。

corelist -v 5.36.0

とかやるとずらっと出てきます。

List::Util の他にも役に立つモジュールが見つけられるかもしれません。

リスト7.3 ありがちなネスト構造

ところで、悪い例示コードも書写してるんですが、このネストはなんというか、心削られるものがありますね・・・

なお、今回から「良いコードの肝」に型やオブジェクトが必要ない、関係なさそうな場合には作らずにいきたいと思います。

今回はハッシュリファレンスを配列の中に入れて代用してます。

これで少しは進捗の速度上がるかな

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    { name => 'alice', hit_point => 10, state => 'poison' },
    { name => 'bob',   hit_point => 20, state => '' },
    { name => 'carol', hit_point => 15, state => 'stone' },
);

for my $member (@members) {

    # hit_point が 0 より大きかったら
    if ( 0 < $member->{hit_point} ) {

        # 毒状態だったら
        if ( $member->{state} eq 'poison' ) {
            $member->{hit_point} -= 10;

            # hit_point が 0 以下になったら
            if ( $member->{hit_point} <= 0 ) {
                $member->{hit_point} = 0;
                $member->{state}     = 'dead';
            }

        }

    }

}

say Dumper @members;
# $VAR1 = {
#           'name' => 'alice',
#           'state' => 'dead',
#           'hit_point' => 0
#         };
# $VAR2 = {
#           'state' => '',
#           'name' => 'bob',
#           'hit_point' => 20
#         };
# $VAR3 = {
#           'name' => 'carol',
#           'state' => 'stone',
#           'hit_point' => 15
#         };

リスト7.4 早期 continue でネスト解消 〜 リスト7.5 if分のネストがすべて解消された

Perl の場合、ループ中の処理を途中で切り上げて次のループに移る時に使うのは next なので、こんな感じ。

ついでに、Perl では if 文の先頭に nextreturn を持ってくる後置 if って書き方ができるのでそれで。

ここでのポイントは、先の例とは条件式を反転させることですね。

例示コードはまとめて、すべてのネストが解消されたリスト7.5のものです。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    { name => 'alice', hit_point => 10, state => 'poison' },
    { name => 'bob',   hit_point => 20, state => '' },
    { name => 'carol', hit_point => 15, state => 'stone' },
);

for my $member (@members) {

    # 生存していない場合 next で次のループ処理に移行する
    # 早期 netxt への変更には、条件を反転させる
    next if ( $member->{hit_point} == 0 );

    # 毒状態でなかったら next
    # 文字列の比較演算子 ne(not equal)を利用 
    next if ( $member->{state} ne 'poison' );
    $member->{hit_point} -= 10;

    # hit_point が 0 より大きかったら next
    next if ( 0 < $member->{hit_point} );

    $member->{hit_point} = 0;
    $member->{state}     = 'dead';

}

say Dumper @members;
$VAR1 = {
          'state' => 'dead',
          'hit_point' => 0,
          'name' => 'alice'
        };
$VAR2 = {
          'state' => '',
          'name' => 'bob',
          'hit_point' => 20
        };
$VAR3 = {
          'state' => 'stone',
          'hit_point' => 15,
          'name' => 'carol'
        };

リスト7.7 早期breakで見通し改善

Perl の場合、ループ中の処理を抜け出す時に使うのは last なので、こんな感じ。

ここクリックして展開

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Data::Dumper;

my @members = (
    {
        name                => 'alice',
        attack              => 35,
        team_attack_succeed => team_attack_succeed()
    },
    {
        name                => 'bob',
        attack              => 40,
        team_attack_succeed => team_attack_succeed()
    },
    {
        name                => 'carol',
        attack              => 50,
        team_attack_succeed => team_attack_succeed()
    },
);

# 連携の成功/失敗の結果を生成する関数
sub team_attack_succeed {
    my $result = rand(1);
    return 1 if $result > 0.8;
    return 0;
}

my $total_damege = 0;

for my $member (@members) {
    last if ( $member->{team_attack_succeed} );

    my $damege = $member->{attack} * 1.1;

    last if $damege < 30;

    $total_damege += $damege;
}

say $total_damege;

リスト7.8 〜 7.13

コレクション処理も低凝集に陥りやすい。

ここでの例では、RPGにおいて「パーティメンバーが1人でも生存しているか?」という判定メソッドや、「メンバーを追加する」のような、よく利用されるメソッドが色々なところで実装されて重複コードになっているというもの。

時には名前が違うだけで、同じ処理内容のコードが生まれることも・・・これは低凝集ですね。

ところで、コレクション処理っていうと、何かの共通項を持った要素の集まり、程度の認識で良いのかな?

例示のコードだと、 member を集めて members みたいな。

まぁ、そんな認識でやっていこう。

このコレクションの低凝集を解決するためにすることが、コレクション処理のカプセル化

ファーストクラスコレクション。おぉ、初めて聞いた・・・

強靭なクラスを作るための

を応用し

を備えたものとのこと。

うーん、うーん?

まぁ、書いていくか。ここはちゃんとオブジェクトで書いていかないとダメっぽそう。

ここクリックして展開

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

package Member {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has name => (
        is       => 'ro',
        isa      => 'Str',
        required => 1,
    );
    __PACKAGE__->meta->make_immutable();
}

package Party {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

    # プライベートにしたインスタンス変数に直接アクセスはさせたくないが、
    # 参照はしたい。ので、アクセサ(getterとかsetter)を作る。
    # メソッド名 get_members とかにするところだが、本に合わせて party とする。
    method party() {
        my @members =
          @{ $self->_members() };    # ここでデリファレンスにしておかないとイミュータブルにならなくて泣く
        return \@members;
    }

    # MouseX::AttributeHelper で provide => {add => 'add'}を使っても
    # よかったが、本文でオブジェクトをイミュータブルにしているので、
    # それなら使わなくてもいいか、と言うわけで自前実装
    # 一人ずつ追加の実装
    method add(:$new_member) {
        my $adding = $self->party();
        push @{$adding}, $new_member;
        return Party->new( _members => $adding );
    }

    __PACKAGE__->meta->make_immutable();
}

package main;

my $alice = Member->new( name => 'alice' );
my $bob   = Member->new( name => 'bob' );
my $party = Party->new();

my $alice_in_party = $party->add( new_member => $alice );

say $alice_in_party->party()->[0]->name;    # alice

my $bob_in_party = $alice_in_party->add( new_member => $bob );

say $bob_in_party->party()->[1]->name;      # bob

リスト型をインスタンス変数で持つ、をこう表現してみた

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

で、メンバーに変更があったら(今回は加入)、加入した情報でオブジェクトを作り直して渡す、と。

    method add(:$new_member) {
        my $adding = $self->party();
        push @{$adding}, $new_member;
        return Party->new( _members => $adding );
    }

ふむふむ。

ここはわかった。

ところで、渡した後のオブジェクトは用済みにしておかなくていいのかな・・・?

あれ、それってシングルトンってやつ?違うか?まぁいいや。

先に進もう。

リスト 7.14 リスト操作に必要なロジックを同じクラスに定義

ここで、コードが整形できてなくて???となる。

Perl では perltidy というツールでコードを整形するのだけど、それが効いてない。

原因は Function::Parameters での名前付き引数 :$new_member のところだった。

    method add(:$new_member) {

便利なんだけど、コードは整形したいから封印かなぁ。

残念。

あと、ちょっと前から真偽値で !!1 とか !!0 ってのを使ってます。

Perl 5.36 では組み込みの変数でとうとう truefalse ってのが実験的機能として追加されました。

早いこと実験的が外れるといいなぁ。

metacpan.org

それまでは

    use constant {  true => !!1, false => !!0 };

で生きていこうと思います。

で、Party クラスに、必要なコレクションを追加したのが以下のコード。

もっと手間かかると思ったけど、意外とあっさり終わったなぁ。

ファーストクラスコレクション、コレクション処理を1箇所にまとめたクラス。

今回は追加とか、メンバー数の判定とか、生存者確認とか。

やっぱ、コード書いてみると理解度が上がるなぁ。

ここクリックして展開

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

package Member {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;

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

    has id => (
        is       => 'ro',
        isa      => 'Int',
        required => 1,
    );

    has is_alive => (
        is       => 'ro',
        isa      => 'Bool',
        required => 0,
    );

    __PACKAGE__->meta->make_immutable();
}

package Party {
    use Carp qw/croak/;
    use Mouse;
    use namespace::autoclean;
    use constant { MAX_MEMBER_COUNT => 4, TRUE => !!1, FALSE => !!0 };

    has _members => (
        is       => 'ro',                      # イミュータブル(不変)にする
        isa      => 'ArrayRef[Object]',        # Mouse が用意している型
        required => 0,
        default  => sub { _members => [] },    # デフォルトを設定し、生焼けオブジェクトにしない
    );

    method party() {
        my @members = @{ $self->_members() };
        return \@members;
    }

    # メンバーを追加する
    method add($new_member) {
        croak "すでにパーティに加わっています" if ( $self->exists($new_member) );

        croak "これ以上メンバーを追加できません" if ( $self->is_full );

        my $adding = $self->party();
        push @{$adding}, $new_member;
        Party->new( _members => $adding );
    }

    # パーティのメンバーが1人でも生存している場合 true
    method is_alive() {
        return TRUE if ( grep { $_->is_alive == 1 } @{ $self->party() } );
    }

    # パーティに所属しているかを調べたいメンバー
    # 既にパーティに所属している場合 true
    method exists($member) {
        return TRUE if ( grep { $_->id eq $member->id } @{ $self->party() } );
    }

    # パーティが満員の場合 true
    method is_full() {
        my $count = scalar @{ $self->party() };
        return TRUE if ( MAX_MEMBER_COUNT == $count );
    }

    __PACKAGE__->meta->make_immutable();
}

package main;

my $alice = Member->new( name => 'alice', id => 1, is_alive => 1 );
my $bob   = Member->new( name => 'bob',   id => 2, is_alive => 1 );
my $party = Party->new();

my $alice_in_party = $party->add($alice);

say $alice_in_party->party()->[0]->name;    # alice

my $bob_in_party = $alice_in_party->add($bob);

say $bob_in_party->party()->[1]->name;      # bob

# my $bob_in_party_twice = $bob_in_party->add($bob);

リスト 7.17 外部には不変にして渡す

へー! Java にはそういうメソッドがあるんだ。unmodifiableList 知らなかった。

と言うことで、第7章終わり!