#!/usr/bin/perl -w
#
# siground.pl
#
# Round the input number to the required reporting significance 
# using the new rounding rule that avoids parity bias.
# See Chap. 3 of "Guerrilla Capacity Planning" (Springer 2006)
# http://www.perfdynamics.com/iBook/gcap.html
#
# Created by Neil Gunther, Tue, Jun 18 2002
# Updated by NJG, Saturday, August 27, 2011
#
# Distributed as http://www.perfdynamics.com/Tools/siground.txt
# under MIT lincense http://en.wikipedia.org/wiki/MIT_License


############################################################
# Read number in from keyboard because we need to maintain 
# all digits literally as a string. Otherwise 0.040300, for 
# example (which has 5 sig digits) would be represented as 
# 0.0403 numerically and conclude there are only 3 sig digits.
############################################################
print "Enter the number: ";
$numstring = <STDIN>;
chomp($numstring); # toss CR
print "Round to sigfigs: ";
$sigfigs = <STDIN>;
chomp($sigfigs);
# NJG Aug 27, 2011: strip any commas
$numstring =~ s/,//g;


############################################################
# Prepare it for analysis ...
############################################################
if ($numstring =~ /\./) { # Check if decimal point present
	$dptpos = index($numstring, "."); # remember where it is
	$isreal = 1;
	$rptfigs = $sigfigs;
	($int, $frac) = split(/\./, $numstring); 
	$digstring = $int . $frac; # Concat sans decimal point
	$i = 0; # offset for any leading zeros ...
	$i++ until ( substr($digstring, $i, 1) != 0 );
	$sigfigs += $i;
} else {
	$isreal = 0;
	$rptfigs = $sigfigs;
	$digstring = $numstring;
}

$numfigs = length($digstring);
if ($sigfigs > $numfigs) {
	print "Can't request more sigfigs than digits!\n\n";
	exit(-1);
}

# Get successive digits if any ...
$sigx = substr($digstring, $sigfigs - 1, 1);


# if 'Y' digit is blank, substitute numeric value for later if tests
if (($sigy = substr($digstring, $sigfigs, 1)) eq "") {
	$sigy = -1;
	$sigz = -1; # no point scanning any further
}

$sfz = $sigfigs + 1; # NJG Aug 27, 2011
if ($sfz > length($digstring)) {
	print "Can't round down any further\n\n";
	exit(-1);
}

$sigz = substr($digstring, $sfz, 1);
if ($sigz eq "") {
	# if 'Z' is blank, substitute numeric value for later if tests
	$sigz = -1;
}

if ($sigz == 0) { 
	# check ALL successive digits
	$trailz = substr($digstring, $sigfigs + 2, length($numstring)); 	
	# If ALL are zeros then leave $siz == 0
	# Else ...
	if ($trailz > 0) { $sigz = 1; } # will cause $sigy to increment
}


# Fall thru these if's to do the rounding ...
if ($sigy == 5) {
	if ( $sigz >= 1 ) { # NJG: changed to '>=' on Jun 24 2002
		$sigy += 1; 
	} 
	if ( $sigz == 0 or $sigz == -1) {
		if ($sigx % 2 != 0) { # has ODD parity 
			$digstring = substr($digstring, 0, $sigfigs - 1);
			$siground = $digstring . ($sigx + 1);
		}
		else { # EVEN parity so, leave 'X' alone
			$digstring = substr($digstring, 0, $sigfigs);
			$siground = $digstring;
		}
	}
}

if ($sigy < 5) {
	$siground = substr($digstring, 0, $sigfigs);
}

if ($sigy > 5) {
	$digstring = substr($digstring, 0, $sigfigs - 1);
	
	# Added Wed, Dec 4, 2002
	if ( ($sigx + 1) == 10 ) { # Carry forward
		my $lds = length($digstring);
		# Trick is to treat string as an integer
		$siground = ($digstring + 1);
		# but this removes any prepended zeros
		# e.g., 02 + 1 becomes 3
		if (length($siground) < $lds) {
			# put zeros back ...
			$siground =  '0' . $siground
				until (length($siground) == $lds);
		}
	}
	else { 
		$siground = $digstring . ($sigx + 1); 
	}
}


############################################################
# Adjust for final presentation
############################################################
if ($isreal) {
	if (length($siground) < $dptpos) { # pad with trailing zeros
		$siground = $siground . '0'  
			until (length($siground) == $dptpos);
	}
	$predp = substr($siground, 0, $dptpos);
	$postdp = substr($siground, $dptpos);
	
	# Added Wed, Dec 4, 2002
	if ( $predp == 0 and length($postdp) < $rptfigs ) {
		$postdp = $postdp . '0'  
			until (length($postdp) == $rptfigs);
	}
	
	# Added Wed, Dec 4, 2002
	if ( length($predp . $postdp) < $rptfigs ) {
		$postdp = $postdp . '0'  
			until (length($predp . $postdp) == $rptfigs);
	}
	
	# put decimal point back into number
	$siground = $predp . "." . $postdp;
}
else { # it's an INTEGER and may need to pad with trailing zeros
	$siground = $siground . '0'  until (length($siground) == $numfigs);
}

print "Number '$numstring' becomes '$siground'\n";
print "correct to $rptfigs significant digits.\n";
print "\n";