comment trouver la distance entre les éléments de deux tableaux?

Question

J'écris en perl, mais cela me semble plus une question d'algorithme. Les réponses dans d'autres langues sont les bienvenues. J'ai deux tableaux triés d'entiers, short et long. Pour chaque élément dans short, je veux trouver l'élément le plus proche dans long, et dans mon cas particulier je veux faire un histogramme des distances.

est ici l'algorithme J'utilise:

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]++; 
    } 
} 

Cela repose sur short et long être triés.

Voici un sous-programme que j'ai écrit pour tester mon algorithme. Le premier test réussit, mais le second échoue:

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

est ici la décharge:

$VAR1 = [ 
      7, 
      5 
     ]; 

(le problème persiste, si je compare long à une copie de celui-ci moins un élément, il est donc pas que la algorithme nécessite short être strictement inférieure long aussi, si je change 401, 402 ... 402, 404 ... gotHist devient (7, undef, 5))

Voici ce que je voudrais de vous tous:.. d'abord et F ou plus, un algorithme de travail pour cela. Réparer ce que j'ai ou en concevoir un autre à partir d'un tissu entier. Deuxièmement, je pourrais utiliser l'aide dans mes compétences de débogage. Comment allez-vous identifier le problème avec l'algorithme existant? Si je pouvais faire cela, je n'aurais pas besoin de poser cette question :)

Merci! En ce qui concerne la partie sur le débogage, utilisez un IDE qui permet les points d'arrêt.

Answer 1

Vous devez diviser le sous-programme: Calculer les distances et construire l'histogramme sont deux choses différentes et beaucoup de clarté est perdue en essayant de combiner les deux.

Commencez par la solution la plus simple en premier. Je comprends l'optimisation potentielle en utilisant un @long trié, mais recourez à cela seulement si List::Util::min est lent.

Vous pouvez utiliser Statistics::Descriptive pour générer la distribution de fréquence.

#!/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; 
} 

Sortie:

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

Bien sûr, il est possible de le faire sans utiliser de modules et d'utiliser votre hypothèse d'une @long triée:

#!/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

Je n'ai pas d'exemple pour perl, mais pour PHP et ASP.NET, il y a Eclipse et Visual Studio (ou la version gratuite, Visual Web Developer), respectivement.