配列ユーティリティ

ArrayUtil.pm

package ArrayUtil;

use strict;
use warnings;

use Exporter;
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/
  uniq
  any
  all
  full_outer_join
/;

# 配列の重複を除外します。
# ブロックで比較キーを指定します。
# 事前ソートは不要です。
sub uniq(&@) {
  my $code = shift;
  my %exists;
  my @out;
  for (@_) {
    my $key = $code->($_);
    push @out, $_ unless (defined $exists{$key});
    $exists{$key} = 1;
  }
  @out;
}

# 述語を満たす要素が1個でもあれば1を返し、そうでなければ0を返します
sub any(&@) {
  my $predicate = shift;
  for (@_) {
    return 1 if ($predicate->($_));
  }
  0;
}

# すべての要素が述語をみたすとき1を返し、そうでなければ0を返します
sub all(&@) {
  my $predicate = shift;
  for my $x (@_) {
    return 0 unless $predicate->($_);
  }
  1;
}

# A difference B
sub difference {
    my $A = shift;
    my $B = shift;
    my %B = map {$_ => 1} @{$B}; # Bの要素をルックアップするためのハッシュ
    grep {! $B{$_}} @{$A};         # Bに含まれないAの要素からなる配列
}

# ２つのArrayRefを完全外部結合
# full_outer_join {$a eq $b} [1,2,3,4], [2,3,4,5]
# (
#   [    1, undef],
#   [    2,     2],
#   [    3,     3],
#   [    4,     4],
#   [undef,     5],
# )
sub full_outer_join(&$$) {
  my ($eq, $lhs, $rhs) = @_;
  my @rows;
  
  # 呼び出し元の our $a, $b にアクセスする準備 
  my ($caller_a, $caller_b) = do {
    my $pkg = caller;
    no strict 'refs';
    (\*{"$pkg\::a"}, \*{"$pkg\::b"});
  };
  
  my %index_of_joined_r;
  for my $l (@{$lhs}) {
    my @rows_;
    my $index_of_r = 0;
    for my $r (@{$rhs}) {
      local (*$caller_a, *$caller_b) = (\$l, \$r);
      if ($eq->($l, $r)) {
        $index_of_joined_r{$index_of_r} = 1;
        push @rows_, [$l, $r];
      }
      $index_of_r++;
    }
    unless (@rows_) {
      push @rows_, [$l, undef];
    }
    push @rows, @rows_;
  }
  
  my $index_of_r = 0;
  for my $r (@{$rhs}) {
    unless ($index_of_joined_r{$index_of_r}) {
      push @rows, [undef, $r];
    }
    $index_of_r++;
  }
  
  @rows;
}

1;