File Coverage

blib/lib/Math/SigFigs.pm

Criterion	Covered	Total	%
statement	161	161	100.0
branch	98	98	100.0
condition	23	23	100.0
subroutine	14	14	100.0
pod	6	6	100.0
total	302	302	100.0

package Math::SigFigs;

# Copyright (c) 1995-2016 Sullivan Beck. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

########################################################################

require 5.004;
require Exporter;
use Carp;
use strict;
use warnings;

our (@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
use base qw(Exporter);
@EXPORT     = qw(FormatSigFigs
                 CountSigFigs
               );
@EXPORT_OK  = qw(FormatSigFigs
                 CountSigFigs
                 addSF subSF multSF divSF
                 VERSION);

%EXPORT_TAGS = ('all' => \@EXPORT_OK);

our($VERSION);
$VERSION='1.20';

use strict;

sub addSF {
   my($n1,$n2)=@_;
   _add($n1,$n2,0);
}

sub subSF {
   my($n1,$n2)=@_;
   _add($n1,$n2,1);
}

sub _add {
   my($n1in,$n2in,$sub) = @_;

   my($n1,$sig1,$lsp1,$s1,$int1,$dec1,$n2,$sig2,$lsp2,$s2,$int2,$dec2);

   if (defined($n1in)) {
      ($n1,$sig1,$lsp1,$s1,$int1,$dec1) = _Simplify($n1in);
   }
   return   if (! defined($n1));

   if (defined($n2in)) {
      ($n2,$sig2,$lsp2,$s2,$int2,$dec2) = _Simplify($n2in);
   }
   return   if (! defined($n2));

   if ($sub) {
      if ($n2<0) {
         $n2 =~ s/\-//;
         $s2 = '';
      } elsif ($n2 > 0) {
         $n2 =~ s/^\+?/-/;
         $s2 = '-';
      }
   }

   return $n2    if ($n1in eq '0');
   return $n1    if ($n2in eq '0');

   my $lsp = ($lsp1 > $lsp2 ? $lsp1 : $lsp2);

   ($n1) = _ToExp($s1,$int1,$dec1,$lsp);
   ($n2) = _ToExp($s2,$int2,$dec2,$lsp);

   my($n,$sig,$tmp,$s,$int,$dec) = _Simplify($n1+$n2);
   $n = sprintf("%.0f",$n) . ".e$lsp";
   ($n,$sig,$lsp,$tmp,$int,$dec) = _Simplify("${n}");
   return $n;
}

sub multSF {
   my($n1,$n2)=@_;
   my($sig1,$sig2);

   if (defined($n1)) {
      ($n1,$sig1) = _Simplify($n1);
   }
   return   if (! defined($n1));

   if (defined($n2)) {
      ($n2,$sig2) = _Simplify($n2);
   }
   return   if (! defined($n2));

   my $sig = ($sig1 < $sig2 ? $sig1 : $sig2);
   my($n)  = $n1*$n2;
   FormatSigFigs($n,$sig);
}

sub divSF {
   my($n1,$n2)=@_;
   my($sig1,$sig2);

   if (defined($n1)) {
      ($n1,$sig1) = _Simplify($n1);
   }
   return   if (! defined($n1));

   if (defined($n2)) {
      ($n2,$sig2) = _Simplify($n2);
   }
   return   if (! defined($n2)  ||  $n2 == 0);

   my $sig = ($sig1 < $sig2 ? $sig1 : $sig2);
   my($n)  = $n1/$n2;
   FormatSigFigs($n,$sig);
}

sub FormatSigFigs {
   my($N,$n) = @_;
   return ''  if ($n !~ /^\d+$/  ||  $n == 0);

   my($ret,$sig,$lsp,$s,$int,$dec);
   ($N,$sig,$lsp,$s,$int,$dec) = _Simplify($N);
   return ""  if (! defined($N));
   return '0.0'  if ($N==0  &&  $n==1);

   return $N  if ($sig eq $n);

   # Convert $N to an exponential where the numeric part with the exponent
   # ignored is 0.1 <= $num < 1.0.  i.e. 0.#####e## where the first '#' is
   # non-zero.  Then we can format it using a simple sprintf command.

   my($num,$e);
   if ($int > 0) {
      $num = "0.$int$dec";
      $e   = length($int);
   } elsif ($dec ne ''  &&  $dec > 0) {
      $dec =~ s/^(0*)//;
      $num = "0.$dec";
      $e   = -length($1);
   } else {
      $e = 0;
      $num = "$int.$dec";
   }

   # sprintf doesn't round 5 up, so convert a 5 to 6 in the n+1'th position

   if ($n < $sig  &&  substr($num,$n+2,1) eq '5') {
      substr($num,$n+2,1) = '6';
   }

   # We have to handle the one special case:
   #    0.99 (1) => 1.0
   # If sprintf rounds a number to 1.0 or higher, then we reduce the
   # number of decimal points by 1.

   my $tmp = sprintf("%.${n}f",$num);
   if ($tmp >= 1.0) {
      $n--;
      $tmp = sprintf("%.${n}f",$num);
   }
   ($N,$sig,$lsp,$s,$int,$dec) = _Simplify("$s${tmp}e$e");
   return $N;
}

sub CountSigFigs {
   my($N) = @_;
   my($sig);
   ($N,$sig) = _Simplify($N);
   return ()  if (! defined($N));
   return $sig;
}

########################################################################
# NOT FOR EXPORT
#
# These are for internal use only.  They are not guaranteed to remain
# backward compatible (or even to exist at all) in future versions.
########################################################################

# This takes the parts of a number ($int and $dec) and turns it into
# an exponential with the LSP in the 1's place.  The exponent is
# returned (rather than appended to the number).
#
sub _ToExp {
   my($s,$int,$dec,$lsp) = @_;

   if ($lsp == 0) {
      return ("$s$int.${dec}",0);
   }

   if ($lsp > 0) {
      $int  = "0"x($lsp-length($int)) . $int;
      $dec  = substr($int,-$lsp) . $dec;
      $int  = substr($int,0,length($int)-$lsp);
      return ("$s$int.${dec}",-$lsp);
   }

   $dec .= "0"x(-$lsp-length($dec));
   $int .= substr($dec,0,-$lsp);
   $dec  = substr($dec,-$lsp);
   return ("$s$int.${dec}",-$lsp);
}

# This prepares a number by converting it to it's simplest correct
# form.  All space is ignored.  It handles numbers of the form:
#    signed (+, -, or no sign)
#    integers
#    reals (###.###)
#    exponential (###.###e###)
#
# It returns:
#    the number in the simplest form
#    the number of significant figures
#    the power of the least significant digit
#
sub _Simplify {
   my($n)  = @_;
   return  if (! defined($n));
   $n      =~ s/\s+//g;
   $n      =~ s/^([+-])//;
   my $s   = $1  ||  '';
   $s      = ''  if ($s eq '+');
   return  if ($n eq '');
   my $exp;
   if ($n  =~ s/[eE]([+-]*\d+)$//) {
      $exp = $1;
   } else {
      $exp = 0;
   }

   my($int,$dec,$sig,$lsp);

   if ($n  =~ /^(\d+)$/) {                  # 00  0123  012300
      $int    = $n;
      $int    =~ s/^0*//;                   # ''  123   12300
      $dec    = '';
      $int    =~ /(0*)$/;
      my $tmp = $1;                         # ''  ''    00
      $int    = 0  if ($int eq '');         # 0
      $lsp    = length($tmp);               # 0   0     2
      $sig    = length($int) - $lsp;        # 1   3     3

   } elsif ($n =~ /^0*\.(\d+)$/) {          # .000  .00123  .0012300
      $dec    = $1;                         # 000   00123   0012300
      $int    = '';
      $dec    =~ /^(0*)/;
      my $tmp = $1;                         # 000   00      00
      $lsp    = -length($dec);              # -3    -5      -7
      $sig    = length($dec)-length($tmp);  # 0     3       5
      $sig    = length($dec)
        if ($dec eq $tmp);                  # 3

   } elsif ($n =~ /^0*(\d+)\.(\d*)$/) {     # 12.       12.3
      ($int,$dec) = ($1,$2);                # 12,''     12,3
      $lsp    = -length($dec);              # 0         -1
      $sig    = length($int) + length($dec);# 2         3

   } else {
      return;
   }

   # Handle the exponent, if any

   if ($exp > 0) {
      if ($exp >= length($dec)) {
         $int  = "$int$dec" . "0"x($exp-length($dec));
         $dec  = '';
      } else {
         $int .= substr($dec,0,$exp);
         $dec  = substr($dec,$exp);
      }
      $lsp += $exp;
      $int  =~ s/^0*//;
      $int  = '0'  if (! $int);

   } elsif ($exp < 0) {
      if (-$exp < length($int)) {
         $dec  = substr($int,$exp) . $dec;
         $int  = substr($int,0,length($int)+$exp);
      } else {
         $dec  = "0"x(-$exp-length($int)) . "$int$dec";
         $int  = "0";
      }
      $lsp += $exp;
   }

   # We have a decimal point if:
   #    There is a decimal section
   #    An integer ends with a significant 0 but is not exactly 0
   # We prepend a sign to anything except for 0

   my $num;
   if ($dec eq '') {
      $num  = $int;
      $num .= "."  if ($lsp == 0  &&  $int =~ /0$/  &&  $int ne '0');
   } else {
      $int  = "0"  if ($int eq '');
      $num  = "$int.$dec";
   }
   $s       = ''   if ($num == 0);
   $num     = "$s$num";

   return ($num,$sig,$lsp,$s,$int,$dec);
}

1;
# Local Variables:
# mode: cperl
# indent-tabs-mode: nil
# cperl-indent-level: 3
# cperl-continued-statement-offset: 2
# cperl-continued-brace-offset: 0
# cperl-brace-offset: 0
# cperl-brace-imaginary-offset: 0
# cperl-label-offset: 0
# End: