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

Question

Я пытаюсь написать алгоритм сортировки слияния в 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, который передается, есть также хэш-запись для этого элемента, содержащая элемент => {type => 'file', modified => '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";