Cosa c'è di sbagliato nell'implementazione del mio tipo di unione in Perl?
Domanda
Sto cercando di scrivere un algoritmo di smistamento di unione a Perl e ho tentato di copiare il Pseudo Codice da Wikipedia.
Quindi questo è quello che ho:
sub sort_by_date {
my $self = shift;
my $collection = shift;
print STDERR "\$collection = ";
print STDERR Dumper $collection;
if ( @$collection <= 1 ) {
return $collection;
}
my ( $left, $right, $result );
my $middle = ( @$collection / 2 ) - 1;
my $x = 0;
for ( $x; $x <= $middle; $x++ ) {
push( @$left,$collection->[$x] );
}
$x = $middle + 1;
for ( $x; $x < @$collection; $x++ ) {
push( @$right,$collection->[$x] );
}
$left = $self->sort_by_date( $left );
$right = $self->sort_by_date( $right );
print STDERR '$left = ';
print STDERR Dumper $left;
print STDERR '$right = ';
print STDERR Dumper $right;
print STDERR '$self->{\'files\'}{$left->[@$left-1]} = ';
print STDERR Dumper $self->{'files'}{$left->[@$left-1]};
print STDERR '$self->{\'files\'}{$right->[0]} = ';
print STDERR Dumper $self->{'files'}{$right->[0]};
if ( $self->{'files'}{$left->[@$left-1]}{'modified'} > $self->{'files'}{$right->[0]}{'modified'} ) {
$result = $self->merge_sort( $left,$right );
}
else {
$result = [ @$left, @$right ];
}
return $result;
}
## We're merge sorting two lists together
sub merge_sort {
my $self = shift;
my $left = shift;
my $right = shift;
my @result;
while ( @$left > 0 && @$right > 0 ) {
if ( $self->{'files'}{$left->[0]}{'modified'} <= $self->{'files'}{$right->[0]}{'modified'} ) {
push( @result,$left->[0] );
shift( @$left );
}
else {
push( @result,$right->[0] );
shift( @$right );
}
}
print STDERR "\@$left = @$left\n";
print STDERR "\@$right = @$right\n";
if ( @$left > 0 ) {
push( @result,@$left );
}
else {
push( @result,@$right );
}
print STDERR "\@result = @result\n";
return @result;
}
L'errore che sto ottenendo + l'output dalle mie dichiarazioni di stampa di debug è il seguente:
$collection = $VAR1 = [
'dev/css/test.css',
'dev/scripts/out.tmp',
'dev/scripts/taxonomy.csv',
'dev/scripts/wiki.cgi',
'dev/scripts/wiki.cgi.back',
'dev/templates/convert-wiki.tpl',
'dev/templates/includes/._menu.tpl',
'dev/templates/test.tpl'
];
$collection = $VAR1 = [
'dev/css/test.css',
'dev/scripts/out.tmp',
'dev/scripts/taxonomy.csv',
'dev/scripts/wiki.cgi'
];
$collection = $VAR1 = [
'dev/css/test.css',
'dev/scripts/out.tmp'
];
$collection = $VAR1 = [
'dev/css/test.css'
];
$collection = $VAR1 = [
'dev/scripts/out.tmp'
];
$left = $VAR1 = [
'dev/css/test.css'
];
$right = $VAR1 = [
'dev/scripts/out.tmp'
];
$self->{'files'}{$left->[@$left-1]} = $VAR1 = {
'type' => 'file',
'modified' => '0.764699074074074'
};
$self->{'files'}{$right->[0]} = $VAR1 = {
'type' => 'file',
'modified' => '340.851956018519'
};
$collection = $VAR1 = [
'dev/scripts/taxonomy.csv',
'dev/scripts/wiki.cgi'
];
$collection = $VAR1 = [
'dev/scripts/taxonomy.csv'
];
$collection = $VAR1 = [
'dev/scripts/wiki.cgi'
];
$left = $VAR1 = [
'dev/scripts/taxonomy.csv'
];
$right = $VAR1 = [
'dev/scripts/wiki.cgi'
];
$self->{'files'}{$left->[@$left-1]} = $VAR1 = {
'type' => 'file',
'modified' => '255.836377314815'
};
$self->{'files'}{$right->[0]} = $VAR1 = {
'type' => 'file',
'modified' => '248.799166666667'
};
@ARRAY(0x8226b2c) = dev/scripts/taxonomy.csv
@ARRAY(0x8f95178) =
@result = dev/scripts/wiki.cgi dev/scripts/taxonomy.csv
$left = $VAR1 = [
'dev/css/test.css',
'dev/scripts/out.tmp'
];
$right = $VAR1 = 2;
$self->{'files'}{$left->[@$left-1]} = $VAR1 = {
'type' => 'file',
'modified' => '340.851956018519'
};
$self->{'files'}{$right->[0]} = [Tue Sep 22 13:47:19 2009] [error] [Tue Sep 22 13:47:19 2009] null: Can't use string ("2") as an ARRAY ref while "strict refs" in use at ../lib/Master/ProductVersion.pm line 690.\n
Ora la complessità aggiunta che vedi nel codice è che per ogni elemento in $ raccolta array_ref trasmesso in una voce hash per quell'elemento contenente elemento => {type => 'file', modificato => 'data-last- modificato '} e sto cercando di ordinare la data ultima modificata di ciascun file.
Il mio cervello praticamente non riesco a far fronte alla ricorsione e non riesco a capire dove sto sbagliando - probabilmente è ovvio e/o orribile. Qualsiasi aiuto sarebbe molto apprezzato ... o sto riscrivendo come tipo di inserimento!
Grazie
Soluzione
Perché non stai usando il sort
funzione?
my @sorted = sort { $a->{modified} <=> $b->{modified} } @unsorted;
Solo per il record, ecco un'implementazione inefficiente dell'ordinamento di unione in Perl:
#!/usr/bin/perl
use strict;
use warnings;
sub merge {
my ($cmp, $left, $right) = @_;
my @merged;
while (@$left && @$right) {
if ($cmp->($left->[0], $right->[0]) <= 0) {
push @merged, shift @$left;
} else {
push @merged, shift @$right;
}
}
if (@$left) {
push @merged, @$left;
} else {
push @merged, @$right;
}
return @merged;
}
sub merge_sort {
my ($cmp, $array) = @_;
return @$array if @$array <= 1;
my $mid = @$array/2 - 1;
my @left = merge_sort($cmp, [@{$array}[0 .. $mid]]);
my @right = merge_sort($cmp, [@{$array}[$mid+1 .. $#{$array}]]);
if ($left[-1] > $right[0]) {
@left = merge $cmp, \@left, \@right;
} else {
push @left, @right;
}
return @left;
}
my $cmp = sub {
my ($x, $y) = @_;
return $x <=> $y;
};
print join(", ", merge_sort $cmp, [qw/1 3 4 2 5 4 7 8 1/]), "\n";