view release on metacpan or  search on metacpan

Units/Rank.pm  view on Meta::CPAN

package Math::Calc::Units::Rank;
use base 'Exporter';
use vars qw(@EXPORT_OK);
BEGIN { @EXPORT_OK = qw(choose_juicy_ones render render_unit); }

use Math::Calc::Units::Convert qw(convert canonical);
use Math::Calc::Units::Convert::Multi qw(variants major_variants major_pref pref_score range_score get_class);
use strict;

# choose_juicy_ones : value -> ( value )
#
# Pick the best-sounding units for the given value, and compute the
# resulting magnitude and score. The total number returned is based on
# a magical formula that examines the rates of decay of the scores.
#
sub choose_juicy_ones {
    my ($v, $options) = @_;

    # Collect the variants of the value, together with their scores.
    my @variants = rank_variants($v, $options); # ( < {old=>new}, score > )

    # Remove duplicates
    my %variants; # To remove duplicates: { id => [ {old=>new}, score ] }
    for my $variant (@variants) {
	my $id = join(";;", values %{ $variant->[0] });
	$variants{$id} = $variant;
    }

    my @options;
    for my $variant (values %variants) {
	my ($map, $score) = @$variant;
	my %copy;
        my ($magnitude, $units) = @$v;
	while (my ($unit, $count) = each %$units) {
	    $copy{$map->{$unit}} = $count;
	}
	push @options, [ $score, convert($v, \%copy) ];
    }

    # Pick up to five of the highest scores. If any score is less than
    # 1/10 of the previous score, or 1/25 of the highest score, then
    # don't bother returning it (or anything worse than it.)
    my @juicy;
    my $first;
    my $prev;
    foreach (sort { $b->[0] <=> $a->[0] } @options) {
        my ($score, $val) = @$_;
        last if (defined $prev && ($prev / $score) > 8);
        last if (defined $first && ($first / $score) > 25);
        push @juicy, $val;
        $first = $score unless defined $first;
        $prev = $score;
        last if @juicy == 5;
    }

    return @juicy;
}

# rank_variants : <amount,unit> -> ( < map, score > )
# where map : {original unit => new unit}
#
sub rank_variants {
    my ($v, $options) = @_;

    $v = canonical($v);

    my ($mag, $count) = @$v;

    my @rangeable = grep { $count->{$_} > 0 } keys %$count;
    if (@rangeable == 0) {
	@rangeable = keys %$count;
    }

    return rank_power_variants($mag, \@rangeable, $count, $options);