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