Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

List::Ranking

by miyagawa (Chaplain)
on Dec 10, 2001 at 20:15 UTC ( [id://130687]=perlmeditation: print w/replies, xml ) Need Help??

Now preparing module to calculate a ranking of a list, named List::Ranking. Request For Comments, especially about its API.

Current tarball can be fetched from: here.

package List::Ranking; use strict; use vars qw($VERSION); $VERSION = '0.01'; sub new { my($class, $hashref) = @_; $class->_real_new( _data => $hashref, _asc => 0, ); } sub new_ascending { my($class, $hashref) = @_; $class->_real_new( _data => $hashref, _asc => 1, ); } sub _real_new { my($class, %args) = @_; my $self = bless { _data => $args{_data}, _asc => $args{_asc}, _order => [], _ranking => {}, }, $class; $self->_calc; return $self; } sub _calc { my $self = shift; # first using perl's builtin sort() my $sorter = $self->_sorter; my $prev; my $rank = 1; my $curr = 1; for my $key (sort $sorter keys %{$self->{_data}}) { push @{$self->{_order}}, $key; if (defined $prev && $prev == $self->{_data}->{$key}) { $self->{_ranking}->{$key} = $curr; } else { $self->{_ranking}->{$key} = $rank; $curr = $rank; } $rank++; # keep it as previous $prev = $self->{_data}->{$key}; } } sub _sorter { my $self = shift; return $self->{_asc} ? sub { $self->{_data}->{$a} <=> $self->{_data}->{$b} } : sub { $self->{_data}->{$b} <=> $self->{_data}->{$a} }; } sub order { my $self = shift; return @{$self->{_order}}; } sub ranking { my($self, $key) = @_; return $self->{_ranking}->{$key}; } 1; __END__ =head1 NAME List::Ranking - Class for calculating ranking of a list =head1 SYNOPSIS use List::Ranking; my %data = ( 'slashdot.org' => 180, 'cpan.org' => 150, 'perl.com' => 150, 'apache.org' => 120, ); my $rank = List::Ranking->new(\%data); for my $key ($rank->order) { print "$key:\tvalue=$data{$key} ranking=", $rank->ranking($key), "\n"; } # this script will output: slashdot.org: value=180 ranking=1 cpan.org: value=150 ranking=2 perl.com: value=150 ranking=2 apache.org: value=120 ranking=4 =head1 DESCRIPTION Simple ranking calculation can be done by using perl's builtin C<sort> function. But it can be more complex when you should consider ranking of multiple records with same value. List::Ranking provides an easy way to calculate ranking of a list, with a care for the same value problem. =head1 METHODS This module currently implements following methods. I don't think this API is complete, so it may be changed in near future. Let me know if you have a better idea for the interface. =over 4 =item new, new_ascending $rank = List::Ranking->new($hashref); $rank = List::Ranking->new_ascending($hashref); Cnostructs new List::Ranking object. List should be given as a hash reference, whose value is the list of the target to calculate. C<new_decending> calculates ranking with ascending order. =item ranking $ranking = $rank->ranking($key); returns ranking of a specific record. =item order @keys = $rank->order; returns an array of the key, sorted by ranking. =back =head1 AUTHOR Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt> This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L<perl> =cut

--
Tatsuhiko Miyagawa
miyagawa@cpan.org

Replies are listed 'Best First'.
Re: List::Ranking
by merlyn (Sage) on Dec 10, 2001 at 20:28 UTC
    I usually just code this in-line. A module seems overkill:
    my %data = ( 'slashdot.org' => 180, 'cpan.org' => 150, 'perl.com' => 150, 'apache.org' => 120, ); my @ranks; my @keys = keys %data; @ranks[ sort { $data{$keys[$b]} cmp $data{$keys[$a]} } 0..$#keys ] = 1 +..@keys; print "key $keys[$_] has rank $ranks[$_]\n" for 0..$#ranks;
    </code>

    -- Randal L. Schwartz, Perl hacker

      Usually do I also. But this code doesn't care the fact that "cpan.org" and "perl.com" have the same value (150). What this module does is that.

      --
      Tatsuhiko Miyagawa
      miyagawa@cpan.org

        Right. So instead, try this:

        my %data = ( 'slashdot.org' => 180, 'cpan.org' => 150, 'perl.com' => 150, 'apache.org' => 120, ); my @keys = keys %data; # invert the %data hash, creating arrayrefs each with list # of elements with the same ranking my %ranks; push @{$ranks{$data{$_}}}, $_ for @keys; # count/sort the rankings my @ranks = reverse sort {$a<=>$b} keys %ranks; for my $rank ( 0 .. $#ranks ) { # print them my @tied = @{$ranks{ $ranks[$rank] }}; if (@tied > 1) { # more than one with this ranking local $"=', '; my $last = pop @tied; print "@tied and $last all have rank ". 1+$ranks[$rank] ."\n"; } else { print "@tied has rank ". 1+$ranks[$rank] ."\n"; } }

        Update: Rankings should be 1-based.

        dmm

        You can give a man a fish and feed him for a day ...
        Or, you can
        teach him to fish and feed him for a lifetime
Re: List::Ranking
by dragonchild (Archbishop) on Dec 10, 2001 at 20:59 UTC
    Why not make this a tie'd array, with the appropriate sorting done. Then, each element of the array would, instead, be a bucket. So, if you wanted all the things that were in the 3rd ranking, you could get them appropriately.

    I guess I don't see why you stopped at just what you have there. Instead, I would have gone further and allowed more manipulation.

    ------
    We are the carpenters and bricklayers of the Information Age.

    Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://130687]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (9)
As of 2024-04-19 08:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found