Что не так с моей реализацией сортировки слиянием в Perl?

Question

Я пытаюсь написать алгоритм сортировки слиянием в Perl, и я пытался скопировать псевдокод из Википедии .

Так вот что у меня есть:

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 есть также хеш-запись для этого элемента, содержащая элемент => {type => 'file' ,ified => 'date -last-Modified '} и я пытаюсь отсортировать по дате последнего изменения каждого файла.

Мой мозг просто не может справиться с рекурсией, и я не могу понять, где я ошибаюсь - это, вероятно, очевидно и / или ужасно неправильно. Любая помощь будет высоко ценится ... или я переписываю как сортировка вставки!

Спасибо

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";