view release on metacpan or  search on metacpan

Units/Convert/Base.pm  view on Meta::CPAN

    }
}

# canonical_unit : void -> unit name
#
# Return the canonical unit for this class.
#
sub canonical_unit {
    return;
}

sub abbreviated_canonical_unit {
    my ($self) = @_;
    return $self->canonical_unit;
}

#################### RANKING, SCORING, DISPLAYING ##################

# spread : magnitude x base unit x units to spread over
#  -> ( <mag,unit> )
#
# @$units MUST BE SORTED, LARGER UNITS FIRST!
#
my $THRESHOLD = 0.01;
sub spread {
    my ($self, $mag, $base, $start, $units) = @_;
    die if $mag < 0; # Must be given a positive value!
    return [ 0, $base ] if $mag == 0;

    my $orig = $mag;

    my @desc;
    my $started = 0;
    foreach my $unit (@$units) {
	$started = 1 if $unit eq $start;
	next unless $started;

	last if ($mag / $orig) < $THRESHOLD;
	my $mult = $self->simple_convert($unit, $base);
	my $n = int($mag / $mult);
	next if $n == 0;
	$mag -= $n * $mult;
	push @desc, [ $n, $unit ];
    }

    return @desc;
}

# range_score : amount x unitName -> score
#
# Returns 1 if the value is in range for the unit, 0.1 if the value is
# infinitely close to being in range, and decaying to 0.001 as the
# value approaches infinitely far away from the range.
#
# For the outside of range values, I convert to log space (so 1/400 is
# just as far away from 1 as 400 is). I then treat the allowed range
# as a one standard deviation wide segment of a normal distribution,
# and use appropriate modifiers to make the result range from 0.001 to
# 0.1.
#
# The above formula was carefully chosen from thousands of
# possibilities, by picking things at random and scribbling them down
# on a piece of paper, then pouring sparkling apple cider all over and
# using the one that was still readable.
#
# Ok, not really. Just pretend that I went to that much trouble.
#
sub range_score {
    my ($self, $val, $unitName) = @_;
    my $ranges = $self->get_ranges();
    my $range = $ranges->{$unitName} || $ranges->{default};

    # Return 1 if it's in range
    if ($val >= $range->[0]) {
	if (! defined $range->[1] || ($val <= $range->[1])) {
	    return 1;
	}
    }

    $val = _sillylog($val);

    my $r0 = _sillylog($range->[0]);
    my $r1;
    if (defined $range->[1]) {
	$r1 = _sillylog($range->[1]);
    } else {
	$r1 = 4;
    }

    my $width = $r1 - $r0;
    my $mean = ($r0 + $r1) / 2;
    my $stddev = $width / 2;

    my $n = ($val - $mean) / $stddev; # Normalized value

    our $mulconst;
    $mulconst ||= 0.999 * exp(1/8);

    return 0.001 + $mulconst * exp(-$n**2/2);
}

# Infinity-free logarithm
sub _sillylog {
    my $x = shift;
    return log($x) if $x;
    return log(1e-50);
}

# pref_score : unitName -> score
#
# Maps a unit name (eg week) to a score. Higher scores are more likely
# to be chosen.
sub pref_score {
    my ($self, $unitName) = @_;
    my $prefs = $self->get_prefs();
    my $specific = $prefs->{$unitName};
    return defined($specific) ? $specific : $prefs->{default};
}

# get_prefs : void -> { unit name => score }
#