#! /usr/bin/perl/ -w
#
# siground.pl -- round a number to the required reporting 
#                significance using modern rounding rules.
#
# Created by Neil Gunther, 16:41:06    Tue, Jun 18 2002
# Updated by Neil Gunther, 12:18:49    Mon, Jun 24 2002
# Updated by Neil Gunther, 04:40:41 PM Wed, Dec 4, 2002
#
# Available as http://www.perfdynamics.com/Tools/siground.txt


############################################################
# Read the number in from the keyboard.
############################################################
print "Enter the number: ";
$numstring = <STDIN>;
chomp($numstring); # Toss RETURN key
print "Report sigfigs:   ";
$sigfigs = <STDIN>;
chomp($sigfigs); 


############################################################
# Prepare it for analysis ...
############################################################
if ($numstring =~ /\./) { # Check for presence of decimal point.
    $dptpos = index($numstring, "."); # remember where it is
    $isreal = 1;
    $rptfigs = $sigfigs;
    ($int, $frac) = split(/\./, $numstring); 
    $digstring = $int . $frac; # Concatenate 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
}

$sigz = substr($digstring, $sigfigs + 1, 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 ) { # Edited '>=' Mon, 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";