diff options
author | brian d foy <bdfoy@cpan.org> | 2009-11-19 17:56:12 -0600 |
---|---|---|
committer | brian d foy <bdfoy@cpan.org> | 2009-11-19 17:56:12 -0600 |
commit | e1d16ab77edac901d7fbfed3aa4b801de9f3325e (patch) | |
tree | 9d97b41aa38036afe8fde8ae51dc4d891b322c3c | |
parent | e507fdf52b6cc8b84c112b13ae72787f5ee1ffa2 (diff) | |
download | perl-e1d16ab77edac901d7fbfed3aa4b801de9f3325e.tar.gz |
* Fixed sort example using =(\d+)
The example wanted to sort a list like qw(=1 =2 =a =3 =d). One
example tried to be clever with array indices and precomputed
an array in @nums. However, it forgot to leave holes for the
elements where it could not extract a run of digits. Once the
indices were misaligned, the sort didn't give the right answer.
I know you can read the patch, but since I fixed whitespace too,
a simple diff gives you a lot of output. The old example had:
for (@old) {
push @nums, /=(\d+)/;
push @caps, uc($_);
}
The new one keeps the indices aligned by using undef when the
match failed:
for (@old) {
push @nums, ( /=(\d+)/ ? $1 : undef );
push @caps, uc($_);
}
This issue was reported on Stackoverflow:
http://stackoverflow.com/questions/1754441
-rw-r--r-- | pod/perlfunc.pod | 62 |
1 files changed, 31 insertions, 31 deletions
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index bacf296299..54684b5b8f 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -5329,87 +5329,87 @@ Examples: # sort lexically @articles = sort @files; - + # same thing, but with explicit sort routine @articles = sort {$a cmp $b} @files; - + # now case-insensitively @articles = sort {uc($a) cmp uc($b)} @files; - + # same thing in reversed order @articles = sort {$b cmp $a} @files; - + # sort numerically ascending @articles = sort {$a <=> $b} @files; - + # sort numerically descending @articles = sort {$b <=> $a} @files; - + # this sorts the %age hash by value instead of key # using an in-line function @eldest = sort { $age{$b} <=> $age{$a} } keys %age; - + # sort using explicit subroutine name sub byage { - $age{$a} <=> $age{$b}; # presuming numeric + $age{$a} <=> $age{$b}; # presuming numeric } @sortedclass = sort byage @class; - + sub backwards { $b cmp $a } @harry = qw(dog cat x Cain Abel); @george = qw(gone chased yz Punished Axed); print sort @harry; - # prints AbelCaincatdogx + # prints AbelCaincatdogx print sort backwards @harry; - # prints xdogcatCainAbel + # prints xdogcatCainAbel print sort @george, 'to', @harry; - # prints AbelAxedCainPunishedcatchaseddoggonetoxyz + # prints AbelAxedCainPunishedcatchaseddoggonetoxyz # inefficiently sort by descending numeric compare using # the first integer after the first = sign, or the # whole record case-insensitively otherwise - @new = sort { - ($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0] - || - uc($a) cmp uc($b) + my @new = sort { + ($b =~ /=(\d+)/)[0] <=> ($a =~ /=(\d+)/)[0] + || + uc($a) cmp uc($b) } @old; # same thing, but much more efficiently; # we'll build auxiliary indices instead # for speed - @nums = @caps = (); + my @nums = @caps = (); for (@old) { - push @nums, /=(\d+)/; - push @caps, uc($_); + push @nums, ( /=(\d+)/ ? $1 : undef ); + push @caps, uc($_); } - @new = @old[ sort { - $nums[$b] <=> $nums[$a] - || - $caps[$a] cmp $caps[$b] - } 0..$#old - ]; + my @new = @old[ sort { + $nums[$b] <=> $nums[$a] + || + $caps[$a] cmp $caps[$b] + } 0..$#old + ]; # same thing, but without any temps @new = map { $_->[0] } sort { $b->[1] <=> $a->[1] - || - $a->[2] cmp $b->[2] - } map { [$_, /=(\d+)/, uc($_)] } @old; + || + $a->[2] cmp $b->[2] + } map { [$_, /=(\d+)/, uc($_)] } @old; # using a prototype allows you to use any comparison subroutine # as a sort subroutine (including other package's subroutines) package other; sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here - + package main; @new = sort other::backwards @old; - + # guarantee stability, regardless of algorithm use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; - + # force use of mergesort (not portable outside Perl 5.8) use sort '_mergesort'; # note discouraging _ @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; |