いきなり例題から。
以下のような2つの配列があるとき、
my @fruits1 = qw/orange banana apple lemon/;
my @fruits2 = qw/orange banana/;
@fruits1のうち@fruits2とカブるものをカットして、重複しないappleとlemonだけ@fruits1に残したいとする。
こういうとき、今までぼくはこう書いていたのだけど、
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
for my $f2 (@f2) {
for my $f1 (@f1) {
if ($f1 eq $f2) {
say "match:\t$f1!";
@f1 = grep {$f1 ne $_} @f1;
}
}
}
say '===';
say "\@f1の残りは……";
say for @f1;
say "です！";
まあ、これでも目的は達成できる。実行結果は以下。
match: orange!
match: banana!
===
@f1の残りは……
apple
lemon
です！
最初にorange、その後にbananaがマッチして、あとにはappleとlemonが残っている。
コードでやってることとしては、まず2つの配列をループさせて、要素同士がマッチしたらその要素を元の配列からgrepで削除する。
削除というか、実際には「対象の要素以外を元の配列に入れ直す」という感じか。
で、ここでは重複を弾きたい（数を減らしたい）@f1の方を内側のループにして、grepでもその配列を対象としてカットしている。
というのも、この内と外を逆にすると、
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
for my $f1 (@f1) {
for my $f2 (@f2) {
if ($f1 eq $f2) {
say "match:\t$f1!";
@f1 = grep {$f1 ne $_} @f1;
}
}
}
say '===';
say "\@f1の残りは……";
say for @f1;
say "です！";
結果。
match: orange!
===
@f1の残りは……
banana
apple
lemon
です！
こんなふうに、意図に反して最初のorangeだけマッチして、本来消えてほしいbananaが残ってしまう。
中身はどういうことになってるのか、必殺のprintデバッグ。
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
for my $f1 (@f1) {
for my $f2 (@f2) {
say "f1:$f1 & f2:$f2";
if ($f1 eq $f2) {
say "match:\t$f1!";
@f1 = grep {$f1 ne $_} @f1;
}
}
}
say '===';
say "\@f1の残りは……";
say for @f1;
say "です！";
結果。
f1:orange & f2:orange
match: orange!
f1:orange & f2:banana
f1:apple & f2:orange
f1:apple & f2:banana
f1:lemon & f2:orange
f1:lemon & f2:banana
===
@f1の残りは……
banana
apple
lemon
です！
ということで、どうやら最初にorangeにマッチした後、@f1が2周めでbananaを飛ばしてappleの周回に入ってしまっている。（実行結果の4行目）
ちなみに、さっきの上手くいった場合だと、内部はどうなっているのかというと、
f1:orange & f2:orange
match: orange!
f1:apple & f2:orange
f1:lemon & f2:orange
f1:banana & f2:banana
match: banana!
f1:lemon & f2:banana
===
@f1の残りは……
apple
lemon
です！
という感じで、このときは目的上の影響がなくて気づかなかったけど、じつはここでもorangeがマッチした後、@f1のbananaがスッ飛ばされている。（実行結果の3行目）
ということで、実利的には最初の方法であれば目的は果たせるものの、裏で起こっていることはどちらも意図と違うというか、ちょっと気持ち悪い感じがあって、そこでいつもお世話になっていますPerl入学式のサポーター陣とのチャットでいろいろ相談してみた。
で、さっそく @xtetsuji さんからいただいた解答例がこちら。
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
array_minus1(\@f1, \@f2);
sub array_minus1 {
my $f1 = shift;
my $f2 = shift;
@$f1 = map {
my $f1_value = $_;
( grep { $f1_value eq $_ } @$f2 ) ? () : $f1_value;
} @$f1;
}
さらに、もう1案いただいた。
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
array_minus2(\@f1, \@f2);
sub array_minus2 {
my $f1 = shift;
my $f2 = shift;
my %f2_value_is = map { $_ => 1 } @$f2;
@$f1 = map { $f2_value_is{$_} ? () : $_ } @$f1;
}
結果はいずれも、以下。
@f1の残りは……
apple
lemon
です！
前者はgrep, 後者はmapを使っているけど、どちらも「マッチしたら空リストに入れる＝元の配列から外す」という処理になっている。
そしてそれとは別に、@skjmさんからAcme::Toolsのminusもあるよ、と教えて頂いて。
Acme::Tools - search.cpan.org
これを使うと、こんな感じ。
use Acme::Tools 'minus';
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
my @result = minus(\@f1, \@f2);
say "\@f1の残りは……";
say for @result;
say "です！";
結果は同じなので省略。
このAcme::Tools::minusの中身はこんな感じ。
sub minus {
my %seen;
my %notme=map{($_=>1)}@{$_[1]};
grep !$notme{$_}&&!$seen{$_}++, @{$_[0]};
}
http://cpansearch.perl.org/src/KJETIL/Acme-Tools-0.21/Tools.pm
ちょっと略記が多いのでわかりづらいのだけど、自分が見慣れた書式に噛み砕くと……
sub minus {
my $f1 = shift;
my $f2 = shift;
my %notme = map { ($_ => 1) } @{$f2};
my %seen;
my @result = grep { !$notme{$_} && !$seen{$_}++ } @{$f1};
return @result;
}
といった感じか。
ちなみに、これの途中にある以下のインクリメント。
!$seen{$_}++
何度見てもこれのある意味がわからず、実際、これを取っても結果は同じなのだけど、じつは最初の配列@f1に対して、
my @f1 = qw/orange banana apple lemon/;
my @f2 = qw/orange banana/;
以下のように、同配列内の重複要素を入れてみると、結果も変わる。
my @f1 = qw/orange banana apple lemon apple/;
my @f2 = qw/orange banana/;
先のインクリメントを入れた状態だと、これまで通りこうなるのだけど、
@f1の残りは……
apple
lemon
です！
そのインクリメントを外して以下のようにすると、
my @result = grep { !$notme{$_} } @{$f1};
結果はこうなる。
@f1の残りは……
apple
lemon
apple
です！
つまり、そのインクリメントは元になる配列（@f1）内の重複をカット（ユニーク化）してくれていた。
ということで、これについてはもう要件の問題というか、このツールを使う人がそもそもどういう結果を期待しているか？ によって要不要を判断するところだろう。
とりあえずぼくの当初の希望としては、「片方の配列からもう片方の配列と重複する要素を取り除く」ということだけを求めていて、「元の配列内に存在する重複も取り除く」ことは求めていないので、そのインクリメントなしバージョンの方が適切かもしれない。
結論としてのコード集
すでにけっこう長くなってしまったけど、もう少しコード例を挙げつつ、では結局のところ、ぼく自身は今後どういうときにどういうコードで対応していくか、というまとめ。
remove
まずはこれまで話題にしたとおり、「片方の配列からもう片方の配列と重複する要素を取り除く」ということをしたい場合には、こんな関数を使う。
sub remove {
my $whole = shift;
my $part = shift;
my %remove = map { $_ => 1 } @$part;
my @result;
for my $element (@$whole) {
if (! $remove{$element}) {
push @result, $element;
}
}
return @result;
}
これを以下のように呼び出すと、
my @f1 = qw/orange banana apple lemon apple/;
my @f2 = qw/orange banana/;
my @result = remove(\@f1, \@f2);
say for @result;
@f1から@f2の要素と重複する要素を取り除いたものが出てくる。
apple
lemon
apple
この際、@f1内の重複はカットしない。
crush
次に、じつはこれまでに出た要件とは別に、「とにかく重複するものは全部消してほしい」と思うこともあるので、その対策。
この場合、上記の修正前の Acme::Tools::minus でも微妙に適合していなくて、なぜなら上述のとおり、同配列の重複については最低でも1つ残してしまうから。
しかしここでの新たな要件は、たとえば以下の2つの配列があった場合、
my @f1 = qw/orange banana apple lemon apple/;
my @f2 = qw/orange banana/;
lemon以外はすべて重複しているので、
lemon
とだけ出てほしい。
で、そのためにこのような関数を作ってみた。
sub crush {
my $x = shift;
my $y = shift;
my %crush;
map { $crush{ $_ }++ } ( @$x, @$y );
for (keys %crush) {
if ($crush{$_} >= 2) {
delete $crush{$_};
}
}
my @result;
for ( @$x, @$y ) {
if ($crush{$_}) {
push @result, $_;
}
}
return @result;
}
これで以下のように実行すると、
my @f1 = qw/orange banana apple grape lemon apple/;
my @f2 = qw/orange banana strawberry/;
my @result = crush(\@f1, \@f2);
say for @result;
以下のように、とにかく全体の中で重複したものは取り除いてくれる。
grape
lemon
strawberry
この際、関数内ではハッシュで処理しているので、途中で順番がめちゃくちゃになっているのだけど、用途としては関数に渡した順に返ってきたほうが便利な気もするので、最後のfor文で順番を元に戻している。
ちなみに、関数名の crush というのは、重複した果物どうしをぶつけてつぶしてしまうイメージより。ジュースになって、形が消えるというような。
uniq
ついでにもう一つ、途中で少し話題にしたけど、渡した配列全体の中から、重複した余分な分はカットしつつ、でも1つは残しておきたい場合。
これは List::MoreUtilsのuniq関数を使えば早い。
use List::MoreUtils 'uniq';
my @f1 = qw/orange banana apple grape lemon apple/;
my @f2 = qw/orange banana strawberry/;
my @result = uniq(@f1, @f2);
say for @result;
実行。
orange
banana
apple
grape
lemon
strawberry
登場した果物すべてが1つずつ残っている。
uniqはリファレンスではなく普通に配列を渡すだけなので、用途が合えば作業も手っ取り早くてよい。
![うる星やつら2 ビューティフル・ドリーマー [デジタルリマスター版] [Blu-ray]](https://images-fe.ssl-images-amazon.com/images/I/51we2h5PUuL._SL160_.jpg "うる星やつら2 ビューティフル・ドリーマー [デジタルリマスター版] [Blu-ray]")
![恋はデジャ・ブ [DVD]](https://images-fe.ssl-images-amazon.com/images/I/51NmUV88caL._SL160_.jpg "恋はデジャ・ブ [DVD]")
