我在Perl中的合并排序实现怎么了？

Question

我正在尝试在perl中编写合并排序算法，我试图复制 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中的每个项目，该项目也有一个HASH条目，其中包含项目=> {type =>'file'，modified =>'date date-last--修改了'}，我正在尝试对每个文件的最后一个修改日期进行排序。

我的大脑基本上无法应付递归，我无法弄清楚我的出错 - 这可能是明显的和/或可怕的。任何帮助都将不胜感激...或者我正在重写插入！

谢谢

Answer 1

你为什么不使用 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";