1package Math::SigFigs;
2
3# Copyright (c) 1995-2019 Sullivan Beck. All rights reserved.
4# This program is free software; you can redistribute it and/or modify it
5# under the same terms as Perl itself.
6
7########################################################################
8
9require 5.004;
10require Exporter;
11use Carp;
12use strict;
13use warnings;
14
15our (@ISA,@EXPORT,@EXPORT_OK,%EXPORT_TAGS);
16use base qw(Exporter);
17@EXPORT     = qw(FormatSigFigs
18                 CountSigFigs
19               );
20@EXPORT_OK  = qw(FormatSigFigs
21                 CountSigFigs
22                 addSF subSF multSF divSF
23                 VERSION);
24
25%EXPORT_TAGS = ('all' => \@EXPORT_OK);
26
27our($VERSION);
28$VERSION='1.21';
29
30use strict;
31
32sub addSF {
33   my($n1,$n2)=@_;
34   _add($n1,$n2,0);
35}
36
37sub subSF {
38   my($n1,$n2)=@_;
39   _add($n1,$n2,1);
40}
41
42sub _add {
43   my($n1in,$n2in,$sub) = @_;
44
45   my($n1,$sig1,$lsp1,$s1,$int1,$dec1,$n2,$sig2,$lsp2,$s2,$int2,$dec2);
46
47   if (defined($n1in)) {
48      ($n1,$sig1,$lsp1,$s1,$int1,$dec1) = _Simplify($n1in);
49   }
50   return   if (! defined($n1));
51
52   if (defined($n2in)) {
53      ($n2,$sig2,$lsp2,$s2,$int2,$dec2) = _Simplify($n2in);
54   }
55   return   if (! defined($n2));
56
57   if ($sub) {
58      if ($n2<0) {
59         $n2 =~ s/\-//;
60         $s2 = '';
61      } elsif ($n2 > 0) {
62         $n2 =~ s/^\+?/-/;
63         $s2 = '-';
64      }
65   }
66
67   return $n2    if ($n1in eq '0');
68   return $n1    if ($n2in eq '0');
69
70   my $lsp = ($lsp1 > $lsp2 ? $lsp1 : $lsp2);
71
72   ($n1) = _ToExp($s1,$int1,$dec1,$lsp);
73   ($n2) = _ToExp($s2,$int2,$dec2,$lsp);
74
75   my($n,$sig,$tmp,$s,$int,$dec) = _Simplify($n1+$n2);
76   $n = sprintf("%.0f",$n) . ".e$lsp";
77   ($n,$sig,$lsp,$tmp,$int,$dec) = _Simplify("${n}");
78   return $n;
79}
80
81sub multSF {
82   my($n1,$n2)=@_;
83   _mult($n1,$n2,0);
84}
85
86sub divSF {
87   my($n1,$n2)=@_;
88   _mult($n1,$n2,1);
89}
90
91sub _mult {
92   my($n1,$n2,$div)=@_;
93   my($sig1,$sig2);
94
95   if (defined($n1)) {
96      ($n1,$sig1) = _Simplify($n1);
97   }
98   return   if (! defined($n1));
99
100   if (defined($n2)) {
101      ($n2,$sig2) = _Simplify($n2);
102   }
103   return   if (! defined($n2)  ||
104                ($div  &&  $n2 == 0));
105
106   my $sig = ($sig1 < $sig2 ? $sig1 : $sig2);
107   my($n)  = ($div ? $n1/$n2 : $n1*$n2);
108   return FormatSigFigs($n,$sig);
109}
110
111sub FormatSigFigs {
112   my($N,$n) = @_;
113   return ''  if ($n !~ /^\d+$/  ||  $n == 0);
114
115   my($ret,$sig,$lsp,$s,$int,$dec);
116   ($N,$sig,$lsp,$s,$int,$dec) = _Simplify($N);
117   return ""  if (! defined($N));
118   return '0.0'  if ($N==0  &&  $n==1);
119
120   return $N  if ($sig eq $n);
121
122   # Convert $N to an exponential where the numeric part with the exponent
123   # ignored is 0.1 <= $num < 1.0.  i.e. 0.#####e## where the first '#' is
124   # non-zero.  Then we can format it using a simple sprintf command.
125
126   my($num,$e);
127   if ($int > 0) {
128      $num = "0.$int$dec";
129      $e   = length($int);
130   } elsif ($dec ne ''  &&  $dec > 0) {
131      $dec =~ s/^(0*)//;
132      $num = "0.$dec";
133      $e   = -length($1);
134   } else {
135      $e = 0;
136      $num = "$int.$dec";
137   }
138
139   # sprintf doesn't round 5 up, so convert a 5 to 6 in the n+1'th position
140
141   if ($n < $sig  &&  substr($num,$n+2,1) eq '5') {
142      substr($num,$n+2,1) = '6';
143   }
144
145   # We have to handle the one special case:
146   #    0.99 (1) => 1.0
147   # If sprintf rounds a number to 1.0 or higher, then we reduce the
148   # number of decimal points by 1.
149
150   my $tmp = sprintf("%.${n}f",$num);
151   if ($tmp >= 1.0) {
152      $n--;
153      $tmp = sprintf("%.${n}f",$num);
154   }
155   ($N,$sig,$lsp,$s,$int,$dec) = _Simplify("$s${tmp}e$e");
156   return $N;
157}
158
159sub CountSigFigs {
160   my($N) = @_;
161   my($sig);
162   ($N,$sig) = _Simplify($N);
163   return ()  if (! defined($N));
164   return $sig;
165}
166
167########################################################################
168# NOT FOR EXPORT
169#
170# These are for internal use only.  They are not guaranteed to remain
171# backward compatible (or even to exist at all) in future versions.
172########################################################################
173
174# This takes the parts of a number ($int and $dec) and turns it into
175# an exponential with the LSP in the 1's place.  The exponent is
176# returned (rather than appended to the number).
177#
178sub _ToExp {
179   my($s,$int,$dec,$lsp) = @_;
180
181   if ($lsp == 0) {
182      return ("$s$int.${dec}",0);
183   }
184
185   if ($lsp > 0) {
186      my $z = ($lsp > length($int) ?
187               "0"x($lsp-length($int)) : "");
188      $int  = "$z$int";
189      $dec  = substr($int,-$lsp) . $dec;
190      $int  = substr($int,0,length($int)-$lsp);
191      return ("$s$int.${dec}",-$lsp);
192   }
193
194   $dec .= "0"x(-$lsp-length($dec))  if (-$lsp > length($dec));
195   $int .= substr($dec,0,-$lsp);
196   $dec  = substr($dec,-$lsp);
197   return ("$s$int.${dec}",-$lsp);
198}
199
200# This prepares a number by converting it to it's simplest correct
201# form.  All space is ignored.  It handles numbers of the form:
202#    signed (+, -, or no sign)
203#    integers
204#    reals (###.###)
205#    exponential (###.###e###)
206#
207# It returns:
208#    the number in the simplest form
209#    the number of significant figures
210#    the power of the least significant digit
211#
212sub _Simplify {
213   my($n)  = @_;
214   return  if (! defined($n));
215   $n      =~ s/\s+//g;
216   $n      =~ s/^([+-])//;
217   my $s   = $1  ||  '';
218   return  if ($n eq '');
219   my $exp;
220   if ($n  =~ s/[eE]([+-]*\d+)$//) {
221      $exp = $1;
222   } else {
223      $exp = 0;
224   }
225
226   my($int,$dec,$sig,$lsp);
227
228   if ($n  =~ /^\d+$/) {                    # 00     0123     012300
229      $int    = $n+0;                       # 0      123      12300
230      $int    =~ /^(\d+?)(0*)$/;
231      my($i,$z) = ($1,$2);                  # 0,''   123,''   123,00
232      $lsp    = length($z);                 # 0      0        2
233      $sig    = length($int) - $lsp;        # 1      3        3
234      $dec    = '';
235
236   } elsif ($n =~ /^0*\.(\d+)$/) {          # .000       .00123     .0012300
237      $dec    = $1;                         # 000        00123      0012300
238      $int    = '';
239      $dec    =~ /^(0*?)([1-9]\d*?)?(0*+)$/;
240      my($z0,$d,$z1) = ($1,$2,$3);          # '','',000  00,123,''  00,123,00
241      $lsp    = -length($dec);              # -3         -5         -7
242      $sig    = length($dec)-length($z0);   # 3          3          5
243
244   } elsif ($n =~ /^0*(\d+)\.(\d*)$/) {     # 12.       12.3
245      ($int,$dec) = ($1,$2);                # 12,''     12,3
246      $lsp    = -length($dec);              # 0         -1
247      $sig    = length($int) + length($dec);# 2         3
248
249   } else {
250      return;
251   }
252
253   # Handle the exponent, if any
254
255   if ($exp > 0) {
256      if ($exp >= length($dec)) {
257         $int  = "$int$dec" . "0"x($exp-length($dec));
258         $dec  = '';
259      } else {
260         $int .= substr($dec,0,$exp);
261         $dec  = substr($dec,$exp);
262      }
263      $lsp += $exp;
264      $int  =~ s/^0*//;
265      $int  = '0'  if (! $int);
266
267   } elsif ($exp < 0) {
268      if (-$exp < length($int)) {
269         $dec  = substr($int,$exp) . $dec;
270         $int  = substr($int,0,length($int)+$exp);
271      } else {
272         $dec  = "0"x(-$exp-length($int)) . "$int$dec";
273         $int  = "0";
274      }
275      $lsp += $exp;
276   }
277
278   # We have a decimal point if:
279   #    There is a decimal section
280   #    An integer ends with a significant 0 but is not exactly 0
281   # We prepend a sign to anything except for 0
282
283   my $num;
284   if ($dec eq '') {
285      $num  = $int;
286      $num .= "."  if ($lsp == 0  &&  $int =~ /0$/  &&  $int ne '0');
287   } else {
288      $int  = "0"  if ($int eq '');
289      $num  = "$int.$dec";
290   }
291   $s       = ''   if ($num == 0  ||  $s eq '+');
292   $num     = "$s$num";
293
294   return ($num,$sig,$lsp,$s,$int,$dec);
295}
296
2971;
298# Local Variables:
299# mode: cperl
300# indent-tabs-mode: nil
301# cperl-indent-level: 3
302# cperl-continued-statement-offset: 2
303# cperl-continued-brace-offset: 0
304# cperl-brace-offset: 0
305# cperl-brace-imaginary-offset: 0
306# cperl-label-offset: 0
307# End:
308