Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Re^2: Pointers needed to tweak a sort

by Lady_Aleena (Chaplain)
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
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 about the Monastery: (7)
As of 2014-09-30 22:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

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











    Results (385 votes), past polls