grep

Perl の関数「 grep 」の書式を再確認します。

grep BLOCK LIST

grep EXPR, LIST

機能については、grep - perldoc.jp で確認可能です。

ケタの和が奇数になる数値がリストにあるかを確認する

例えば次のように、数値を格納した配列があります。

my @numbers = qw(1 2 4 8 16 32 64);

この配列の各要素の数値のうち、ケタ同士を足した数が奇数 ( odd number ) になる要素が *存在するかどうかのみ* を確認するには、次のコードが利用出来ます。

# 6. grep からの戻り値は index 値 0,4,5

my @indices_of_odd_digit_sums = grep{



  # 2. index 値 $_ で要素をコピー 

  my $number = $numbers[$_];



  # 3. 数字の桁を分割して順次加算

  my $sum;

  $sum += $_ for split //, $number;



  # 4. 剰余がある場合に 真(1) 剰余がない場合に 偽(0)

  $sum % 2;



  # 5. grep は 剰余がある $_ (index 値) を返す



} 0 .. $#numbers; # 1. index 値を grep に渡す

コメントに処理の順序を付与してみました。

まず最初に、「 0 .. $#numbers 」(0x1c) で順番に配列の index 値を grep のブロックに渡します。

次の「 my $number = $numbers[$_] 」は、渡された index 値「 $_ 」を利用してベースの配列「 @numbers 」の要素にアクセスし、その値をスカラ「 $number 」にセットしています。

それから、「 my $sum 」で二項代入演算子「 += 」 (0x86) の対象となるスカラを宣言しておいて、「 $sum += $_ for split //, $number 」で各ケタを足した値を格納します。

ここで、次のようにスカラ「 $sum 」宣言しても良いかと思いましたが、

my $sum += $_ for split //, $number:

これは「 Use of uninitialized value $sum 」のエラーになります。

なぜなら、二項代入演算子「 += 」を利用した上記コードを分解すると次のようになるからです。

my $sum = $sum + $_ for split //, $number;

この場合、「 my $sum 」による変数宣言よりも「 $sum + $_ 」の処理が先に評価され、「 $sum 」が初期化されていない値 ( uninitialized value ) として扱われます。

話を戻して、「 $sum += $_ for split //, $number 」によって、各ケタを足した値に対しては、「 $sum % 2 」によって「 偶数 / 奇数 」のテストを行います。

この時に「 2 」で割り切れず、剰余が発生する値は、自動的に「 奇数 」であると判断出来ます。

「 2 」の除算によって剰余が発生する場合、その値は常に「 1 」となり、これは関数「 grep 」にとって 真 の値となるため、その時点で「 grep 」に渡されていた配列「 @numbers 」の index 値は、配列「 @indices_of_odd_digit_sums 」 ( ケタの和が奇数のインデクス ) に格納されます。

反対に、剰余が発生しない ( 2 で割り切れる ) 場合は、値が「 0 」になります。「 grep 」はこれを 偽 と判定するため、その時点の index 値は破棄されます。

結果として「 grep 」の戻り値を格納する「 @indices_of_odd_digit_sums 」には、index 値「 0 」, 「 4 」, 「 5 」が格納されます。

つまり、配列「 @numbers 」の要素「 $numbers[0] 」( 1 ), 「 $numbers[4] 」( 16 ), 「 $numbers[5] 」( 32 ) が、当初の目的である「 ケタの和が奇数になる数値 」であることがわかります。

目的の条件を満たす要素のみを取得する

前項の処理では、条件 ( ケタの和が奇数になる ) に合致する要素があるかどうか、また、その要素の index 値が何であるかは分かりますが、実際の要素の値は不明です。

実際の要素の値が必要な場合は、前項のコードに次の処理を追加します。

# 配列スライス

my @odd_digit_sums = @numbers[ @indices_of_odd_digit_sums ];

これは、(0x26d) で確認した「 配列スライス 」を利用したコードです。スライスの変数を展開すると、次のようになります。

# 配列スライス

my @odd_digit_sums = @numbers[ 0, 4, 5 ];

ですから、配列「 @odd_digit_sums 」には、次の値がセットされます。

1 16 32

最初から、条件に該当する要素を取得したいなら、次のコードが利用出来ます。

my @odd_digit_sums = grep{

  my $sum;

  $sum += $_ for split //,$_;

  $sum % 2;

} @numbers;

これにより、配列「 @odd_digit_sums 」には、「 1 」, 「 16 」, 「 32 」が格納されます。

なお、奇数 ( odd number ) ではなく偶数 ( even number ) を取得したい場合は、上記コードの 4 行目を以下に変更します。

  $sum % 2 == 0;

2 つの配列の要素の値を比較する

まず、次のように数値のリストを持った 2 つの配列を用意します。

my @x = (qw(1 9 1 9 1 9 10 99));

my @y = (qw(1 2 3 4 5 6 7));

それから、配列「 @x 」の要素で配列「 @y 」と index 値が同じで、かつ、「 @x 」の方が値が大きいものを抽出したいと考えます。なお、「 @x 」の index 値が「 @y 」の最後の index 値 ( $#y ) よりも大きい場合は無条件に抽出します。

この場合は、以下のコードが利用出来ます。

my @bigger_indeces = grep{



  # index 値が大きい or 要素の値が大きい

  $_ > $#y or $x[$_] > $y[$_];



} 0 .. $#x;



my @bigger = @x[ @bigger_indices ];

これにより、配列「 @bigger 」には「 9 9 9 10 99 」が格納されます。

2 つの配列で「 共通 」の要素のみを取得する

次のようにカウンター用のハッシュを利用すれば、2 つの配列の要素で「 共通 」する要素のみを取得出来ます。

# 対象の配列 @x, @y

my @x = (qw(

  aaa.a

  bbb.b

  ccc.c

  eee.e

  fff.f

  ggg.g

));

my @y = (qw(

  aaa.a

  bbb.b

  ccc.c

  ggg.g



));



# カウンター用のハッシュ

my %count = (); 



# 同じ要素があれば value をカウントアップ

foreach my $element (@x, @y) { $count{$element}++ }



# カウントが 2 以上の要素のみ取得

my @intersection = grep{

  $count{$_} > 1;

} sort keys %count;



print "-- intersecton --\n", map{ "$_\n" } @intersection;

ハッシュを利用したカウンターは、 (0x84) で確認したハッシュの key が一意であることを利用したテクニックです。

このコードを実行すると、次の結果が得られます。

-- intersecton --

aaa.a

bbb.b

ccc.c

ggg.g

2 つの配列で「 固有 」の要素のみを取得する

前項のコードで「 grep 」ブロック内の条件を変更すれば、2 の配列の要素のうち「 固有 」のものだけを取得出来ます。

# カウントが 2 以上の要素のみ取得

my @intersection = grep{

  $count{$_} < 2;

} sort keys %count;

結果は次のよう変化します。

-- intersecton --

eee.e

fff.f

参考 ( perlfaq4 )

perlfaq4 - データ操作 の次のコードがとても参考になりました。

@union = @intersection = @difference = ();

%count = ();

foreach $element (@array1, @array2) { $count{$element}++ }

foreach $element (keys %count) {

  push @union, $element;

  push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;

}

NEXT

次回は、関数「 map 」の復習と「 シュワルツ変換 」を確認します。


参考情報は書籍「 続・初めての Perl 改訂版 」, 「 Effective Perl 第 2 版 」を中心に perldoc, Wikipedia および各 Web サイト。それと詳しい先輩。

目次 - Perl Index