[Avida-SVN] r1362 - in development/support: . scripts
barrick at myxo.css.msu.edu
barrick at myxo.css.msu.edu
Fri Feb 23 08:07:18 PST 2007
Author: barrick
Date: 2007-02-23 11:07:18 -0500 (Fri, 23 Feb 2007)
New Revision: 1362
Added:
development/support/scripts/
development/support/scripts/trace_movie.pl
Log:
Added perl script for generating image sequences of traces. Instructions on installing the required libraries and Perl modules are on the Wiki.
Added: development/support/scripts/trace_movie.pl
===================================================================
--- development/support/scripts/trace_movie.pl 2007-02-22 01:21:24 UTC (rev 1361)
+++ development/support/scripts/trace_movie.pl 2007-02-23 16:07:18 UTC (rev 1362)
@@ -0,0 +1,556 @@
+#!/usr/bin/perl -w
+
+###
+# Pod Documentation
+###
+
+=head1 NAME
+
+trace_movie.perl
+
+=head1 SYNOPSIS
+
+Usage: trace_movie.perl -i trace_file -o matlab_input_file
+
+Create an image or a folder of images of organism instruction execution.
+
+=head1 DESCRIPTION
+
+=over
+
+=item B<-i> <org file paths>
+
+An Avida organism file (.org). Generated by the PrintDominantGenotype event, for example.
+
+=item B<-t> <trace file path>
+
+An Avida trace file. Generated by the analyze command.
+
+=item B<-o> <file/directory path>
+
+Output file name or directory name (if -m used).
+
+=item B<-m>
+
+Generate frames of a movie. Without this option, only the final frame is produced.
+
+=item B<-f> <frame limit>
+
+The maximum number of frames to draw.
+
+=back
+
+=head1 AUTHOR
+
+Jeffrey Barrick
+
+=head1 COPYRIGHT
+
+Copyright 2006-2007. All rights reserved.
+
+=cut
+
+###
+# End Pod Documentation
+###
+
+use strict;
+
+use FindBin;
+use lib $FindBin::Bin;
+use Data::Dumper;
+use GD;
+
+#Get options
+use Getopt::Long;
+use Pod::Usage;
+my ($help, $man);
+my $frame_limit = 1000;
+my ($input, $output, $trace, $movie);
+#pod2usage(1) if (scalar @ARGV == 0);
+GetOptions(
+ 'help|?' => \$help, 'man' => \$man,
+ 'input|i=s' => \$input,
+ 'trace|t=s' => \$trace,
+ 'output|o=s' => \$output,
+ 'movie|m' => \$movie,
+ 'frame-limit|f=s' => \$frame_limit
+) or pod2usage(2);
+pod2usage(1) if $help;
+pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+pod2usage(1) if (!defined $output or !defined $input);
+
+#Other options
+my $each_execution_once = 1;
+
+my $data;
+
+#Load the genome from the .org file
+open ORGANISM, "$input";
+our @inst = <ORGANISM>;
+close ORGANISM;
+chomp @inst;
+ at inst = grep !/^#/, @inst; #comments
+ at inst = grep $_, @inst; #blank lines
+#print +(join "\n", @org_lines) . "\n";
+
+#Load the trace from the .org file
+our @trace;
+open TRACE, "$trace";
+
+my $resources_found = 0;
+my $cur_resource_line;
+while (<TRACE>)
+{
+ if ($_ =~ m/(\d+)\s+IP:(\d+)\s+AX:(\S+) \[(\S+)\]\s+BX:(\S+) \[(\S+)\]\s+CX:(\S+) \[(\S+)\]/) #Instruction pointer/register line
+ {
+ my $t;
+ $t->{'time'} = $1;
+ $t->{'inst'} = $2;
+ $t->{AX}->{'dec'} = $3;
+ $t->{AX}->{'hex'} = $4;
+ $t->{BX}->{'dec'} = $5;
+ $t->{BX}->{'hex'} = $6;
+ $t->{CX}->{'dec'} = $7;
+ $t->{CX}->{'hex'} = $8;
+
+ $t->{'aged_time'} = $t->{'time'};
+ if ( $_ =~ m/AgedTime:(\d+)/ )
+ {
+ $t->{'aged_time'} = $1;
+ }
+ my $on_line;
+
+ #The next line is the read/write/flow heads #ignore
+ $on_line = <TRACE>;
+
+ #The next line is stack 0 #ignore
+ $on_line = <TRACE>;
+ chomp $on_line;
+ $t->{stack_0} = $on_line;
+
+ #The next line is stack 1 #ignore
+ $on_line = <TRACE>;
+ chomp $on_line;
+ $t->{stack_1} = $on_line;
+
+ #The next line is memory #ignore
+ $on_line = <TRACE>;
+
+ #The next line is merit/bonus/tasks
+ $on_line = <TRACE>;
+ chomp $on_line;
+ $on_line =~ m/Bonus:\s*(\d+)\s*Errors:\s*(\d+)\s*Donates:\s*(\d+)/;
+ $t->{bonus} = $1;
+ $t->{donates} = $3;
+
+ #The next line is tasks
+ $on_line = <TRACE>;
+ my $original_line = $on_line;
+
+ chomp $on_line;
+ $on_line =~ m/:\s*(.+)$/;
+ $on_line = $1;
+ $on_line =~ s/\(\S+\)\s*//g;
+ $on_line =~ s/\s*$//g; #Not sure why I need this to get rid of trailing space
+ @{$t->{tasks}} = split /\s+/, $on_line;
+
+ #print "$original_line\n" if (scalar @{$t->{tasks}} != 9);
+
+ #Next line is blank
+ $on_line = <TRACE>;
+
+ #Next line is Input (env)
+ #Next line is Input (buf)
+ #Next line is Output
+ $on_line = <TRACE>;
+ $on_line = <TRACE>;
+ $on_line = <TRACE>;
+ #Next line is ----
+ #Next line is ABOUT To EXECUTE
+ $on_line = <TRACE>;
+ $on_line = <TRACE>;
+
+ #Handle saved resources
+ if ($cur_resource_line)
+ {
+ $resources_found = 1;
+ @{$t->{resources}} = @{$t->{resources}} = split /\s+/, $cur_resource_line;
+ }
+ #print Dumper($t);
+ push @trace, $t;
+ }
+ if ($_ =~ s/^Resources: //)
+ {
+ $cur_resource_line = $_;
+ }
+
+}
+close TRACE;
+
+if ($movie)
+{
+ `rm -r $output` if (-e "$output");
+ mkdir $output;
+}
+
+#These constants control how the drawing is made
+our $inst_size_y = 7;
+our $inst_size_x = 7;
+our $inst_space_x = 1;
+
+our $min_size_x = 850;
+our $total_x = $inst_size_x * (scalar @inst) + $inst_space_x * ((scalar @inst) + 1);
+$total_x = $min_size_x if ($total_x < $min_size_x);
+
+our $arc_height_increment = 2;
+our $arc_height_initial = 5;
+
+our $text_size_y = 90;
+
+#Go through the execution to determing how high the drawing needs to be...
+
+#Now draw arrows showing execution
+my $drawn_connections = {};
+my $arc_height = $arc_height_initial;
+foreach (my $i=1; $i < scalar @trace; $i++)
+{
+ if ($trace[$i]->{inst} != $trace[$i-1]->{inst})
+ {
+ my $key = "$trace[$i-1]->{inst}_$trace[$i]->{inst}";
+ next if ($each_execution_once && defined $drawn_connections->{$key});
+
+ $drawn_connections->{$key}++;
+ $arc_height +=$arc_height_increment;
+ }
+}
+
+our $total_y = $arc_height + 10 + 10 + $inst_size_y;
+our $text_y = $total_y;
+$total_y += $text_size_y;
+our $inst_y = $arc_height + 10;
+
+# create a new image
+my $img = new GD::Image($total_x,$total_y);
+$img->interlaced('true');
+
+# allocate some colors
+our $colors;
+$colors->{white} = $img->colorAllocate(255,255,255);
+$colors->{black} = $img->colorAllocate(0,0,0);
+$colors->{red} = $img->colorAllocate(255,0,0);
+$colors->{blue} = $img->colorAllocate(0,0,255);
+$colors->{green} = $img->colorAllocate(0,255,0);
+$colors->{gray} = $img->colorAllocate(127,127,127);
+$colors->{cyan} = $img->colorAllocate(64,240,240);
+$colors->{magenta} = $img->colorAllocate(250,64,220);
+$colors->{orange} = $img->colorAllocate(250,150,55);
+$colors->{purple} = $img->colorAllocate(137,30,246);
+
+
+our $inst_to_style = {
+ 'nop-A' => { 'c' => 'red', 's' => 'circle' },
+ 'nop-B' => { 'c' => 'green', 's' => 'circle' },
+ 'nop-C' => { 'c' => 'blue', 's' => 'circle' },
+ 'sense' => { 'c' => 'blue', 's' => 'triangle' },
+ 'goto' => { 'c' => 'green', 's' => 'square' },
+ 'label' => { 'c' => 'red', 's' => 'square' },
+ 'throw' => { 'c' => 'green', 's' => 'square' },
+ 'catch' => { 'c' => 'red', 's' => 'square' },
+ 'nand' => { 'c' => 'orange', 's' => 'square' },
+ 'get' => { 'c' => 'magenta', 's' => 'square' },
+ 'put' => { 'c' => 'cyan', 's' => 'square' },
+ 'repro' => { 'c' => 'purple', 's' => 'square' },
+ 'default' => { 'c' => 'black', 's' => 'square' }
+};
+
+our $max_label_size = 8;
+our $inst_use_nops = {
+ 'if-n-equ' => 1,
+ 'if-less' => 1,
+ 'pop' => 1,
+ 'push' => 1,
+ 'shift-r' => 1,
+ 'shift-l' => 1,
+ 'inc' => 1,
+ 'dec' => 1,
+ 'add' => 1,
+ 'sub' => 1,
+ 'nand' => 1,
+ 'get' => 1,
+ 'put' => 1,
+ 'goto' => $max_label_size,
+ 'goto-if=0' => $max_label_size,
+ 'goto-if!=0' => $max_label_size,
+ 'label' => $max_label_size,
+ 'throw' => $max_label_size,
+ 'throwif=0' => $max_label_size,
+ 'throwif!=0' => $max_label_size,
+ 'catch' => $max_label_size,
+ 'sense-m100' => $max_label_size,
+};
+
+our @execution_flare_colors = (
+ $img->colorAllocate( 255, 0, 0),
+ $img->colorAllocate( 0, 50, 0),
+ $img->colorAllocate( 0, 75, 0),
+ $img->colorAllocate( 0, 100, 0),
+ $img->colorAllocate( 0, 125, 0),
+ $img->colorAllocate( 0, 150, 0),
+ $img->colorAllocate( 0, 175, 0),
+ $img->colorAllocate( 0, 200, 0),
+ $img->colorAllocate( 0, 230, 0),
+ $img->colorAllocate( 0, 255, 0),
+ $img->colorAllocate( 25, 255, 25),
+ $img->colorAllocate( 50, 255, 50),
+ $img->colorAllocate( 75, 255, 75),
+ $img->colorAllocate(100, 255, 100),
+ $img->colorAllocate(125, 255, 125),
+ $img->colorAllocate(150, 255, 150),
+ $img->colorAllocate(175, 255, 175),
+ $img->colorAllocate(200, 255, 200),
+ $img->colorAllocate(220, 220, 220),
+
+);
+
+
+
+#print Dumper($colors);
+
+#Draw grayed out instructions for each box
+for (my $i=0; $i< scalar @inst; $i++)
+{
+ draw_instruction($i, $colors->{gray});
+}
+
+#Draw a connecting line, vertically centered
+$img->line($inst_space_x,$inst_y + $inst_size_y / 2 ,(scalar @inst - 1) * ($inst_size_x + $inst_space_x), $inst_y + $inst_size_y / 2,$colors->{gray});
+
+#Draw ALL nops in default colors
+#foreach (my $i=0; $i < scalar @inst; $i++)
+#{
+# draw_instruction($i) if ($inst[$i] =~ m/^nop/);
+#}
+
+$drawn_connections = {};
+$arc_height = $arc_height_initial;
+our @arc_memory;
+
+
+my $frame;
+#Now draw arrows showing execution
+foreach (my $i=0; $i < scalar @trace; $i++)
+{
+ #Now draw over instructions that were used in their default colors
+ draw_instruction($trace[$i]->{inst});
+
+ #Include nops as long as we find them and are within the limits of what the inst uses
+ my @nop_list;
+ if ($inst_use_nops->{$inst[$trace[$i]->{inst}]})
+ {
+ my $used_nops = 0;
+ while ( ($inst[($trace[$i]->{inst}+1+$used_nops) % scalar @inst] =~ m/^nop/)
+ && ($used_nops < $inst_use_nops->{$inst[$trace[$i]->{inst}]}) )
+ {
+ $used_nops++;
+ draw_instruction( ($trace[$i]->{inst}+$used_nops) % scalar @inst );
+ push @nop_list, $inst[($trace[$i]->{inst}+$used_nops) % scalar @inst];
+ }
+ }
+
+ $frame++;
+ die "Exceeded frame limit (-f)." if ($movie && ($frame > $frame_limit));
+
+ if ($i!=0 and $trace[$i]->{inst} != $trace[$i-1]->{inst})
+ {
+ my $key = "$trace[$i-1]->{inst}_$trace[$i]->{inst}";
+
+ #Increment the arc_height if drawing multiple connections of does not exist
+
+ if ($each_execution_once)
+ {
+ if (!defined $drawn_connections->{$key})
+ {
+ $arc_height += $arc_height_increment;
+ $drawn_connections->{$key} = $arc_height;
+ }
+ }
+ else
+ {
+ $arc_height += $arc_height_increment;
+ $drawn_connections->{$key} = $arc_height;
+ }
+
+ my $new_arc = { 'h'=> $drawn_connections->{$key}, '1' => $trace[$i-1]->{inst}, '2' => $trace[$i]->{inst} };
+ unshift @arc_memory, $new_arc;
+ #remove last arc
+ pop @arc_memory if (scalar @arc_memory > scalar @execution_flare_colors);
+
+ #redraw all arcs in memory from oldest to newest
+ foreach (my $a= scalar @arc_memory-1; $a >= 0; $a--)
+ {
+ my $this_arc = $arc_memory[$a];
+ draw_execution_arc($this_arc->{1}, $this_arc->{2}, $this_arc->{h}, $execution_flare_colors[$a]);
+ #print Dumper($this_arc, $execution_flare_colors[$a]);
+ }
+ }
+
+ #Erase the bottom information
+ $img->filledRectangle(0,$text_y,$total_x,$total_y,$colors->{white});
+
+ #Draw current instruction name
+ $img->string(gdMediumBoldFont,3,$text_y,$trace[$i]->{time},$colors->{black});
+ $img->string(gdMediumBoldFont,52,$text_y, "$inst[$trace[$i]->{inst}] @nop_list", $colors->{black});
+
+ my $text_color;
+ $text_color = ($i==0 or $trace[$i]->{AX}->{'dec'} == $trace[$i-1]->{AX}->{'dec'}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,252,$text_y,"AX: $trace[$i]->{AX}->{'dec'} [$trace[$i]->{AX}->{'hex'}]",$text_color);
+
+ $text_color = ($i==0 or $trace[$i]->{BX}->{'dec'} == $trace[$i-1]->{BX}->{'dec'}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,452,$text_y,"BX: $trace[$i]->{BX}->{'dec'} [$trace[$i]->{BX}->{'hex'}]",$text_color);
+
+ $text_color = ($i==0 or $trace[$i]->{CX}->{'dec'} == $trace[$i-1]->{CX}->{'dec'}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,652,$text_y,"CX: $trace[$i]->{CX}->{'dec'} [$trace[$i]->{CX}->{'hex'}]",$text_color);
+
+ $text_color = ($i==0 or $trace[$i]->{stack_0} eq $trace[$i-1]->{stack_0}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,3,$text_y + 18,$trace[$i]->{stack_0},$text_color);
+ $text_color = ($i==0 or $trace[$i]->{stack_1} eq $trace[$i-1]->{stack_1}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,3,$text_y + 36,$trace[$i]->{stack_1},$text_color);
+
+ $text_color = ($i==0 or $trace[$i]->{bonus} == $trace[$i-1]->{bonus}) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,3,$text_y + 54,"Bonus: $trace[$i]->{bonus}",$text_color);
+
+ $img->string(gdMediumBoldFont,180,$text_y + 54,"Tasks:",$colors->{black});
+ for (my $b=0; $b<scalar @{$trace[$i]->{tasks}}; $b++)
+ {
+ if (!defined $trace[$i]->{tasks}->[$b] or !defined $trace[$i-1]->{tasks}->[$b])
+ {
+ print Dumper($trace[$i]->{tasks}, $trace[$i-1]->{tasks});
+ }
+ $text_color = ($i==0 or $trace[$i]->{tasks}->[$b] == $trace[$i-1]->{tasks}->[$b]) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,250 + 50 * $b,$text_y + 54,"$trace[$i]->{tasks}->[$b]",$text_color);
+ }
+
+ #$img->string(gdMediumBoldFont,3,$text_y + 72,"Effective Time:",$colors->{black});
+ $img->string(gdMediumBoldFont,3,$text_y + 72,$trace[$i]->{aged_time},$colors->{black});
+
+ if ($resources_found)
+ {
+ $img->string(gdMediumBoldFont,153,$text_y + 72,"Resources:",$colors->{black});
+ for (my $b=0; $b<scalar @{$trace[$i]->{resources}}; $b++)
+ {
+ if (!defined $trace[$i]->{resources}->[$b] or !defined $trace[$i-1]->{resources}->[$b])
+ {
+ print Dumper($trace[$i]->{resources}, $trace[$i-1]->{resources});
+ }
+ $text_color = ($i==0 or $trace[$i]->{resources}->[$b] == $trace[$i-1]->{resources}->[$b]) ? $colors->{black} : $colors->{red};
+ $img->string(gdMediumBoldFont,250 + 50 * $b,$text_y + 72,"$trace[$i]->{resources}->[$b]",$text_color);
+ }
+ }
+
+ if ($movie)
+ {
+ open OUT, ">$output/$frame.png";
+ print OUT $img->png;
+
+ }
+}
+
+
+# make the background transparent and interlaced
+#$im->transparent($white);
+
+# Put a black frame around the picture
+#$im->rectangle(0,0,99,99,$black);
+
+# Draw a blue oval
+#$im->arc(50,50,95,75,0,360,$blue);
+
+# And fill it with red
+#$im->fill(50,50,$red);
+
+# make sure we are writing to a binary stream
+
+# Convert the image to PNG and print it on standard output
+if (!$movie)
+{
+ open OUT, ">$output";
+ binmode OUT;
+ print OUT $img->png;
+}
+
+#end of program
+
+sub find_inst_hash_match
+{
+ my ($inst) = @_;
+
+ foreach my $key (keys %$inst_to_style)
+ {
+ return $key if ($inst =~ /^\Q$key\E/);
+ }
+
+ return 'default';
+}
+
+sub get_inst_color
+{
+ my ($inst) = @_;
+ return $inst_to_style->{find_inst_hash_match($inst)}->{c};
+}
+
+sub get_inst_shape
+{
+ my ($inst) = @_;
+ return $inst_to_style->{find_inst_hash_match($inst)}->{s};
+}
+
+
+sub draw_instruction
+{
+ my ($i, $color) = @_;
+ my $x = $inst_space_x + $i * ($inst_space_x + $inst_size_x);
+
+ $color = $colors->{get_inst_color($inst[$i])} if (!defined $color);
+ my $shape = get_inst_shape($inst[$i]);
+
+ #Decide how to draw it
+ if ($shape eq 'square')
+ {
+ $img->filledRectangle($x,$inst_y,$x+$inst_size_x-1,$inst_y+$inst_size_y-1,$color);
+ }
+ elsif ($shape eq 'circle')
+ {
+ $img->filledArc($x+$inst_size_x/2,$inst_y+$inst_size_y/2,$inst_size_x,$inst_size_y,0,360,$color);
+
+ }
+ elsif ($shape eq 'triangle')
+ {
+ my $poly = new GD::Polygon;
+ $poly->addPt($x + $inst_size_x / 2,$inst_y);
+ $poly->addPt($x, $inst_y + $inst_size_y - 1);
+ $poly->addPt($x + $inst_size_x - 1, $inst_y + $inst_size_y - 1);
+
+ # draw the polygon, filling it with a color
+ $img->filledPolygon($poly,$color);
+ }
+
+}
+
+
+sub draw_execution_arc
+{
+ my ($i, $j, $h, $color) = @_;
+
+ if ($i > $j)
+ {
+ my $temp = $i;
+ $i = $j;
+ $j = $temp;
+ }
+
+ my $cx = ($inst_space_x + $i * ($inst_space_x + $inst_size_x) + $inst_space_x + $j * ($inst_space_x + $inst_size_x) + $inst_size_x) /2;
+ my $w = ($j - $i) * ($inst_space_x + $inst_size_x);
+
+ $img->arc($cx, $inst_y-1, $w, $h * 2, 180, 0, $color);
+}
Property changes on: development/support/scripts/trace_movie.pl
___________________________________________________________________
Name: svn:executable
+ *
More information about the Avida-cvs
mailing list