堆排序 Perl 代碼實現

#!/usr/bin/perl -w<br />use strict;<br />use 5.010;</p><p>sub BigHeapAdjust($$/@){<br /> my($pos, $len, $arr) = @_;<br /> my $temp = $arr->[$pos];<br /> #沿節點值較大的兒子往下層篩選，2*r+1是左兒子，2*(r+1)是右兒子<br /> for(my $j = 2*$pos+1; $j <= $len-1; $j = 2*$j+1 ) {<br /> $j++ if $j<$len-1 && $arr->[$j+1] >= $arr->[$j];<br /> last if $temp >= $arr->[$j];<br /> $arr->[$pos] = $arr->[$j];<br /> $pos = $j;<br /> }<br /> $arr->[$pos] = $temp;<br />}<br />sub BigHeapSort($/@){<br /> my($len, $arr) = @_;<br /> for(my $i = $len/2 -1; $i >=0 ;$i-- ) {<br /> BigHeapAdjust($i, $len, @$arr);<br /> }<br /> $arr->[0] ^= $arr->[$len-1];<br /> $arr->[$len-1] ^= $arr->[0];<br /> $arr->[0] ^= $arr->[$len-1];<br /> #my $temp = $arr->[0];<br /> #$arr->[0] = $arr->[$len-1];<br /> #$arr->[$len-1] = $temp;</p><p> for(my $j = $len -1; $j>1; $j--) {<br /> BigHeapAdjust(0, $j, @$arr);<br /> $arr->[0] ^= $arr->[$j-1];<br /> $arr->[$j-1] ^= $arr->[0];<br /> $arr->[0] ^= $arr->[$j-1];<br /> #$temp = $arr->[0];<br /> #$arr->[0] = $arr->[$j-1];<br /> #$arr->[$j-1] = $temp;<br /> }<br />}<br />my @arr = qw/13 -54 87123 82344 -23 3451 54 -3/;<br />my $n = $#arr + 1;<br />BigHeapSort($n, @arr);<br />say "@arr";