Быстрая сортировка в Perl

Question

Я попытался реализовать QuickSort в Perl, как я это делал в Python и Ruby, с помощью следующего кода:

use strict;
use warnings;

sub sort {
    my ($lista, $p, $r) = @_;
    if ($p < $r) {
        my $q = &partition(\@$lista, $p, $r);
        &sort(\@$lista, $p, $q - 1);
        &sort(\@$lista, $q + 1, $r);
    }
}

sub partition {
    my ($lista, $p, $r) = @_;
    my $x = $$lista[$r];
    my $i = $p - 1;
    for (my $j = $p; $j < @$lista - 1; $j++) {
        if ($$lista[$j] <= $x) {
            $i++;
            ($$lista[$i], $$lista[$j]) = ($$lista[$j], $$lista[$i]);
        }
    }
    ($$lista[$i + 1], $$lista[$r]) = ($$lista[$r], $$lista[$i + 1]);
    return $i + 1;
}

my @lista = (4, 3, 9, 2, 1, 7, 5, 8);
&sort(\@lista, 0, $#lista);
print @lista

В этом случае выполнение падает в бесконечной рекурсии, и я не знаю почему, потому чтокод выглядит так же, как в Python и Ruby (алгоритм из Cormen, Введение в алгоритмы)

Примечание: если я пытаюсь выполнить:

my @lista = (3, 2, 1);
&sort(\@lista, 0, $#lista);
print @lista;

Выполнение заканчивается, иРезультат верный.

Заранее благодарим за помощь.

Answer 1

Вот новая версия вашего кода, с исправленным алгоритмом в partition, расширенными именами переменных для удобства чтения и расширенным использованием идиом Perl:

use strict;
use warnings;

sub qsort (\@) {_qsort($_[0], 0, $#{$_[0]})}

sub _qsort {
    my ($array, $low, $high) = @_;
    if ($low < $high) {
        my $mid = partition($array, $low, $high);
        _qsort($array, $low,     $mid - 1);
        _qsort($array, $mid + 1, $high   );
    }
}

sub partition {
    my ($array, $low, $high) = @_;
    my $x = $$array[$high];
    my $i = $low - 1;
    for my $j ($low .. $high - 1) {
        if ($$array[$j] <= $x) {
            $i++;
            @$array[$i, $j] = @$array[$j, $i];
        }
    }
    $i++;
    @$array[$i, $high] = @$array[$high, $i];
    return $i;
}

my @array = (4, 3, 9, 2, 1, 7, 5, 8);
qsort @array;
print "@array\n"; # 1 2 3 4 5 7 8 9

Поскольку вы действительно не хотитечтобы заставить вашего вызывающего всегда использовать qsort(@array, 0, $#array), когда будет делать qsort(@array), приведенный выше код создает функцию-обертку qsort, которая принимает массив букв (как встроенная функция shift @array) и затем вызывает три аргумента _qsort function.

Ваша реализация exchange переписана как фрагмент массива.Начальный символ изменен с $ на @, и список помещен в нижний индекс [...].

Наконец, основная проблема с вашим кодом заключалась в том, что ваше конечное условие в разделе было неверным.Там, где вы должны были использовать $r, вы использовали $#$lista, в результате чего раздел работал с гораздо большей частью списка, чем следовало бы.В приведенном выше коде я использовал цикл for/foreach вместо цикла for(;;){...} в стиле C:

for (my $i = 0; $i <= 100; $i++) {...}

for my $i (0 .. 100) {...} # faster and easier to read

Answer 2

Если я правильно понимаю, $ i и $ j никогда не должны выходить за пределы диапазона ($ p, $ r) в подпрограмме pratition, что неверно в вашем коде. Также, когда вы назначаете что-то за пределами списка, список будет расти и @list-1 изменится, и, похоже, это происходит здесь.

Также несколько замечаний по стилю:

1) Переименуйте sort в qsort.

2) Вызовите сабвуферы без ведущего &

3) используйте $list->[$n] вместо $$list[$n] - это легче читать.

Answer 3

вот быстрый с grep

sub quick_sort {
  my @a = @_;
  return @a if @a < 2;
  my $p = pop @a;
  quick_sort(grep $_ < $p, @a), $p, quick_sort(grep $_ >= $p, @a);
}

Answer 4

use strict;
use warnings;

sub qsort(\@){
    my( $array ) = @_;
    _qsort( $array, 0, @$array - 1 );
}
sub _qsort{
    my( $array, $left, $right ) = @_;
    return $array unless $left < $right;

    my $pivot_index = _qsort_partition( $array, $left, $right );

    _qsort( $array, $left, $pivot_index - 1);
    _qsort( $array, $pivot_index + 1, $right );
}
sub _qsort_partition {
    my ($array, $left, $right) = @_;
    my $pivot_value = $array->[$right];
    my $store_index = $left;

    for my $i ( $left .. ($right-1) ){
        if( $array->[$i] <= $pivot_value ){
            @$array[ $i, $store_index ] = @$array[ $store_index, $i ];
            $store_index++;
        }
    }

    @$array[ $store_index, $right ] = @$array[ $right, $store_index ];
    return $store_index;
}

use JSON 'to_json';
use List::Util 'shuffle';

my @array = 0..9;

my $max_str_len = @array * 2 + 1;
my $format = "%-${max_str_len}s => %-${max_str_len}s\n";

for my $array_length ( @array ){
    my @array = shuffle @array[0..$array_length];

    my $before = to_json \@array;
    qsort( @array );
    my $after = to_json \@array;

    printf $format, $before, $after;
}

пример вывода:

[0]                   => [0]                  
[1,0]                 => [0,1]                
[2,1,0]               => [0,1,2]              
[2,0,1,3]             => [0,1,2,3]            
[2,4,3,0,1]           => [0,1,2,3,4]          
[2,1,3,5,0,4]         => [0,1,2,3,4,5]        
[4,5,2,3,0,6,1]       => [0,1,2,3,4,5,6]      
[1,3,0,7,6,2,5,4]     => [0,1,2,3,4,5,6,7]    
[5,4,3,0,8,2,1,7,6]   => [0,1,2,3,4,5,6,7,8]  
[6,9,8,2,7,3,5,1,0,4] => [0,1,2,3,4,5,6,7,8,9]

Answer 5

Вы передаете всю полноту @ $ lista по ссылке на сабвуферы, поэтому условие завершения @$lista - 1 цикла for в sub partition, вероятно, не выполняет то, что вы хотели.

Стилистическая заметка \@$lista является избыточной, она разыменовывает список ref $lista, а затем снова получает ссылку, так что это то же самое, что просто сказать $lista.

Для производственного кода имеет смысл использовать встроенную в Perl функцию sort.