More efficient rounding

Makefile

@@ -1,3 +1,8 @@
 test:
 	dzil test
 
+tidy:
+	find . -name '*.p?.bak' -delete
+	find . -not -path "./.git*" -name '*.p[lm]' -o -name '*.t' | xargs perltidy -pro=/home/git/regentmarkets/cpan/rc/.perltidyrc --backup-and-modify-in-place -bext=tidyup
+	find . -name '*.tidyup' -delete
+

lib/Format/Util/Numbers.pm

@@ -9,7 +9,7 @@ our @EXPORT_OK = qw/commas to_monetary_number_format roundnear roundcommon finan
 
 use Carp qw(cluck);
 use Scalar::Util qw(looks_like_number);
-use POSIX qw(ceil);
+use POSIX qw(ceil log10);
 use YAML::XS;
 use File::ShareDir;
 use Math::BigFloat lib => 'Calc';
@@ -31,19 +31,22 @@ Format::Util::Numbers - Miscellaneous routines to do with manipulating number fo
 
 =head2 roundnear
 
-Round a number near the precision of the supplied one.
+(DEPRECATED) Round a number near the precision of the supplied one.
 
     roundnear( 0.01, 12345.678) => 12345.68
 
 =cut
 
 {
-    #cf. Math::Round
+    # cf. Math::Round
+    # https://github.com/psipred/MemSatSVM/blob/master/lib/Math/Round.pm
     my $halfdec = do {
         my $halfhex = unpack('H*', pack('d', 0.5));
         if (substr($halfhex, 0, 2) ne '00' && substr($halfhex, -2) eq '00') {
+            #--- It's big-endian.
             substr($halfhex, -4) = '1000';
         } else {
+            #--- It's little-endian.
             substr($halfhex, 0, 4) = '0010';
         }
         unpack('d', pack('H*', $halfhex));
@@ -71,7 +74,7 @@ Round a number near the precision of the supplied one.
 # format of precsion should be
 # TYPE:
 #   CURRENCY: PRECISION
-my $precisions = YAML::XS::LoadFile($ENV{FORMAT_UTIL_PRECISION} // File::ShareDir::dist_file('Format-Util', 'precision.yml'));
+my $precisions           = YAML::XS::LoadFile($ENV{FORMAT_UTIL_PRECISION} // File::ShareDir::dist_file('Format-Util', 'precision.yml'));
 my $floating_point_regex = qr/^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$/;
 
 =head2 commas
@@ -274,9 +277,9 @@ sub roundcommon {
         or (not defined $precision or $precision !~ /^(?:1(?:[eE][-]?[0-9]+)?|0(?:\.0*1)?)$/ or $precision == 0));
 
     # get the number of decimal places needed by BigFloat
-    $precision = log(1 / $precision) / log(10);
+    my $decimal_places = log10(1 / $precision);
 
-    return _round_to_precison($precision, $val);
+    return _round_to_precison($decimal_places, $val);
 }
 
 =head2 get_precision_config
@@ -313,12 +316,49 @@ sub get_min_unit {
     return formatnumber('price', $currency, 1 / 10**($precisions->{price}->{$currency}));
 }
 
-# common sub used by roundcommon and financialrounding
+=head2 _round_to_precison
+
+Rounds the given value up to C<decimal_places>
+For smaller values that fit into C<double> type,
+we'll calculate the rounded value here.
+L<Math::BigFloat> is used for bigger values.
+Numbers are rounded away from zero
+
+=over 4
+
+=item * C<decimal_places> Precsion for rounding
+
+=item * C<val> Value to round
+
+=back
+
+Returns pip sized string for the value
+
+=cut
+
 sub _round_to_precison {
-    my ($precision, $val) = @_;
+    my ($decimal_places, $val) = @_;
+
+    die unless $decimal_places >= 0;
+
+    if (
+        $decimal_places <= 6                          # Smallest pip size value we have: 0.000001 for XRP
+        && length(int $val) + $decimal_places < 15    # In doubles we ca hold up to 15 digits
+        )
+    {
+        my $pow = 10**$decimal_places;
+        my ($real, $fraction) = split /\./, ($val * $pow);
+        if ($fraction && substr($fraction, 0, 1) >= 5) {
+            $real += $real > 0 ? 1 : -1;              # Round away from zero
+        }
+        my $rounded = $real / $pow;
+        my $format  = "%." . $decimal_places . "f";
+        return sprintf($format, $rounded);            # No rounding occures here, only padding
+    }
 
+    # For number that require more decimal_places use BigFloat. It's way slower
     my $x = Math::BigFloat->bzero();
-    $x->badd($val)->bfround('-' . $precision, 'common');
+    $x->badd($val)->bfround('-' . $decimal_places, 'common');
 
     return $x->bstr();
 }

t/Numbers.t

@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 11;
 use Test::Exception;
 use Test::NoWarnings;
 
@@ -29,7 +29,13 @@ subtest 'roundcommon' => sub {
     cmp_ok(roundcommon(1e-10, 10.56783333331239), '==', 10.5678333333, 'Rounding with exponential precision');
     cmp_ok(roundcommon(0.01,  0.025),             '==', 0.03,          'Correct rounding, round away from zero');
     cmp_ok(roundcommon(0.01,  -0.025),            '==', -0.03,         'Correct rounding, round away from zero');
-    cmp_ok(roundcommon(0.001,  150.9065),         '==', 150.907,       'Correct rounding, handled floating point error');
+    cmp_ok(roundcommon(0.001, 150.9065),          '==', 150.907,       'Correct rounding, handled floating point error');
+
+    note 'Checke high precision and very small numbers with BigFloat';
+    cmp_ok(roundcommon(1e-18, "0.$_"), 'eq', "0.$_" . '00000000000000000', 'Numbers with big precision are correctly rounded as string') for (0 .. 9);
+    cmp_ok(roundcommon(1e-18, "0.00000000000000000$_"), 'eq', "0.00000000000000000$_", 'Very small numbers are correctly rounded as string')
+        for (0 .. 9);
+    cmp_ok(roundcommon(1e-8, "123456789.0000000$_"), 'eq', "123456789.0000000$_", 'aVery small numbers are correctly rounded as string') for (0 .. 9);
 };
 
 subtest 'commas' => sub {
@@ -39,10 +45,10 @@ subtest 'commas' => sub {
     is(commas(12345.6789, 3), '12,345.679',  '3 decimal commas is correct');
     is(commas(12345.6789, 4), '12,345.6789', '4 decimal commas is correct');
 
-    is(commas(12345.00, 0), '12,345',    '0 decimal commas is correct');
-    is(commas(12345,    0), '12,345',    '0 decimal commas is correct');
-    is(commas(1234567,  0), '1,234,567', 'integer value >1m is correct');
-    is(commas(1234567), '1,234,567', 'integer value >1m with no DP parameter is correct');
+    is(commas(12345.00, 0),   '12,345',       '0 decimal commas is correct');
+    is(commas(12345, 0),      '12,345',       '0 decimal commas is correct');
+    is(commas(1234567, 0),    '1,234,567',    'integer value >1m is correct');
+    is(commas(1234567),       '1,234,567',    'integer value >1m with no DP parameter is correct');
     is(commas(1234567.89, 2), '1,234,567.89', 'floating point value >1m is correct');
 
     is(commas('N/A',    4), 'N/A',        'Non-numeric commas returns same');
@@ -53,11 +59,11 @@ subtest 'commas' => sub {
 };
 
 subtest 'to_monetary_number_format' => sub {
-    is(to_monetary_number_format(undef),     '0.00',           'undef to_monetary_number_format is correct');
-    is(to_monetary_number_format('N/A'),     'N/A',            'nonnumeric to_monetary_number_format is correct');
-    is(to_monetary_number_format(123456789), '123,456,789.00', 'Integer to_monetary_number_format is correct');
+    is(to_monetary_number_format(undef),        '0.00',           'undef to_monetary_number_format is correct');
+    is(to_monetary_number_format('N/A'),        'N/A',            'nonnumeric to_monetary_number_format is correct');
+    is(to_monetary_number_format(123456789),    '123,456,789.00', 'Integer to_monetary_number_format is correct');
     is(to_monetary_number_format(123456789, 1), '123,456,789', 'Integer to_monetary_number_format is correct when requested to remove int decimals');
-    is(to_monetary_number_format(12345678.9), '12,345,678.90', 'One decimal to_monetary_number_format is correct');
+    is(to_monetary_number_format(12345678.9),   '12,345,678.90', 'One decimal to_monetary_number_format is correct');
     is(to_monetary_number_format(12345678.9, 1),
         '12,345,678.90', 'One decimal to_monetary_number_format is correct when requested to remove int decimals');
     is(to_monetary_number_format(1234567.89), '1,234,567.89', 'Two decimal to_monetary_number_format is correct');
@@ -132,7 +138,7 @@ subtest 'regression' => sub {
     foreach my $i (1 .. 100) {
         my $j = rand() * rand(100000);
         cmp_ok(roundnear(1 / $i, $j), '>=', 0, 'roundnear runs for (' . 1 / $i . ',' . $j . ')');
-        ok(commas($j, $i), 'commas runs for (' . $j . ',' . $i . ')');
+        ok(commas($j, $i),                'commas runs for (' . $j . ',' . $i . ')');
         ok(to_monetary_number_format($j), 'to_monetary_number_format runs for (' . $j . ')');
     }
 
@@ -142,6 +148,41 @@ subtest 'regression' => sub {
     }
 };
 
+subtest 'check numbers in range' => sub {
+    my $base      = '3.9760';
+    my $are_equal = 0;
+    for my $dec (0 .. 499) {
+        my $num     = sprintf("$base%03d", $dec);
+        my $rounded = roundcommon(1e-4, $num);
+        $are_equal = $rounded eq '3.9760';
+        ok($are_equal, "$num rounded correctly: $rounded");
+        last unless $are_equal;
+    }
+    for my $dec (500 .. 999) {
+        my $num     = sprintf("$base%d", $dec);
+        my $rounded = roundcommon(1e-4, $num);
+        $are_equal = $rounded eq '3.9761';
+        ok($are_equal, "$num rounded correctly: $rounded");
+        last unless $are_equal;
+    }
+
+    $base = 178568.0046;
+    for my $dec (0 .. 499) {
+        my $num     = sprintf("$base%03d", $dec);
+        my $rounded = roundcommon(1e-4, $num);
+        $are_equal = $rounded eq '178568.0046';
+        ok($are_equal, "$num rounded correctly: $rounded");
+        last unless $are_equal;
+    }
+    for my $dec (500 .. 999) {
+        my $num     = sprintf("$base%d", $dec);
+        my $rounded = roundcommon(1e-4, $num);
+        $are_equal = $rounded eq '178568.0047';
+        ok($are_equal, "$num rounded correctly: $rounded");
+        last unless $are_equal;
+    }
+};
+
 subtest 'get_min_unit' => sub {
 # Test minimum units
     is get_min_unit('USD'), formatnumber('price', 'USD', 0.01),       'Correct minimum unit for USD';