2010-12-08 17 views
0

Ich schreibe in Perl, aber es scheint eher wie eine Algorithmusfrage für mich. Antworten in anderen Sprachen sind willkommen.Wie finde ich den Abstand zwischen Elementen zweier Arrays?

Ich habe zwei sortierte Reihen von ganzen Zahlen, short und long. Für jedes Element in short möchte ich das nächste Element in long finden, und in meinem speziellen Fall möchte ich ein Histogramm der Entfernungen machen.

Hier ist der Algorithmus Ich verwende:

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

Dies beruht auf short und long sortiert werden.

Hier ist ein Unterprogramm, das ich schrieb, um meinen Algorithmus zu testen. Der erste Test erfolgreich ist, aber die zweite nicht:

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

hier ist der dump:

$VAR1 = [ 
      7, 
      5 
     ]; 

(das Problem weiterhin besteht, wenn ich long auf eine Kopie davon minus ein Element vergleichen zu können, so ist es nicht, dass die Algorithmus erfordert short als long streng kürzer sein auch, wenn ich 401 ändern, 402 ... bis 402, 404 ... gotHist wird (7, undef, 5))

Hier ist, was ich von y'all möchte:.. zuerst und f Oder ein funktionierender Algorithmus dafür. Entweder repariere das, was ich habe, oder baue ein anderes aus ganzem Stoff. Zweitens könnte ich Hilfe in meinen Debugging-Fähigkeiten verwenden. Wie würden Sie das Problem mit dem vorhandenen Algorithmus identifizieren? Wenn ich das tun könnte, müsste ich diese Frage nicht stellen :)

Danke!

+1

Sie erkennen Sie '$ tarHist [97] ++ 'wächst' @ tarHist' um 98 Elemente zu enthalten, oder? Warum nicht eine Hash-Tabelle verwenden? –

+0

Auch, was ist '@tarHist = (@ lang + 0); soll das tun? –

Antwort

3

Sie sollten die Subroutine auflösen: Das Berechnen der Abstände und das Erstellen des Histogramms sind zwei verschiedene Dinge und viel Klarheit geht verloren, wenn man versucht, die beiden zu kombinieren.

Beginnen Sie zuerst mit der einfachsten Lösung. Ich verstehe die mögliche Optimierung durch Verwendung einer sortierten @long, aber greifen Sie darauf nur zurück, wenn List::Util::min langsam ist.

Sie können Statistics::Descriptive verwenden, um die Häufigkeitsverteilung zu generieren.

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

Ausgang:

[[email protected] so]$ ./t.pl 
0:  3 
2:  1 
10:  1 
20:  1 
94:  1 
97:  1

Natürlich ist es möglich, dies zu tun, ohne irgendwelche Module zu verwenden und mit Ihrer Annahme einer sortierten @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; 
} 
0

In Bezug auf den Teil über das Debuggen, verwenden Sie eine IDE, die Haltepunkte erlaubt. Ich habe kein Beispiel für Perl, aber für PHP und ASP.NET gibt es Eclipse und Visual Studio (bzw. die kostenlose Version, Visual Web Developer).

Verwandte Themen