как найти расстояние между элементами двух массивов?

Question

Я пишу на Perl, но для меня это больше похоже на вопрос об алгоритме.Ответы на других языках приветствуются.

У меня есть два отсортированных массива целых чисел, short и long.Для каждого элемента в short я хочу найти ближайший элемент в long, и в моем конкретном случае я хочу составить гистограмму расстояний.

Вот алгоритм, который я использую:

sub makeDistHist {
    my ($hist, $short, $long, $max) = @_; # first 3 are array references

    my $lIndex = 0;
    foreach my $s (@$short) {
        my $distance = abs( $s - $long->[$lIndex] );
        while (abs( $s - $long->[$lIndex+1] ) < $distance) {
            $distance = abs( $s - $long->[$lIndex] );
            $lIndex++;
        }
        $distance = $max if $distance>$max; # make overflow bin
        $hist->[$distance]++;
    }  
}

Это зависит от сортировки short и long.

Вот подпрограмма, которую я написал для проверки моего алгоритма.Первый тест успешен, но второй не пройден:

sub test { # test makeDistHist 

    my @long = qw(100 200 210 300 350 400 401 402 403 404 405 406);
    my @short = qw(3 6 120 190 208 210 300 350);
    my @tarHist;
    $tarHist[97]++;
    $tarHist[94]++;
    $tarHist[20]++;
    $tarHist[10]++;
    $tarHist[2]++;
    $tarHist[0]+=3;

    my $max = 3030;
    my @gotHist;
    makeDistHist(\@gotHist, \@short, \@long, $max);

    use Test::More tests => 2;
    is_deeply(\@gotHist, \@tarHist, "did i get the correct distances for two different arrays?");

    @gotHist = ();
    @tarHist = ( @long+0 );
    makeDistHist(\@gotHist, \@long, \@long, $max);
    is_deeply(\@gotHist, \@tarHist, "did i get the correct distances between an array and itself?");  # nope!
    print Dumper(\@gotHist);
}

вот дамп:

$VAR1 = [
          7,
          5
        ];

(проблема сохраняется, если сравнить long с его копией минус один элементпоэтому алгоритм не требует, чтобы short был строго короче long. Кроме того, если я изменяю 401, 402 ... на 402, 404 ... gotHist становится (7, undef, 5).)

Вот что я хотел бы от вас: прежде всего, рабочий алгоритм для этого.Либо починить то, что у меня есть, либо придумать другое из цельной ткани.Во-вторых, я мог бы использовать помощь в моих навыках отладки.Как бы вы пошли на выявление проблемы с существующим алгоритмом?Если бы я мог это сделать, мне бы не пришлось задавать этот вопрос:)

Спасибо!

Answer 1

Вы должны разбить подпрограмму: вычисление расстояний и построение гистограммы - это две разные вещи, и при объединении этих двух значений теряется большая ясность.

Сначала начните с самого простого решения. Я понимаю потенциальную оптимизацию с использованием отсортированного @long, но прибегаю к этому, только если List :: Util :: min медленный.

Вы можете использовать Статистика :: Описательный для генерации распределения частоты.

#!/usr/bin/perl

use strict; use warnings;
use List::Util qw( min );
use Statistics::Descriptive;

my $stat = Statistics::Descriptive::Full->new;

my @long = (100, 200, 210, 300, 350, 400, 401, 402, 403, 404, 405, 406);
my @short = (3, 6, 120, 190, 208, 210, 300, 350);

for my $x ( @short ) {
    $stat->add_data(find_dist($x, \@long));
}

my $freq = $stat->frequency_distribution_ref([0, 2, 10, 20, 94, 97]);
for my $bin ( sort { $a <=> $b } keys %$freq ) {
    print "$bin:\t$freq->{$bin}\n";
}

sub find_dist {
    my ($x, $v) = @_;
    return min map abs($x - $_), @$v;
}

Выход:

[sinan@archardy so]$ ./t.pl
0:      3
2:      1
10:     1
20:     1
94:     1
97:     1

Конечно, это можно сделать без использования каких-либо модулей и использования вашего предположения о отсортированном @long:

#!/usr/bin/perl

use strict; use warnings;

my @long = (100, 200, 210, 300, 350, 400, 401, 402, 403, 404, 405, 406);
my @short = (3, 6, 120, 190, 208, 210, 300, 350);

my @bins = reverse (0, 2, 10, 20, 94, 97);
my %hist;

for my $x ( @short ) {
    add_hist(\%hist, \@bins, find_dist($x, \@long));
}

for my $bucket ( sort { $a <=> $b } keys %hist ) {
    print "$bucket:\t$hist{$bucket}\n";
}

sub find_dist {
    my ($x, $v) = @_;
    my $min = abs($x - $v->[0]);
    for my $i ( 1 .. $#$v ) {
        my $dist = abs($x - $v->[$i]);
        last if $dist >= $min;
        $min = $dist;
    }
    return $min;
}

sub add_hist {
    my ($hist, $bins, $x) = @_;
    for my $u ( @$bins ) {
        if ( $x >= $u ) {
            $hist{ $u } += 1;
            last;
        }
    }
    return;
}

Answer 2

Что касается части об отладке, используйте IDE, которая разрешает точки останова.У меня нет примера для Perl, но для PHP и ASP.NET есть Eclipse и Visual Studio (или бесплатная версия, Visual Web Developer), соответственно.