Quel est le problème avec mon implémentation de tri de fusion dans Perl?

Question

J'essaye d'écrire un algorithme de tri de fusion en Perl et j'ai essayé de copier le pseudo code from Wikipedia.

Voilà donc ce que j'ai:

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

L'erreur que je reçois + la sortie de mes déclarations d'impression de débogage est comme suit:

$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 

Maintenant, la complexité supplémentaire que vous voyez dans le code est que pour chaque article dans le $ collection array_ref passé il y a aussi une entrée de hachage pour cet élément contenant item => {type => 'fichier', modified => 'date-last-modified'} et je suis essayer de trier la date de dernière modification de chaque fichier.

Mon cerveau ne peut tout simplement pas faire face à la récursivité et je ne peux pas comprendre où je vais mal - c'est probablement évident et/ou terriblement mal. Toute aide serait très appréciée ... ou je réécris en tri d'insertion!

Merci

Answer 1

Pourquoi vous n'utilisez pas la fonction sort?

my @sorted = sort { $a->{modified} <=> $b->{modified} } @unsorted; 

Pour le compte rendu, voici une mise en œuvre inefficace de tri fusion en 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";