Return to parse.pl CVS log

Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / bird2 / proto / perf

Annotation of embedaddon/bird2/proto/perf/parse.pl, revision 1.1.1.1

1.1       misho       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: }