作者: 西野 太郎
日時: 2005/10/06(06:50)
西野と申します。始めまして。

藤岡さんから解答が出てますが、Schwartz変換に拘った形で、私もちょっと書い
てみました。いそいで書いたのでリファクタリングの対象になると思います。

use strict;
use warnings;

my @a = (13, 18, 8, 9, 11, 20);
my @b = (15, 9, 9, 18, 25);
sub first_map(\@\@);
sub second_map(\@);

my @sorted = sort{ $a->[0] <=> $b->[0] } first_map(@a, @b);
my ($A, $B) = second_map @sorted;
my @A = @$A;
my @B = @$B;
#結果の表示
print '@A = (', join(", ", @A), ")\n";
print '@B = (', join(", ", @B), ")\n";
#
sub first_map(\@\@) {
    my ($one, $two) = (shift, shift);
    my @array;
    for (my $cnt = 0; $cnt < @$one; $cnt++) {
        push @array, [ ${$one}[$cnt], $cnt + 1, undef, 'A' ];
    }
    for (my $cnt = 0; $cnt < @$two; $cnt++) {
        push @array, [ ${$two}[$cnt], $cnt + 1, undef, 'B' ];
    }
    wantarray ? @array : die "not list context!";
}

sub second_map(\@) {
    my $param = shift;
    my $cnt = 0;
    my %table = ();
    for (@$param) {
        $cnt++;
        $_->[2] = $cnt;
        my $num = $_->[0];
        push @{$table{$num}}, $cnt;
    }
    while ( my ($key, $val) = each %table ) {
        next if @$val == 1;
        my $sum = 0;
        $sum += $_ for (@$val);
        for (@$param) {
            next if $key != $_->[0];
            $_->[2] = $sum / @$val;
        }
    }
    my (@A, @B);
    for (@$param) {
        push @A, $_ if $_->[3] eq 'A';
        push @B, $_ if $_->[3] eq 'B';
    }
    @A = map{ $_->[2] } sort{ $a->[1] <=> $b->[1] } @A;
    @B = map{ $_->[2] } sort{ $a->[1] <=> $b->[1] } @B;
    return (\@A, \@B);
}
__END__

<実行結果>
@A = (6, 8.5, 1, 3, 5, 10)
@B = (7, 3, 3, 8.5, 11)

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
   西野太郎
    C62E 5A26 922B 90F8 4BEE  11B4 3811 7FE0 0798 A16D
    taro-nishino@...-ho.ne.jp
_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/