我正在尝试在Perl中编写合并排序算法,我试图复制pseudo code from Wikipedia。
所以这就是我所拥有的:
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;
}
我得到的错误+调试打印语句的输出如下:
$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
现在,您在代码中看到的额外复杂性是,对于传入的$ collection array_ref中的每个项目,还有一个包含item =&gt;的项目的哈希条目。 {type =&gt; 'file',modified =&gt; 'date-last-modified'}我正在尝试对每个文件的最后修改日期进行排序。
我的大脑基本上无法应对递归,我无法弄清楚我哪里出错了 - 这可能是显而易见的和/或可怕的错误。任何帮助都会非常感激...或者我正在重写插入排序!
由于
答案 0 :(得分:4)
为什么不使用sort
功能?
my @sorted = sort { $a->{modified} <=> $b->{modified} } @unsorted;
仅供记录,这是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";