[sword-cvs] icu-sword/source/test/perf/perldriver Dataset.pm,NONE,1.1 Format.pm,NONE,1.1 Output.pm,NONE,1.1 PerfFramework.pm,NONE,1.1
sword@www.crosswire.org
sword@www.crosswire.org
Tue, 9 Sep 2003 19:42:52 -0700
- Previous message: [sword-cvs] icu-sword/source/test/perf/normperf Makefile.in,NONE,1.1 NormPerf.pl,NONE,1.1 normperf.cpp,NONE,1.1 normperf.dsp,NONE,1.1 normperf.h,NONE,1.1
- Next message: [sword-cvs] icu-sword/source/test/perf/ubrkperf Makefile.in,NONE,1.1 UBrkPerf.pl,NONE,1.1 ubrkperf.cpp,NONE,1.1 ubrkperf.dsp,NONE,1.1 ubrkperf.h,NONE,1.1 ubrkperf20.dsp,NONE,1.1 ubrkperfold.cpp,NONE,1.1 ubrkperfold.dsp,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /usr/local/cvsroot/icu-sword/source/test/perf/perldriver
In directory www:/tmp/cvs-serv19862/source/test/perf/perldriver
Added Files:
Dataset.pm Format.pm Output.pm PerfFramework.pm
Log Message:
ICU 2.6 commit
--- NEW FILE: Dataset.pm ---
#!/usr/local/bin/perl
# ********************************************************************
# * COPYRIGHT:
# * Copyright (c) 2002, International Business Machines Corporation and
# * others. All Rights Reserved.
# ********************************************************************
package Dataset;
use Statistics::Descriptive;
use Statistics::Distributions;
use strict;
# Create a new Dataset with the given data.
sub new {
my ($class) = shift;
my $self = bless {
_data => \@_,
_scale => 1.0,
_mean => 0.0,
_error => 0.0,
}, $class;
my $n = @_;
if ($n >= 1) {
my $stats = Statistics::Descriptive::Full->new();
$stats->add_data(@{$self->{_data}});
$self->{_mean} = $stats->mean();
if ($n >= 2) {
# Use a t distribution rather than Gaussian because (a) we
# assume an underlying normal dist, (b) we do not know the
# standard deviation -- we estimate it from the data, and (c)
# we MAY have a small sample size (also works for large n).
my $t = Statistics::Distributions::tdistr($n-1, 0.005);
$self->{_error} = $t * $stats->standard_deviation();
}
}
$self;
}
# Set a scaling factor for all data; 1.0 means no scaling.
# Scale must be > 0.
sub setScale {
my ($self, $scale) = @_;
$self->{_scale} = $scale;
}
# Multiply the scaling factor by a value.
sub scaleBy {
my ($self, $a) = @_;
$self->{_scale} *= $a;
}
# Return the mean.
sub getMean {
my $self = shift;
return $self->{_mean} * $self->{_scale};
}
# Return a 99% error based on the t distribution. The dataset
# is desribed as getMean() +/- getError().
sub getError {
my $self = shift;
return $self->{_error} * $self->{_scale};
}
# Divide two Datasets and return a new one, maintaining the
# mean+/-error. The new Dataset has no data points.
sub divide {
my $self = shift;
my $rhs = shift;
my $minratio = ($self->{_mean} - $self->{_error}) /
($rhs->{_mean} + $rhs->{_error});
my $maxratio = ($self->{_mean} + $self->{_error}) /
($rhs->{_mean} - $rhs->{_error});
my $result = Dataset->new();
$result->{_mean} = ($minratio + $maxratio) / 2;
$result->{_error} = $result->{_mean} - $minratio;
$result->{_scale} = $self->{_scale} / $rhs->{_scale};
$result;
}
# subtracts two Datasets and return a new one, maintaining the
# mean+/-error. The new Dataset has no data points.
sub subtract {
my $self = shift;
my $rhs = shift;
my $result = Dataset->new();
$result->{_mean} = $self->{_mean} - $rhs->{_mean};
$result->{_error} = $self->{_error} + $rhs->{_error};
$result->{_scale} = $self->{_scale};
$result;
}
# adds two Datasets and return a new one, maintaining the
# mean+/-error. The new Dataset has no data points.
sub add {
my $self = shift;
my $rhs = shift;
my $result = Dataset->new();
$result->{_mean} = $self->{_mean} + $rhs->{_mean};
$result->{_error} = $self->{_error} + $rhs->{_error};
$result->{_scale} = $self->{_scale};
$result;
}
# Divides a dataset by a scalar.
# The new Dataset has no data points.
sub divideByScalar {
my $self = shift;
my $s = shift;
my $result = Dataset->new();
$result->{_mean} = $self->{_mean}/$s;
$result->{_error} = $self->{_error}/$s;
$result->{_scale} = $self->{_scale};
$result;
}
# Divides a dataset by a scalar.
# The new Dataset has no data points.
sub multiplyByScalar {
my $self = shift;
my $s = shift;
my $result = Dataset->new();
$result->{_mean} = $self->{_mean}*$s;
$result->{_error} = $self->{_error}*$s;
$result->{_scale} = $self->{_scale};
$result;
}
1;
--- NEW FILE: Format.pm ---
#!/usr/local/bin/perl
# ********************************************************************
# * COPYRIGHT:
# * Copyright (c) 2002, International Business Machines Corporation and
# * others. All Rights Reserved.
# ********************************************************************
my $PLUS_MINUS = "±";
#|#---------------------------------------------------------------------
#|# Format a confidence interval, as given by a Dataset. Output is as
#|# as follows:
#|# 241.23 - 241.98 => 241.5 +/- 0.3
#|# 241.2 - 243.8 => 242 +/- 1
#|# 211.0 - 241.0 => 226 +/- 15 or? 230 +/- 20
#|# 220.3 - 234.3 => 227 +/- 7
#|# 220.3 - 300.3 => 260 +/- 40
#|# 220.3 - 1000 => 610 +/- 390 or? 600 +/- 400
#|# 0.022 - 0.024 => 0.023 +/- 0.001
#|# 0.022 - 0.032 => 0.027 +/- 0.005
#|# 0.022 - 1.000 => 0.5 +/- 0.5
#|# In other words, take one significant digit of the error value and
#|# display the mean to the same precision.
#|sub formatDataset {
#| my $ds = shift;
#| my $lower = $ds->getMean() - $ds->getError();
#| my $upper = $ds->getMean() + $ds->getError();
#| my $scale = 0;
#| # Find how many initial digits are the same
#| while ($lower < 1 ||
#| int($lower) == int($upper)) {
#| $lower *= 10;
#| $upper *= 10;
#| $scale++;
#| }
#| while ($lower >= 10 &&
#| int($lower) == int($upper)) {
#| $lower /= 10;
#| $upper /= 10;
#| $scale--;
#| }
#|}
#---------------------------------------------------------------------
# Format a number, optionally with a +/- delta, to n significant
# digits.
#
# @param significant digit, a value >= 1
# @param multiplier
# @param time in seconds to be formatted
# @optional delta in seconds
#
# @return string of the form "23" or "23 +/- 10".
#
sub formatNumber {
my $sigdig = shift;
my $mult = shift;
my $a = shift;
my $delta = shift; # may be undef
my $result = formatSigDig($sigdig, $a*$mult);
if (defined($delta)) {
my $d = formatSigDig($sigdig, $delta*$mult);
# restrict PRECISION of delta to that of main number
if ($result =~ /\.(\d+)/) {
# TODO make this work for values with all significant
# digits to the left of the decimal, e.g., 1234000.
# TODO the other thing wrong with this is that it
# isn't rounding the $delta properly. Have to put
# this logic into formatSigDig().
my $x = length($1);
$d =~ s/\.(\d{$x})\d+/.$1/;
}
$result .= " $PLUS_MINUS " . $d;
}
$result;
}
#---------------------------------------------------------------------
# Format a time, optionally with a +/- delta, to n significant
# digits.
#
# @param significant digit, a value >= 1
# @param time in seconds to be formatted
# @optional delta in seconds
#
# @return string of the form "23 ms" or "23 +/- 10 ms".
#
sub formatSeconds {
my $sigdig = shift;
my $a = shift;
my $delta = shift; # may be undef
my @MULT = (1 , 1e3, 1e6, 1e9);
my @SUFF = ('s' , 'ms', 'us', 'ns');
# Determine our scale
my $i = 0;
#always do seconds if the following line is commented out
++$i while ($a*$MULT[$i] < 1 && $i < @MULT);
formatNumber($sigdig, $MULT[$i], $a, $delta) . ' ' . $SUFF[$i];
}
#---------------------------------------------------------------------
# Format a percentage, optionally with a +/- delta, to n significant
# digits.
#
# @param significant digit, a value >= 1
# @param value to be formatted, as a fraction, e.g. 0.5 for 50%
# @optional delta, as a fraction
#
# @return string of the form "23 %" or "23 +/- 10 %".
#
sub formatPercent {
my $sigdig = shift;
my $a = shift;
my $delta = shift; # may be undef
formatNumber($sigdig, 100, $a, $delta) . '%';
}
#---------------------------------------------------------------------
# Format a number to n significant digits without using exponential
# notation.
#
# @param significant digit, a value >= 1
# @param number to be formatted
#
# @return string of the form "1234" "12.34" or "0.001234". If
# number was negative, prefixed by '-'.
#
sub formatSigDig {
my $n = shift() - 1;
my $a = shift;
local $_ = sprintf("%.${n}e", $a);
my $sign = (s/^-//) ? '-' : '';
my $a_e;
my $result;
if (/^(\d)\.(\d+)e([-+]\d+)$/) {
my ($d, $dn, $e) = ($1, $2, $3);
$a_e = $e;
$d .= $dn;
$e++;
$d .= '0' while ($e > length($d));
while ($e < 1) {
$e++;
$d = '0' . $d;
}
if ($e == length($d)) {
$result = $sign . $d;
} else {
$result = $sign . substr($d, 0, $e) . '.' . substr($d, $e);
}
} else {
die "Can't parse $_";
}
$result;
}
1;
#eof
--- NEW FILE: Output.pm ---
#!/usr/local/bin/perl
# ********************************************************************
# * COPYRIGHT:
# * Copyright (c) 2002, International Business Machines Corporation and
# * others. All Rights Reserved.
# ********************************************************************
use strict;
use Dataset;
my $TABLEATTR = 'BORDER="1" CELLPADDING="4" CELLSPACING="0"';
my $outType = "HTML";
my $html = "noName";
my $inTable;
my @headers;
my @timetypes = ("mean per op", "error per op", "events", "per event");
my %raw;
my $current = "";
my $exp = 0;
my $mult = 1e9; #use nanoseconds
my $perc = 100; #for percent
my $printEvents = 0;
my $legend = "<a name=\"Legend\">\n<h2>Table legend</h2></a><ul>";
my $legendDone = 0;
my %options;
my $operationIs = "operation";
my $eventIs = "event";
sub startTest {
$current = shift;
$exp = 0;
outputData($current);
}
sub printLeg {
if(!$legendDone) {
my $message;
foreach $message (@_) {
$legend .= "<li>".$message."</li>\n";
}
}
}
sub outputDist {
my $value = shift;
my $percent = shift;
my $mean = $value->getMean;
my $error = $value->getError;
print HTML "<td class=\"";
if($mean > 0) {
print HTML "value";
} else {
print HTML "worse";
}
print HTML "\">";
if($percent) {
print HTML formatPercent(2, $mean);
} else {
print HTML formatNumber(2, $mult, $mean);
}
print HTML "</td>\n";
print HTML "<td class=\"";
if((($error*$mult < 10)&&!$percent) || (($error<10)&&$percent)) {
print HTML "error";
} else {
print HTML "errorLarge";
}
print HTML "\">±";
if($percent) {
print HTML formatPercent(2, $error);
} else {
print HTML formatNumber(2, $mult, $error);
}
print HTML "</td>\n";
}
sub outputValue {
my $value = shift;
print HTML "<td class=\"sepvalue\">";
print HTML $value;
#print HTML formatNumber(2, 1, $value);
print HTML "</td>\n";
}
sub startTable {
#my $printEvents = shift;
$inTable = 1;
my $i;
print HTML "<table $TABLEATTR>\n";
print HTML "<tbody>\n";
if($#headers >= 0) {
my ($header, $i);
print HTML "<tr>\n";
print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#TestName\">Test Name</a></th>\n";
print HTML "<th rowspan=\"2\" class=\"testNameHeader\"><a href=\"#Ops\">Ops</a></th>\n";
printLeg("<a name=\"Test Name\">TestName</a> - name of the test as set by the test writer\n", "<a name=\"Ops\">Ops</a> - number of ".$operationIs."s per iteration\n");
if(!$printEvents) {
print HTML "<th colspan=".((4*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
} else {
print HTML "<th colspan=".((2*($#headers+1))-2)." class=\"sourceType\">Per Operation</th>\n";
print HTML "<th colspan=".((5*($#headers+1))-2)." class=\"sourceType\">Per Event</th>\n";
}
print HTML "</tr>\n<tr>\n";
if(!$printEvents) {
foreach $header (@headers) {
print HTML "<th class=\"source\" colspan=2><a href=\"#meanop_$header\">$header<br>/op</a></th>\n";
printLeg("<a name=\"meanop_$header\">$header /op</a> - mean time and error for $header per $operationIs");
}
}
for $i (1 .. $#headers) {
print HTML "<th class=\"source\" colspan=2><a href=\"#mean_op_$i\">ratio $i<br>/op</a></th>\n";
printLeg("<a name=\"mean_op_$i\">ratio $i /op</a> - ratio and error of per $operationIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
}
if($printEvents) {
foreach $header (@headers) {
print HTML "<th class=\"source\"><a href=\"#events_$header\">$header<br>events</a></th>\n";
printLeg("<a name=\"events_$header\">$header events</a> - number of ".$eventIs."s for $header per iteration");
}
foreach $header (@headers) {
print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$header\">$header<br>/ev</a></th>\n";
printLeg("<a name=\"mean_ev_$header\">$header /ev</a> - mean time and error for $header per $eventIs");
}
for $i (1 .. $#headers) {
print HTML "<th class=\"source\" colspan=2><a href=\"#mean_ev_$i\">ratio $i<br>/ev</a></th>\n";
printLeg("<a name=\"mean_ev_$i\">ratio $i /ev</a> - ratio and error of per $eventIs time, calculated as: (($headers[0] - $headers[$i])/$headers[$i])*100%, mean value");
}
}
print HTML "</tr>\n";
}
$legendDone = 1;
}
sub closeTable {
if($inTable) {
undef $inTable;
print HTML "</tr>\n";
print HTML "</tbody>";
print HTML "</table>\n";
}
}
sub newRow {
if(!$inTable) {
startTable;
} else {
print HTML "</tr>\n";
}
print HTML "<tr>";
}
sub outputData {
if($inTable) {
my $msg = shift;
my $align = shift;
print HTML "<td";
if($align) {
print HTML " align = $align>";
} else {
print HTML ">";
}
print HTML "$msg";
print HTML "</td>";
} else {
my $message;
foreach $message (@_) {
print HTML "$message";
}
}
}
sub setupOutput {
my $date = localtime;
my $options = shift;
%options = %{ $options };
my $title = $options{ "title" };
my $headers = $options{ "headers" };
if($options{ "operationIs" }) {
$operationIs = $options{ "operationIs" };
}
if($options{ "eventIs" }) {
$eventIs = $options{ "eventIs" };
}
@headers = split(/ /, $headers);
my ($t, $rest);
($t, $rest) = split(/\.\w+/, $0);
$t =~ /^.*\W(\w+)$/;
$t = $1;
if($outType eq 'HTML') {
$html = $date;
$html =~ s/://g; # ':' illegal
$html =~ s/\s*\d+$//; # delete year
$html =~ s/^\w+\s*//; # delete dow
$html = "$t $html.html";
if($options{ "outputDir" }) {
$html = $options{ "outputDir" }."/".$html;
}
$html =~ s/ /_/g;
open(HTML,">$html") or die "Can't write to $html: $!";
#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
print HTML <<EOF;
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<TITLE>$title</TITLE>
<style>
<!--
body { font-size: 10pt; font-family: sans-serif }
th { font-size: 10pt; border: 0 solid #000080; padding: 5 }
th.testNameHeader { border-width: 1 }
th.testName { text-align: left; border-left-width: 1; border-right-width: 1;
border-bottom-width: 1 }
th.source { border-right-width: 1; border-bottom-width: 1 }
th.sourceType { border-right-width: 1; border-top-width: 1; border-bottom-width: 1 }
td { font-size: 10pt; text-align: Right; border: 0 solid #000080; padding: 5 }
td.string { text-align: Left; border-bottom-width:1; border-right-width:1 }
td.sepvalue { border-bottom-width: 1; border-right-width: 1 }
td.value { border-bottom-width: 1 }
td.worse { color: #FF0000; font-weight: bold; border-bottom-width: 1 }
td.error { font-size: 75%; border-right-width: 1; border-bottom-width: 1 }
td.errorLarge { font-size: 75%; color: #FF0000; font-weight: bold; border-right-width: 1;
border-bottom-width: 1 }
A:link { color: black; font-weight: normal; text-decoration: none} /* unvisited links */
A:visited { color: blue; font-weight: normal; text-decoration: none } /* visited links */
A:hover { color: red; font-weight: normal; text-decoration: none } /* user hovers */
A:active { color: lime; font-weight: normal; text-decoration: none } /* active links */
-->
</style>
</HEAD>
<BODY bgcolor="#FFFFFF" LINK="#006666" VLINK="#000000">
EOF
print HTML "<H1>$title</H1>\n";
#print HTML "<H2>$TESTCLASS</H2>\n";
}
}
sub closeOutput {
if($outType eq 'HTML') {
if($inTable) {
closeTable;
}
$legend .= "</ul>\n";
print HTML $legend;
outputRaw();
print HTML <<EOF;
</BODY>
</HTML>
EOF
close(HTML) or die "Can't close $html: $!";
}
}
sub outputRaw {
print HTML "<h2>Raw data</h2>";
my $key;
my $i;
my $j;
my $k;
print HTML "<table $TABLEATTR>\n";
for $key (sort keys %raw) {
my $printkey = $key;
$printkey =~ s/\<br\>/ /g;
if($printEvents) {
if($key ne "") {
print HTML "<tr><th class=\"testNameHeader\" colspan = 7>$printkey</td></tr>\n"; # locale and data file
}
print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th><th class=\"testName\">events</th></tr>\n";
} else {
if($key ne "") {
print HTML "<tr><th class=\"testName\" colspan = 6>$printkey</td></tr>\n"; # locale and data file
}
print HTML "<tr><th class=\"testName\">test name</th><th class=\"testName\">interesting arguments</th><th class=\"testName\">iterations</th><th class=\"testName\">operations</th><th class=\"testName\">mean time (ns)</th><th class=\"testName\">error (ns)</th></tr>\n";
}
$printkey =~ s/[\<\>\/ ]//g;
my %done;
for $i ( $raw{$key} ) {
print HTML "<tr>";
for $j ( @$i ) {
my ($test, $args);
($test, $args) = split(/,/, shift(@$j));
print HTML "<th class=\"testName\">";
if(!$done{$test}) {
print HTML "<a name=\"".$printkey."_".$test."\">".$test."</a>";
$done{$test} = 1;
} else {
print HTML $test;
}
print HTML "</th>";
print HTML "<td class=\"string\">".$args."</td>";
print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
my @data = @{ shift(@$j) };
my $ds = Dataset->new(@data);
print HTML "<td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getMean)."</td><td class=\"sepvalue\">".formatNumber(4, $mult, $ds->getError)."</td>";
if($#{ $j } >= 0) {
print HTML "<td class=\"sepvalue\">".shift(@$j)."</td>";
}
print HTML "</tr>\n";
}
}
}
}
sub store {
$raw{$current}[$exp++] = [@_];
}
sub outputRow {
#$raw{$current}[$exp++] = [@_];
my $testName = shift;
my @iterPerPass = @{shift(@_)};
my @noopers = @{shift(@_)};
my @timedata = @{shift(@_)};
my @noevents;
if($#_ >= 0) {
@noevents = @{shift(@_)};
}
if(!$inTable) {
if(@noevents) {
$printEvents = 1;
startTable;
} else {
startTable;
}
}
debug("No events: @noevents, $#noevents\n");
my $j;
my $loc = $current;
$loc =~ s/\<br\>/ /g;
$loc =~ s/[\<\>\/ ]//g;
# Finished one row of results. Outputting
newRow;
#outputData($testName, "LEFT");
print HTML "<th class=\"testName\"><a href=\"#".$loc."_".$testName."\">$testName</a></th>\n";
#outputData($iterCount);
#outputData($noopers[0], "RIGHT");
outputValue($noopers[0]);
if(!$printEvents) {
for $j ( 0 .. $#timedata ) {
my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
#debug("Time per operation: ".formatSeconds(4, $perOperation->getMean, $perOperation->getError)."\n");
outputDist($perOperation);
}
}
my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noopers[0]);
for $j ( 1 .. $#timedata ) {
my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noopers[$j]); # time per operation
my $ratio = $baseLinePO->subtract($perOperation);
$ratio = $ratio->divide($perOperation);
outputDist($ratio, "%");
}
if (@noevents) {
for $j ( 0 .. $#timedata ) {
#outputData($noevents[$j], "RIGHT");
outputValue($noevents[$j]);
}
for $j ( 0 .. $#timedata ) {
my $perEvent = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per event
#debug("Time per operation: ".formatSeconds(4, $perEvent->getMean, $perEvent->getError)."\n");
outputDist($perEvent);
}
my $baseLinePO = $timedata[0]->divideByScalar($iterPerPass[0]*$noevents[0]);
for $j ( 1 .. $#timedata ) {
my $perOperation = $timedata[$j]->divideByScalar($iterPerPass[$j]*$noevents[$j]); # time per operation
my $ratio = $baseLinePO->subtract($perOperation);
$ratio = $ratio->divide($perOperation);
outputDist($ratio, "%");
}
}
}
1;
#eof
--- NEW FILE: PerfFramework.pm ---
#!/usr/local/bin/perl
# ********************************************************************
# * COPYRIGHT:
# * Copyright (c) 2002, International Business Machines Corporation and
# * others. All Rights Reserved.
# ********************************************************************
use strict;
#use Dataset;
use Format;
use Output;
my $VERBOSE = 0;
my $DEBUG = 1;
my $start_l = ""; #formatting help
my $end_l = "";
my @testArgs; # different kinds of tests we want to do
my $datadir = "data";
my $extraArgs; # stuff that always gets passed to the test program
my $iterCount = 0;
my $NUMPASSES = 4;
my $TIME = 2;
my $DATADIR;
sub setupOptions {
my %options = %{shift @_};
if($options{"time"}) {
$TIME = $options{"time"};
}
if($options{"passes"}) {
$NUMPASSES = $options{"passes"};
}
if($options{"dataDir"}) {
$DATADIR = $options{"dataDir"};
}
}
sub runTests {
my $options = shift;
my @programs;
my $tests = shift;
my %datafiles;
if($#_ >= 0) { # maybe no files/locales
my $datafiles = shift;
if($datafiles) {
%datafiles = %{$datafiles};
}
}
setupOutput($options);
setupOptions($options);
my($locale, $iter, $data, $program, $args, $variable);
#
# Outer loop runs through the locales to test
#
if (%datafiles) {
foreach $locale (sort keys %datafiles ) {
foreach $data (@{ $datafiles{$locale} }) {
closeTable;
my $locdata = "";
if(!($locale eq "")) {
$locdata = "<b>Locale:</b> $locale<br>";
}
$locdata .= "<b>Datafile:</b> $data<br>";
startTest($locdata);
if($DATADIR) {
compareLoop ($tests, $locale, $DATADIR."/".$data);
} else {
compareLoop ($tests, $locale, $data);
}
}
}
} else {
compareLoop($tests);
}
closeOutput();
}
sub compareLoop {
my $tests = shift;
#my @tests = @{$tests};
my %tests = %{$tests};
my $locale = shift;
my $datafile = shift;
my $locAndData = "";
if($locale) {
$locAndData .= " -L $locale";
}
if($datafile) {
$locAndData .= " -f $datafile";
}
my $args;
my ($i, $j, $aref);
foreach $i ( sort keys %tests ) {
debug("Test: $i\n");
$aref = $tests{$i};
my @timedata;
my @iterPerPass;
my @noopers;
my @noevents;
my $program;
my @argsAndTest;
for $j ( 0 .. $#{$aref} ) {
# first we calibrate. Use time from somewhere
# first test is used for calibration
($program, @argsAndTest) = split(/\ /, @{ $tests{$i} }[$j]);
my $commandLine = "$program -t $TIME -p $NUMPASSES $locAndData @argsAndTest";
#my $commandLine = "$program -i 5 -p $NUMPASSES $locAndData @argsAndTest";
my @res = measure1($commandLine);
store("$i, $program @argsAndTest", @res);
push(@iterPerPass, shift(@res));
push(@noopers, shift(@res));
my @data = @{ shift(@res) };
if($#res >= 0) {
push(@noevents, shift(@res));
}
shift(@data) if (@data > 1); # discard first run
#debug("data is @data\n");
my $ds = Dataset->new(@data);
push(@timedata, $ds);
}
outputRow($i, \@iterPerPass, \@noopers, \@timedata, \@noevents);
}
}
#---------------------------------------------------------------------
# Measure a given test method with a give test pattern using the
# global run parameters.
#
# @param the method to run
# @param the pattern defining characters to test
# @param if >0 then the number of iterations per pass. If <0 then
# (negative of) the number of seconds per pass.
#
# @return array of:
# [0] iterations per pass
# [1] events per iteration
# [2..] ms reported for each pass, in order
#
sub measure1 {
# run passes
my @t = callProg(shift); #"$program $args $argsAndTest");
my @ms = ();
my @b; # scratch
for my $a (@t) {
# $a->[0]: method name, corresponds to $method
# $a->[1]: 'begin' data, == $iterCount
# $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
# $a->[3...]: gc messages from JVM during pass
@b = split(/\s+/, $a->[2]);
#push(@ms, $b[0]);
push(@ms, shift(@b));
}
my $iterCount = shift(@b);
my $operationsPerIter = shift(@b);
my $eventsPerIter;
if($#b >= 0) {
$eventsPerIter = shift(@b);
}
# out("Iterations per pass: $iterCount<BR>\n");
# out("Events per iteration: $eventsPerIter<BR>\n");
# debug("Iterations per pass: $iterCount<BR>\n");
# if($eventsPerIter) {
# debug("Events per iteration: $eventsPerIter<BR>\n");
# }
my @ms_str = @ms;
$ms_str[0] .= " (discarded)" if (@ms_str > 1);
# out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
debug("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
if($eventsPerIter) {
($iterCount, $operationsPerIter, \@ms, $eventsPerIter);
} else {
($iterCount, $operationsPerIter, \@ms);
}
}
#---------------------------------------------------------------------
# Measure a given test method with a give test pattern using the
# global run parameters.
#
# @param the method to run
# @param the pattern defining characters to test
# @param if >0 then the number of iterations per pass. If <0 then
# (negative of) the number of seconds per pass.
#
# @return a Dataset object, scaled by iterations per pass and
# events per iteration, to give time per event
#
sub measure2 {
my @res = measure1(@_);
my $iterPerPass = shift(@res);
my $operationsPerIter = shift(@res);
my @data = @{ shift(@res) };
my $eventsPerIter = shift(@res);
shift(@data) if (@data > 1); # discard first run
my $ds = Dataset->new(@data);
#$ds->setScale(1.0e-3 / ($iterPerPass * $operationsPerIter));
($ds, $iterPerPass, $operationsPerIter, $eventsPerIter);
}
#---------------------------------------------------------------------
# Invoke program and capture results, passing it the given parameters.
#
# @param the method to run
# @param the number of iterations, or if negative, the duration
# in seconds. If more than on pass is desired, pass in
# a string, e.g., "100 100 100".
# @param the pattern defining characters to test
#
# @return an array of results. Each result is an array REF
# describing one pass. The array REF contains:
# ->[0]: The method name as reported
# ->[1]: The params on the '= <meth> begin ...' line
# ->[2]: The params on the '= <meth> end ...' line
# ->[3..]: GC messages from the JVM, if any
#
sub callProg {
my $cmd = shift;
#my $pat = shift;
#my $n = shift;
#my $cmd = "java -cp c:\\dev\\myicu4j\\classes $TESTCLASS $method $n $pat";
debug( "[$cmd]\n"); # for debugging
open(PIPE, "$cmd|") or die "Can't run \"$cmd\"";
my @out;
while (<PIPE>) {
push(@out, $_);
}
close(PIPE) or die "Program failed: \"$cmd\"";
@out = grep(!/^\#/, @out); # filter out comments
#debug( "[", join("\n", @out), "]\n");
my @results;
my $method = '';
my $data = [];
foreach (@out) {
next unless (/\S/);
if (/^=\s*(\w+)\s*(\w+)\s*(.*)/) {
my ($m, $state, $d) = ($1, $2, $3);
#debug ("$_ => [[$m $state !!!$d!!! $data ]]\n");
if ($state eq 'begin') {
die "$method was begun but not finished" if ($method);
$method = $m;
push(@$data, $d);
push(@$data, ''); # placeholder for end data
} elsif ($state eq 'end') {
if ($m ne $method) {
die "$method end does not match: $_";
}
$data->[1] = $d; # insert end data at [1]
#debug( "#$method:", join(";",@$data), "\n");
unshift(@$data, $method); # add method to start
push(@results, $data);
$method = '';
$data = [];
} else {
die "Can't parse: $_";
}
}
elsif (/^\[/) {
if ($method) {
push(@$data, $_);
} else {
# ignore extraneous GC notices
}
}
else {
die "Can't parse: $_";
}
}
die "$method was begun but not finished" if ($method);
@results;
}
sub debug {
my $message;
if($DEBUG != 0) {
foreach $message (@_) {
print STDERR "$message";
}
}
}
sub measure1Alan {
#Added here, was global
my $CALIBRATE = 2; # duration in seconds for initial calibration
my $method = shift;
my $pat = shift;
my $iterCount = shift; # actually might be -seconds/pass
out("<P>Measuring $method using $pat, ");
if ($iterCount > 0) {
out("$iterCount iterations/pass, $NUMPASSES passes</P>\n");
} else {
out(-$iterCount, " seconds/pass, $NUMPASSES passes</P>\n");
}
# is $iterCount actually -seconds?
if ($iterCount < 0) {
# calibrate: estimate ms/iteration
print "Calibrating...";
my @t = callJava($method, $pat, -$CALIBRATE);
print "done.\n";
my @data = split(/\s+/, $t[0]->[2]);
my $timePerIter = 1.0e-3 * $data[0] / $data[2];
# determine iterations/pass
$iterCount = int(-$iterCount / $timePerIter + 0.5);
out("<P>Calibration pass ($CALIBRATE sec): ");
out("$data[0] ms, ");
out("$data[2] iterations = ");
out(formatSeconds(4, $timePerIter), "/iteration<BR>\n");
}
# run passes
print "Measuring $iterCount iterations x $NUMPASSES passes...";
my @t = callJava($method, $pat, "$iterCount " x $NUMPASSES);
print "done.\n";
my @ms = ();
my @b; # scratch
for my $a (@t) {
# $a->[0]: method name, corresponds to $method
# $a->[1]: 'begin' data, == $iterCount
# $a->[2]: 'end' data, of the form <ms> <eventsPerIter>
# $a->[3...]: gc messages from JVM during pass
@b = split(/\s+/, $a->[2]);
push(@ms, $b[0]);
}
my $eventsPerIter = $b[1];
out("Iterations per pass: $iterCount<BR>\n");
out("Events per iteration: $eventsPerIter<BR>\n");
my @ms_str = @ms;
$ms_str[0] .= " (discarded)" if (@ms_str > 1);
out("Raw times (ms/pass): ", join(", ", @ms_str), "<BR>\n");
($iterCount, $eventsPerIter, @ms);
}
1;
#eof
- Previous message: [sword-cvs] icu-sword/source/test/perf/normperf Makefile.in,NONE,1.1 NormPerf.pl,NONE,1.1 normperf.cpp,NONE,1.1 normperf.dsp,NONE,1.1 normperf.h,NONE,1.1
- Next message: [sword-cvs] icu-sword/source/test/perf/ubrkperf Makefile.in,NONE,1.1 UBrkPerf.pl,NONE,1.1 ubrkperf.cpp,NONE,1.1 ubrkperf.dsp,NONE,1.1 ubrkperf.h,NONE,1.1 ubrkperf20.dsp,NONE,1.1 ubrkperfold.cpp,NONE,1.1 ubrkperfold.dsp,NONE,1.1
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]