リスト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 さんの記事で補足しておくと良いでしょう。
なお、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 文の先頭に next や return を持ってくる後置 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 では組み込みの変数でとうとう true と false ってのが実験的機能として追加されました。
早いこと実験的が外れるといいなぁ。
それまでは
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章終わり！
