代码之家 › 专栏 › 技术社区 › Adam Taylor

我在Perl中的合并排序实现有什么问题?

mergesort sorting algorithm perl

Adam Taylor · 技术社区 · 15 年前

我正在尝试用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数组中的每个项,该项也有一个哈希项,其中包含item=>type=>'file',modified=>'date last modified',我正在尝试对每个文件的上次修改日期进行排序。

我的大脑基本上无法处理递归,我也不知道哪里出错了——这可能是明显和/或可怕的错误。任何帮助都会非常感谢…或者我正在重写为插入排序!

谢谢

1 回复 | 直到 15 年前

Chas. Owens 15 年前

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