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     ! 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: }