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

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))

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

Спасибо!

Answer 1

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

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

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

#!/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), соответственно.