File:  [ELWIX - Embedded LightWeight unIX -] / embedaddon / bird2 / proto / perf / parse.pl
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs - revision graph
Mon Oct 21 16:03:56 2019 UTC (5 years, 5 months ago) by misho
Branches: bird2, MAIN
CVS tags: v2_0_7p0, HEAD
bird2 ver 2.0.7

    1: #!/usr/bin/perl
    2: 
    3: use File::Temp ();
    4: 
    5: package row;
    6: 
    7: use Moose;
    8: 
    9: has 'exp' => ( is => 'ro', 'isa' => 'Num' );
   10: has 'gen' => ( is => 'ro', 'isa' => 'Num' );
   11: has 'temp' => ( is => 'ro', 'isa' => 'Num' );
   12: has 'update' => ( is => 'ro', 'isa' => 'Num' );
   13: has 'withdraw' => ( is => 'ro', 'isa' => 'Num' );
   14: 
   15: sub reduce {
   16:   my $self = shift;
   17: 
   18:   my $N = 1 << $self->exp;
   19:   return row->new(
   20:     exp => $self->exp,
   21:     gen => $self->gen / $N,
   22:     temp => $self->temp / $N,
   23:     update => $self->update / $N,
   24:     withdraw => $self->withdraw / $N
   25:   );
   26: }
   27: 
   28: sub dump {
   29:   my ($self, $fh) = @_;
   30: 
   31:   print $fh join ",", $self->exp, $self->gen, $self->temp, $self->update, $self->withdraw;
   32:   print $fh "\n";
   33: }
   34: 
   35: package results;
   36: 
   37: use Moose;
   38: 
   39: has 'name' => (
   40:   is => 'ro',
   41:   isa => 'Str',
   42:   required => 1,
   43: );
   44: 
   45: has 'date' => (
   46:   is => 'ro',
   47:   isa => 'Str',
   48:   required => 1,
   49: );
   50: 
   51: has 'reduced' => (
   52:   is => 'ro',
   53:   isa => 'Bool',
   54:   default => 0,
   55: );
   56: 
   57: has 'rows' => (
   58:   is => 'ro',
   59:   isa => 'ArrayRef[row]',
   60:   default => sub { [] },
   61: );
   62: 
   63: has 'stub' => (
   64:   is => 'ro',
   65:   isa => 'Str',
   66:   lazy => 1,
   67:   builder => '_build_stub',
   68: );
   69: 
   70: sub _build_stub {
   71:   my $self = shift;
   72: 
   73:   my $date = $self->date;
   74:   my $name = $self->name;
   75: 
   76:   my $reduced = "-reduced" if $self->reduced;
   77: 
   78:   my $stub = $date . "-" . $name . $reduced;
   79: 
   80:   $stub =~ tr/a-zA-Z0-9_-/@/c;
   81:   return $stub;
   82: }
   83: 
   84: sub add {
   85:   my $self = shift;
   86:   push @{$self->rows}, row->new(@_);
   87: }
   88: 
   89: sub reduce {
   90:   my $self = shift;
   91: 
   92:   return $self if $self->reduced;
   93: 
   94:   return results->new(
   95:     name => $self->name,
   96:     date => $self->date,
   97:     reduced => 1,
   98:     rows => [
   99:       map { $_->reduce } @{$self->rows}
  100:     ],
  101:   );
  102: }
  103: 
  104: sub dump {
  105:   my $self = shift;
  106:   my $fn = $self->stub . ".csv";
  107: 
  108:   open my $CSV, ">", $fn;
  109:   map {
  110:     $_->dump($CSV);
  111:     } @{$self->rows};
  112: 
  113:   close $CSV;
  114:   return $fn;
  115: }
  116: 
  117: sub draw {
  118:   my $self = shift;
  119: 
  120:   my $csv = $self->dump();
  121:   my $svg = $self->stub . ".svg";
  122: 
  123:   my $title = $self->name;
  124:   $title =~ s/_/ /g;
  125: 
  126:   open PLOT, "|-", "gnuplot -p";
  127:   print PLOT "set terminal svg;\n";
  128:   print PLOT "set output '$svg';\n";
  129:   print PLOT "set title '$title';\n";
  130:   print PLOT "set datafile separator ',';\n";
  131:   print PLOT "set jitter over 0.3 spread 0.3;\n";
  132:   print PLOT "plot '$csv' using 1:2 title 'gen', '$csv' using 1:3 title 'temp', '$csv' using 1:4 title 'update', '$csv' using 1:5 title 'withdraw';\n";
  133:   close PLOT;
  134: }
  135: 
  136: package main;
  137: 
  138: my %results;
  139: my @done;
  140: 
  141: while (<>) {
  142:   if (m/(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2}).*?Perf (.+) starting$/) {
  143:     my $date = $1;
  144:     my $name = $2;
  145:     die "Garbled input data" if exists $results{$name};
  146:     $results{$name} = results->new(name => $name, date => $date);
  147:     next;
  148:   }
  149: 
  150:   if (m/Perf (.+) done with exp=(\d+)$/) {
  151:     my $name = $1;
  152:     die "Garbled input data" unless exists $results{$name};
  153:     push @done, $results{$name};
  154:     delete $results{$name};
  155:     next;
  156:   }
  157: 
  158:   my ($name, $exp, $gen, $temp, $update, $withdraw) = m/Perf (.+) exp=(\d+) times: gen=(\d+) temp=(\d+) update=(\d+) withdraw=(\d+)$/ or next;
  159: 
  160:   exists $results{$name} or die "Garbled input data";
  161: 
  162:   $results{$name}->add(exp => $exp, gen => $gen, temp => $temp, update => $update, withdraw => $withdraw);
  163: }
  164: 
  165: scalar %results and die "Incomplete input data";
  166: 
  167: foreach my $res (@done) {
  168:   $res->reduce->draw();
  169: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>