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

Re^2: Pointers needed to tweak a sort

by Lady_Aleena (Deacon)
on Jul 04, 2012 at 05:40 UTC ( #979820=note: print w/ replies, xml ) Need Help??


in reply to Re: Pointers needed to tweak a sort
in thread Pointers needed to tweak a sort

ambrus, I hope I'm using this as you intended. I separated out the subroutines into a module, and use them where ever I need them. I use hashes of hashes instead of arrays of hashes, but I did not have to rewrite your code to make it work, though I renamed the subroutines and moved @networks and $network_string inside the list_sortflags subroutine.

package Twitter::ListSort; use strict; use warnings FATAL => qw( all ); use base 'Exporter'; our @EXPORT_OK = qw(list_sortflags list_compare); # Written by ambrus on PerlMonks. use Base::Nifty qw(my_sort); # Write a function to precompute all those boolean keys you want to # sort by. This should be an improvement because now the code has # each condition only once, not twice, so we reduced code duplication. # The key is just a string of "0" and "1" characters. For simplicity, # we store the key right into the record. sub list_sortflags { my($s) = @_; my @networks = qw(ABC CBS FOX NBC SyFy TNT USA); my $network_string = join('|',@networks); my @k; push @k, ( !($s->{user} =~ /LadyAleena_($network_string|TV)/ && $s->{name} !~ + /TV/), !($s->{user} =~ /LadyAleena_($network_string)/ && $s->{name} =~ /T +V shows$/), !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'Premium TV shows +'), !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV shows'), !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV networks'), !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV authors'), !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Comedians|Musicia +ns)/), !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Horror|Science fi +ction)/), !($s->{user} eq 'Lady_Aleena' && $s->{name} eq 'Ripley\'s & Guinne +ss'), !($s->{user} eq 'LadyAleena_home'), !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Followers' busine +sses|List subscribers)/), ); my $k = join "", map { $_ ? "1" : "0" } @k; $$s{sortflag} = $k; } # Now do the sort relying on the key we computed. Note that as # the compare function is still non-trivial, I don't write its # body in the same line as the sort, because that's ugly. sub list_compare { my($a, $b) = @_; return $$a{sortflag} cmp $$b{sortflag} || my_sort($$a{name}, $$b{name}, "article"); } 1;

This is how it is used in a script.

#!/usr/bin/perl use strict; use warnings FATAL => qw( all ); use lib '../files/perl/lib'; use Base::Data qw(data_file get_hash); use Twitter qw(twitter_accounts); use Twitter::ListSort qw(list_sortflags list_compare); my %lists; for my $account (twitter_accounts) { my $account_list_file = data_file("Twitter/users/$account","lists.tx +t"); if (-s $account_list_file) { my %sublists = get_hash( file => $account_list_file, headings => [qw(id slug name user members mem_change subscribers + sub_change status)], ); for (keys %sublists) { next if $sublists{$_}{status} ne 'owner'; $lists{$_} = $sublists{$_}; } } } for my $list (values %lists) { list_sortflags($list); } for my $list (sort { list_compare($a,$b) } values %lists) { local $\ = "\n"; my $name = $list->{name}; my $user = $list->{user}; print "$name ($user)"; }
Have a cookie and a very nice day!
Lady Aleena


Comment on Re^2: Pointers needed to tweak a sort
Select or Download Code
Replies are listed 'Best First'.
Re^3: Pointers needed to tweak a sort
by ambrus (Abbot) on Jul 05, 2012 at 14:40 UTC

    By the way, if you wanted only up to one of those conditions to match, then you don't need all this complication with a string of zeros and ones. Just have the key be a single number you just compare with spaceship. Something like this, untested:

    ... sub list_sortflags { my($s) = @_; my @networks = ...; my $network_string = ...; my $k; if ($s->{user} =~ /LadyAleena_($network_string|TV)/ && $s->{name} !~ + /TV/) { $k = 1; } elsif ($s->{user} =~ /LadyAleena_($network_string)/ && $s->{name} =~ + /TV shows$/) { $k = 2; } elsif ($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'Premium TV sh +ows') { $k = 3; } elsif ($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV shows') { $k = 4; } ... elsif ($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Followers' bus +inesses|List subscribers)/) { $k = 11; } else { $k = 12; } $$s{sortflag} = $k; } ... sub list_compare { my($a, $b) = @_; return $$a{sortflag} <=> $$b{sortflag} || my_sort($$a{name}, $$b{name}, "article"); } ...

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (15)
As of 2015-07-07 19:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls