Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: short sorts

by Arunbear (Parson)
on Mar 30, 2012 at 14:48 UTC ( #962629=note: print w/ replies, xml ) Need Help??


in reply to short sorts

Since you've already got ascending/descending options, passing in $a and $b seems redundant.

The options could be simplified by mimicking the regex flags e.g. assuming case sensitivity as the default i.e. 'i' meaning case insensitive and no 'i' meaning case sensitive. And also leaving out the hyphens.

It could be expanded by proving alternate equivalent options so you don't have to remember the order of them e.g. 'idr', 'rid' and 'dir' would all mean insensitive + descending + reversed.

Example:
#!/usr/bin/perl use strict; use feature qw(switch say); use List::Util qw(shuffle); sub short_sorter { my ($type) = @_; # Legend: # i = case insensitive # a = ascending # d = descending # r = reverse (right to left) # n = numbers # l = length of value my %sorter = ( 'a' => sub { $a cmp $b }, 'd' => sub { $b cmp $a }, ); given ($type) { when ([qw[dr rd]]) { $sorter{$type} = sub { reverse($b) cmp re +verse($a) }; } when ([qw[ar ra]]) { $sorter{$type} = sub { reverse($a) cmp re +verse($b) }; } when ([qw[ai ia]]) { $sorter{$type} = sub { uc $a cmp uc $b }; + } when ([qw[di id]]) { $sorter{$type} = sub { uc $b cmp uc $a }; + } when ([qw[an na]]) { $sorter{$type} = sub { $a <=> $b }; } when ([qw[nd dn]]) { $sorter{$type} = sub { $b <=> $a }; } when ([qw[la al]]) { $sorter{$type} = sub { length($a) <=> len +gth($b) }; } when ([qw[ld dl]]) { $sorter{$type} = sub { length($b) <=> len +gth($a) }; } when ([qw[air ari iar ira rai ria]]) { $sorter{$type} = sub { uc reverse($a) cmp uc reverse($b) } +; } when ([qw[dir dri idr ird rdi rid]]) { $sorter{$type} = sub { uc reverse($b) cmp uc reverse($a) } +; } } if ($type) { return $sorter{$type} or die 'AAARGH!!'; } else { return (shuffle values %sorter)[0]; } } my @unsorted = qw(red lilac yelloW green cyan blue magenta); my $criteria = short_sorter('dir'); my @sorted = sort $criteria @unsorted; print "$_\n" for @sorted; __DATA__ yelloW green cyan blue red lilac magenta

Update

The random option doesn't do the right thing in this version

Update 2

Corrected with respect to random option:
#!/usr/bin/perl use strict; use feature qw(switch say); use List::Util qw(shuffle); sub short_sorter { my ($type) = @_; # Legend: # i = case insensitive # a = ascending # d = descending # r = reverse (right to left) # n = numbers # l = length of value my %sorter = ( a => sub { $a cmp $b }, d => sub { $b cmp $a }, ai => sub { uc $a cmp uc $b }, di => sub { uc $b cmp uc $a }, an => sub { $a <=> $b }, dn => sub { $b <=> $a }, al => sub { length($a) <=> length($b) }, dl => sub { length($b) <=> length($a) }, ar => sub { reverse($a) cmp reverse($b) }, dr => sub { reverse($b) cmp reverse($a) }, air => sub { uc reverse($a) cmp uc reverse($b) }, dir => sub { uc reverse($b) cmp uc reverse($a) }, ); given ($type) { when ('dr') { $sorter{$type} = $sorter{dr} } when ('ra') { $sorter{$type} = $sorter{ar} } when ('ia') { $sorter{$type} = $sorter{ai} } when ('id') { $sorter{$type} = $sorter{di} } when ('na') { $sorter{$type} = $sorter{an} } when ('nd') { $sorter{$type} = $sorter{dn} } when ('la') { $sorter{$type} = $sorter{al} } when ('ld') { $sorter{$type} = $sorter{dl} } when ([qw[ari iar ira rai ria]]) { $sorter{$type} = $sorter{air}; } when ([qw[dri idr ird rdi rid]]) { $sorter{$type} = $sorter{dir}; } } if ($type) { return $sorter{$type} or die "Unknown options: $type"; } else { return (shuffle values %sorter)[0]; } } my @unsorted = qw(red lilac yelloW green cyan blue magenta); my $criteria = short_sorter('dri'); my @sorted = sort $criteria @unsorted; print "$_\n" for @sorted;


Comment on Re: short sorts
Select or Download Code
Re^2: short sorts
by Lady_Aleena (Chaplain) on Mar 30, 2012 at 18:39 UTC

    Thank you for pointing out that the options should not be so rigid Arundear. I changed the dispatch table to include the option variations, even though I did not use switch like you did. I also kept case sensitive in because I like it. (I know that is not the best reason, but it is why case sensitivity is still there.)

    sub short_sorts { my ($a,$b,$type) = @_; # Legend: # s = case sensitive # i = case insensitive # a = ascending # d = descending # r = reverse (right to left) # n = numbers # l = length of value my %sorts; $sorts{$_} = sub { $_[0] cmp $_[1] } for qw(sa as); $sorts{$_} = sub { $_[1] cmp $_[0] } for qw(sd ds); $sorts{$_} = sub { uc $_[0] cmp uc $_[1] } for qw(ia ai); $sorts{$_} = sub { uc $_[1] cmp uc $_[0] } for qw(id di); $sorts{$_} = sub { $_[0] <=> $_[1] } for qw(na an); $sorts{$_} = sub { $_[1] <=> $_[0] } for qw(nd dn); $sorts{$_} = sub { reverse($_[0]) cmp reverse($_[1]) } for qw(sar sr +a asr ars rsa ras); $sorts{$_} = sub { reverse($_[1]) cmp reverse($_[0]) } for qw(sdr sr +d dsr drs rsd rds); $sorts{$_} = sub { uc reverse($_[0]) cmp uc reverse($_[1]) } for qw( +iar ira air ari ria rai); $sorts{$_} = sub { uc reverse($_[1]) cmp uc reverse($_[0]) } for qw( +idr ird dir dri rid rdi); $sorts{$_} = sub { reverse $_[0] <=> reverse $_[1] } for qw(nar nra +anr arn rna ran); $sorts{$_} = sub { reverse $_[1] <=> reverse $_[0] } for qw(ndr nrd +dnr drn rnd rdn); $sorts{$_} = sub { length($_[0]) <=> length($_[1]) } for qw(la al); $sorts{$_} = sub { length($_[1]) <=> length($_[0]) } for qw(ld dl); if ($type) { croak "$type is not supported" if !exists $sorts{$type}; return $sorts{$type}->($a,$b); } else { # A random sort was here, however, it was not acting as expected, +so the die is being used. die "A sort type was not selected."; } }

    I'm still passing $a and $b since there are times where I am sorting hashes by a key within a hash of hashes.

    (sort { short_sorts($master_list{$a}{members},$master_list{$b}{members},'nd' +) || short_sorts($a,$b,'ia') } keys %master_list)

    I am not sure how I am going to combine those just yet.

    Have a cookie and a very nice day!
    Lady Aleena

      In what way does the random sort not work?

      Just for fun, an example of going functional ;)
      #!/usr/bin/perl use strict; use Data::Dump qw(dd pp); use List::Util qw(reduce shuffle); # the composables sub Cmp { my ($x, $y) = @_; $x cmp $y } sub Ncmp { my ($x, $y) = @_; $x <=> $y } sub Reverse { map { scalar reverse $_ } @_ } sub Length { map { length $_ } @_ } sub Uc { map { uc $_ } @_ } sub Transpose { reverse @_ } sub Ab { ($a, $b) } # naive composer using evil # composes functions f, g, h into sub { f(g(h(@_))) } sub Compose { my $body = reduce { "$b($a)" } '@_', reverse @_; eval "sub { $body }" or die $@; } # special case for sort sub Compose_ab { Compose(@_, 'Ab') } sub sorter { my ($type, $src) = @_; # Legend: # i = case insensitive # a = ascending # d = descending # r = reverse (right to left) # n = numbers # l = length of value my %sorter = ( a => [qw/Cmp/], d => [qw/Cmp Transpose/], ai => [qw/Cmp Uc/], di => [qw/Cmp Uc Transpose/], an => [qw/Ncmp/], dn => [qw/Ncmp Transpose/], al => [qw/Ncmp Length/], dl => [qw/Ncmp Length Transpose/], ar => [qw/Cmp Reverse/], dr => [qw/Cmp Reverse Transpose/], air => [qw/Cmp Uc Reverse/], dir => [qw/Cmp Uc Reverse Transpose/], ); my @composed; if ($type) { $type = join '', sort split //, $type; # normalize @composed = @{ $sorter{$type} } or die "Unknown option: $type"; if ($src) { push @composed, $src; } } else { @composed = @{ (shuffle values %sorter)[0] }; warn 'random criteria: ' . pp @composed; } return Compose_ab(@composed); } my @unsorted = qw(red lilac yelloW Green cyan blue magenta); my $sort_type = shift; my $criteria = sorter($sort_type); dd sort $criteria @unsorted; my %master_list = ( alpha => { members => 1 }, beta => { members => 3 }, gamma => { members => 8 }, delta => { members => 5 }, ); # custom source for $a, $b sub Members { map { $master_list{$_}{members} } @_ } $criteria = sorter($sort_type, 'Members'); dd sort $criteria keys %master_list;

        Arunbear, you seem to be having some fun with this, though you have really made it explode beyond a simple silly subroutine that I plopped into my Nifty module. (My Nifty module is where I put subroutines that I use, but can't categorize anywhere else.) What you have written looks like it would have to be put in a stand alone module. You have added a lot of complexity that I am having a hard time following. It could be that I am having a hard time seeing past my own dispatch table.

        I am not entirely sure what you mean when you say that you are making this functional. It could be that I see "subroutine", "sub", and "function" used almost interchangeably that I am not picking up on the subtle differences between them.

        As to why the random sort is not acting as expected, I am not sure I can explain the results I was seeing returned. The best I can do is say that it was getting new sort parameters for each iteration of the list while it was being sorted. I also had trouble keeping numerical sorts out of the mix which of course would throw up all kinds of warnings when non-numbers were being sorted.

        I hope that you found the idea useful and are using it. Thank you for taking the time to play with this and show me what else can be done. Really silly sorts like sorting from the second character or third to the last character will wait until later. I was thinking about assigning hex and ord numbers to each character and sort them that way, but I think that would be the same as a straight up $a cmp $b.

        Have a cookie and a very nice day!
        Lady Aleena

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://962629]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (13)
As of 2014-09-18 19:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (121 votes), past polls