Home | History | Annotate | Download | only in perldriver
      1 #!/usr/local/bin/perl
      2 #  ********************************************************************
      3 #  * COPYRIGHT:
      4 #  *  2016 and later: Unicode, Inc. and others.
      5 #  * License & terms of use: http://www.unicode.org/copyright.html#License
      6 #  * Copyright (c) 2006, International Business Machines Corporation and
      7 #  * others. All Rights Reserved.
      8 #  ********************************************************************
      9 
     10 my $PLUS_MINUS = "±";
     11 
     12 #|#---------------------------------------------------------------------
     13 #|# Format a confidence interval, as given by a Dataset.  Output is as
     14 #|# as follows:
     15 #|#   241.23 - 241.98 => 241.5 +/- 0.3
     16 #|#   241.2 - 243.8 => 242 +/- 1
     17 #|#   211.0 - 241.0 => 226 +/- 15 or? 230 +/- 20
     18 #|#   220.3 - 234.3 => 227 +/- 7
     19 #|#   220.3 - 300.3 => 260 +/- 40
     20 #|#   220.3 - 1000 => 610 +/- 390 or? 600 +/- 400
     21 #|#   0.022 - 0.024 => 0.023 +/- 0.001
     22 #|#   0.022 - 0.032 => 0.027 +/- 0.005
     23 #|#   0.022 - 1.000 => 0.5 +/- 0.5
     24 #|# In other words, take one significant digit of the error value and
     25 #|# display the mean to the same precision.
     26 #|sub formatDataset {
     27 #|    my $ds = shift;
     28 #|    my $lower = $ds->getMean() - $ds->getError();
     29 #|    my $upper = $ds->getMean() + $ds->getError();
     30 #|    my $scale = 0;
     31 #|    # Find how many initial digits are the same
     32 #|    while ($lower < 1 ||
     33 #|           int($lower) == int($upper)) {
     34 #|        $lower *= 10;
     35 #|        $upper *= 10;
     36 #|        $scale++;
     37 #|    }
     38 #|    while ($lower >= 10 &&
     39 #|           int($lower) == int($upper)) {
     40 #|        $lower /= 10;
     41 #|        $upper /= 10;
     42 #|        $scale--;
     43 #|    }
     44 #|}
     45 
     46 #---------------------------------------------------------------------
     47 # Format a number, optionally with a +/- delta, to n significant
     48 # digits.
     49 #
     50 # @param significant digit, a value >= 1
     51 # @param multiplier
     52 # @param time in seconds to be formatted
     53 # @optional delta in seconds
     54 #
     55 # @return string of the form "23" or "23 +/- 10".
     56 #
     57 sub formatNumber {
     58     my $sigdig = shift;
     59     my $mult = shift;
     60     my $a = shift;
     61     my $delta = shift; # may be undef
     62     
     63     my $result = formatSigDig($sigdig, $a*$mult);
     64     if (defined($delta)) {
     65         my $d = formatSigDig($sigdig, $delta*$mult);
     66         # restrict PRECISION of delta to that of main number
     67         if ($result =~ /\.(\d+)/) {
     68             # TODO make this work for values with all significant
     69             # digits to the left of the decimal, e.g., 1234000.
     70 
     71             # TODO the other thing wrong with this is that it
     72             # isn't rounding the $delta properly.  Have to put
     73             # this logic into formatSigDig().
     74             my $x = length($1);
     75             $d =~ s/\.(\d{$x})\d+/.$1/;
     76         }
     77         $result .= " $PLUS_MINUS " . $d;
     78     }
     79     $result;
     80 }
     81 
     82 #---------------------------------------------------------------------
     83 # Format a time, optionally with a +/- delta, to n significant
     84 # digits.
     85 #
     86 # @param significant digit, a value >= 1
     87 # @param time in seconds to be formatted
     88 # @optional delta in seconds
     89 #
     90 # @return string of the form "23 ms" or "23 +/- 10 ms".
     91 #
     92 sub formatSeconds {
     93     my $sigdig = shift;
     94     my $a = shift;
     95     my $delta = shift; # may be undef
     96 
     97     my @MULT = (1   , 1e3,  1e6,  1e9);
     98     my @SUFF = ('s' , 'ms', 'us', 'ns');
     99 
    100     # Determine our scale
    101     my $i = 0;
    102     #always do seconds if the following line is commented out
    103     ++$i while ($a*$MULT[$i] < 1 && $i < @MULT);
    104     
    105     formatNumber($sigdig, $MULT[$i], $a, $delta) . ' ' . $SUFF[$i];
    106 }
    107 
    108 #---------------------------------------------------------------------
    109 # Format a percentage, optionally with a +/- delta, to n significant
    110 # digits.
    111 #
    112 # @param significant digit, a value >= 1
    113 # @param value to be formatted, as a fraction, e.g. 0.5 for 50%
    114 # @optional delta, as a fraction
    115 #
    116 # @return string of the form "23 %" or "23 +/- 10 %".
    117 #
    118 sub formatPercent {
    119     my $sigdig = shift;
    120     my $a = shift;
    121     my $delta = shift; # may be undef
    122     
    123     formatNumber($sigdig, 100, $a, $delta) . '%';
    124 }
    125 
    126 #---------------------------------------------------------------------
    127 # Format a number to n significant digits without using exponential
    128 # notation.
    129 #
    130 # @param significant digit, a value >= 1
    131 # @param number to be formatted
    132 #
    133 # @return string of the form "1234" "12.34" or "0.001234".  If
    134 #         number was negative, prefixed by '-'.
    135 #
    136 sub formatSigDig {
    137     my $n = shift() - 1;
    138     my $a = shift;
    139 
    140     local $_ = sprintf("%.${n}e", $a);
    141     my $sign = (s/^-//) ? '-' : '';
    142 
    143     my $a_e;
    144     my $result;
    145     if (/^(\d)\.(\d+)e([-+]\d+)$/) {
    146         my ($d, $dn, $e) = ($1, $2, $3);
    147         $a_e = $e;
    148         $d .= $dn;
    149         $e++;
    150         $d .= '0' while ($e > length($d));
    151         while ($e < 1) {
    152             $e++;
    153             $d = '0' . $d;
    154         }
    155         if ($e == length($d)) {
    156             $result = $sign . $d;
    157         } else {
    158             $result = $sign . substr($d, 0, $e) . '.' . substr($d, $e);
    159         }
    160     } else {
    161         die "Can't parse $_";
    162     }
    163     $result;
    164 }
    165 
    166 1;
    167 
    168 #eof
    169