summaryrefslogtreecommitdiffstats
path: root/lib/Math/Decimal/FastPP.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Math/Decimal/FastPP.pm')
-rw-r--r--lib/Math/Decimal/FastPP.pm208
1 files changed, 208 insertions, 0 deletions
diff --git a/lib/Math/Decimal/FastPP.pm b/lib/Math/Decimal/FastPP.pm
new file mode 100644
index 0000000..ad1e7f8
--- /dev/null
+++ b/lib/Math/Decimal/FastPP.pm
@@ -0,0 +1,208 @@
+=head1 NAME
+
+Math::Decimal::FastPP - Fast pure-Perl decimal arithmetic
+
+=head1 SYNOPSIS
+
+ use Math::Decimal::FastPP;
+
+ $a = dadd($a, "1.23"); # $a += 1.23
+ $c = dmul($a, $b); # $c = $a * $b
+ $a = drhtz($a); # Round half towards zero
+
+=head1 DESCRIPTION
+
+Math::Decimal::FastPP provides a few common decimal arithmetic functions written
+in pure Perl. The functions are of course slower than Perl's built-in binary
+floating-point arithmetic, but they're faster than L<Math::BigFloat> and other
+commonly used decimal arithmetic modules.
+
+This module is currently less complete than Perl's built-in arithmetic and other
+decimal arithmetic modules. So far it only includes addition, multiplication,
+and rounding functions.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=cut
+
+use strict;
+use warnings;
+
+package Math::Decimal::FastPP;
+
+use Exporter qw(import);
+our @EXPORT = qw(dadd dmul drhtz drhfz);
+
+our $VERSION = "0.001";
+
+=item dadd()
+
+ $c = dadd($a, $b);
+
+Adds C<$a> and C<$b> and returns their sum.
+
+=cut
+
+sub dadd
+{
+ my ($ai, $af) = split("\\.", $_[0]);
+ my ($bi, $bf) = split("\\.", $_[1]);
+ $af ||= "";
+ $bf ||= "";
+ my $ae = length($af);
+ my $be = length($bf);
+ my $ce;
+ if ($ae == $be) {
+ $ce = $ae;
+ } elsif ($ae < $be) {
+ $af .= "0" x ($be - $ae);
+ $ce = $be;
+ } else {
+ $bf .= "0" x ($ae - $be);
+ $ce = $ae;
+ }
+ my $as = $ai . $af;
+ my $bs = $bi . $bf;
+ my $cs = $as + $bs;
+ $cs = sprintf("%0${ce}i", $cs);
+ # The substr() code is 400% faster than this regular expression code.
+ #$cs =~ s/(.{$ce})$/.$1/;
+ #return $cs;
+ return substr($cs, 0, length($cs) - $ce) . "." .
+ substr($cs, length($cs) - $ce);
+}
+
+=item dmul()
+
+ $c = dmul($a, $b);
+
+Multiplies C<$a> and C<$b> and returns their product.
+
+=cut
+
+sub dmul
+{
+ my ($ai, $af) = split("\\.", $_[0]);
+ my ($bi, $bf) = split("\\.", $_[1]);
+ $af ||= "";
+ $bf ||= "";
+ my $as = $ai . $af;
+ my $ae = length($af);
+ my $bs = $bi . $bf;
+ my $be = length($bf);
+ my $cs = $as * $bs;
+ my $ce = $ae + $be;
+ $cs = sprintf("%0${ce}i", $cs);
+ # The substr() code is 400% faster than this regular expression code.
+ #$cs =~ s/(.{$ce})$/.$1/;
+ #return $cs;
+ return substr($cs, 0, length($cs) - $ce) . "." .
+ substr($cs, length($cs) - $ce);
+}
+
+=item drhtz()
+
+ $a = drhtz($a, $p);
+
+Rounds C<$a> with precision C<$p>. Halves are rounded towards zero. For
+example:
+
+ drhtz("23.5", 0); # Returns "23."
+ drhtz("2.35", 1); # Returns "2.3"
+ drhtz("-23.5", 0); # Returns "-23."
+ drhtz("-2.35", 1); # Returns "-2.3"
+
+C<$p> is a non-negative (i.e. zero or positive) integer representing the number
+of significant digits right of the radix point.
+
+=cut
+
+sub drhtz
+{
+ my ($ai, $af, $ad) = $_[0] =~ m/^(.*)\.(.{$_[1]})(.*)$/ or return;
+ my $as = $ai . $af;
+ ++$as if $ad > "5" . "0" x (length($ad) - 1);
+ $as = sprintf("%0$_[1]i", $as);
+ # The substr() code is 400% faster than this regular expression code.
+ #$as =~ s/(.{$_[1]})$/.$1/;
+ #return $cs;
+ return substr($as, 0, length($as) - $_[1]) . "." .
+ substr($as, length($as) - $_[1]);
+}
+
+=item drhfz()
+
+ $a = drhfz($a, $p);
+
+Rounds C<$a> with precision C<$p>. Halves are rounded away from zero. For
+example:
+
+ drhfz("23.5", 0); # Returns "24."
+ drhtz("2.35", 1); # Returns "2.4"
+ drhfz("-23.5", 0); # Returns "-24."
+ drhtz("-2.35", 1); # Returns "-2.4"
+
+C<$p> is a non-negative (i.e. zero or positive) integer representing the number
+of significant digits right of the radix point.
+
+=cut
+
+sub drhfz
+{
+ my ($ai, $af, $ad) = $_[0] =~ m/^(.*)\.(.{$_[1]})(.*)$/ or return;
+ my $as = $ai . $af;
+ ++$as if $ad >= "5" . "0" x (length($ad) - 1);
+ $as = sprintf("%0$_[1]i", $as);
+ # The substr() code is 400% faster than this regular expression code.
+ #$as =~ s/(.{$_[1]})$/.$1/;
+ #return $as;
+ return substr($as, 0, length($as) - $_[1]) . "." .
+ substr($as, length($as) - $_[1]);
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 CAVEATS
+
+These arithmetic functions preserve all significant fractional digits, including
+trailing zeroes. They also don't always add a leading zero before the radix
+point for numbers with absolute values less than one. So the output numbers can
+look "ugly", like ".123000". This is only an issue if the numbers (which are
+returned as strings) are concatenated into other strings or printed without
+formatting. If this is an issue in your code, use the outputs as numbers (e.g.
+C<$c + 0>) or print with formatting (with C<printf>).
+
+=head1 AUTHOR
+
+Patrick McDermott <patrick.mcdermott@libiquity.com>
+
+=head1 SEE ALSO
+
+L<Math::BigFloat>, L<Math::Decimal>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2017 Patrick McDermott
+
+=head1 LICENSE
+
+This program is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+=cut