@sorted = sort { $a <=> $b } @numbers; # ascending order @sorted = sort { $b <=> $a } @numbers; # descending order #### @sorted = sort { $a cmp $b } @unsorted; #### @sorted = sort @unsorted; #### @sorted = sort { lc($a) cmp lc($b) } @unsorted; # or @sorted = sort { uc($a) cmp uc($b) } @unsorted; #### sub age_or_name { my ($name_a, $age_a) = split /_/ => $a; my ($name_b, $age_b) = split /_/ => $b; return ($age_a <=> $age_b or $name_a cmp $name_b); } @people = qw( Jeff_19 Jon_14 Ray_18 Tim_14 Joan_20 Greg_19 ); @sorted = sort age_or_name @people; # @sorted is now # qw( Jon_14 Tim_14 Ray_18 Greg_19 Jeff_19 Joan_20 ) #### @sorted = sort { ... } @strings; #### @nodes = ( { id => 17, size => 300, keys => 2, cmp => 'keys' }, { id => 14, size => 104, keys => 9, cmp => 'size' }, { id => 31, size => 2045, keys => 43, cmp => 'keys' }, { id => 28, size => 6, keys => 0, cmp => 'id' }, ); #### { my %cache; # cache hash is only seen by this function sub age_or_name { my $data_a = ($cache{$a} ||= [ split /_/ => $a ]); my $data_b = ($cache{$b} ||= [ split /_/ => $b ]); return ( $data_a->[1] <=> $data_b->[1] or $data_a->[0] <=> $data_b->[0] ); } } @people = qw( Jeff_19 Jon_14 Ray_18 Tim_14 Joan_20 Greg_19 ); @sorted = sort age_or_name @people; #### { my %cache; sub function { my $data_a = ($cache{$a} ||= mangle($a)); my $data_b = ($cache{$b} ||= mangle($b)); # compare as needed } } #### # sorts in-place (meaning @list gets changed) # set $unknown to true to indicate variable length radix_sort(\@list, $unknown); #### sub radix_sort { my ($data, $k) = @_; $k = !!$k; # turn any true value into 1 if ($k) { $k < length and $k = length for @$data } else { $k = length $data->[0] } while ($k--) { my @buckets; for (@$data) { my $c = substr $_, $k, 1; # get char $c = "\0" if not defined $c; push @{ $buckets[ord($c)] }, $_; } @$data = map @$_, @buckets; # expand array refs } } #### sub radix_sort (\@;$); radix_sort @list, $unknown; sub radix_sort (\@;$) { # ... } #### @names = qw( Jeff Jon Ray Tim Joan Greg ); @ages = qw( 19 14 18 14 20 19 ); @gender = qw( m m m m f m ); #### @names = qw( Jon Tim Ray Greg Jeff Joan ); @ages = qw( 14 14 18 19 19 20 ); @gender = qw( m m m m m f ); #### sub age_or_name { return ( $ages[$a] <=> $ages[$b] or $names[$a] cmp $names[$b] ) } #### @idx = sort age_or_name 0 .. $#ages; print "@ages\n"; # 19 14 18 14 20 19 print "@idx\n"; # 1 3 2 5 0 4 print "@ages[@idx]\n"; # 14 14 18 19 19 20 #### @sorted = map { get_original_data($_) } sort { ... } map { transform_data($_) } @original; #### username:password:shell:name:dir #### @sorted = map { $_->[0] } sort { $a->[3] cmp $b->[3] or $a->[4] cmp $b->[4] or $a->[1] cmp $b->[1] } map { [ $_, split /:/ ] } @entries; #### @transformed = map { [ $_, split /:/ ] } @entries; #### for (@entries) { push @transformed, [ $_, split /:/ ]; } #### @transformed = sort { $a->[3] cmp $b->[3] or $a->[4] cmp $b->[4] or $a->[1] cmp $b->[1] } @transformed; #### @sorted = map { $_->[0] } @transformed; #### @sorted = map { restore($_) } sort map { normalize($_) } @original; #### my $nulls = 0; # find length of longest run of NULs for (@original) { for (/(\0+)/g) { $nulls = length($1) if length($1) > $nulls; } } #### $NUL = "\0" x ++$nulls; #### # "\L...\E" is like lc(...) @normalized = map { "\L$_\E$NUL$_" } @original; #### @sorted = sort @normalized; #### @sorted = map { (split /$NUL/)[1] } @original; #### # implement our for loop from above # as a function $NUL = get_nulls(\@original); @sorted = map { (split /$NUL/)[1] } sort map { "\L$_\E$NUL$_" } @original; #### # see Exercise 1 for this function $maxlen = maxlen(\@original); #### @sorted = map { substr($_, $maxlen) } sort map { lc($_) . ("\0" x ($maxlen - length)) . $_ } @original; #### @sorted = { $a->[3] cmp $b->[3] or $a->[4] cmp $b->[4] or $a->[1] cmp $b->[1] } #### #!/usr/bin/perl -w #### package Sorting; #### sub passwd_cmp { $a->[3] cmp $b->[3] or $a->[4] cmp $b->[4] or $a->[1] cmp $b->[1] } #### sub case_insensitive_cmp { lc($a) cmp lc($b) } #### package main; #### @strings = sort Sorting::case_insensitive_cmp qw( this Mine yours Those THESE nevER ); #### print "<@strings>\n"; #### __END__ #### #!/usr/bin/perl -w #### package Sorting; #### sub passwd_cmp ($$) { local ($a, $b) = @_; $a->[3] cmp $b->[3] or $a->[4] cmp $b->[4] or $a->[1] cmp $b->[1] } #### sub case_insensitive_cmp ($$) { local ($a, $b) = @_; lc($a) cmp lc($b) } #### package main; #### @strings = sort Sorting::case_insensitive_cmp qw( this Mine yours Those THESE nevER ); #### print "<@strings>\n"; #### __END__