http://www.perlmonks.org?node_id=1195601

A little over a year ago, i have been playing with AI::Genetic, Javascript::V8 and Strandbeest evolution for a Linuxdays Demo. I wrote this originally as a distributed genetic evolution demo, complete with managment web interface, but for the sake of clarity, here is the single-user command-line version of it.

(I might do another meditation later that show more of the distributed stuff, but my Raspberry Pi cluster is still in a packing crate in the attic... i hope... after moving house in a chaotioc fashion).

Before i begin, you should note that the Javascript::V8 version on CPAN has a memory leak. You might try my own, non-official version at https://cavac.at/public/mercurial/JavaScript-V8/. It is in a mercurial repo, so you should be able to do this:

hg clone https://cavac.at/public/mercurial/JavaScript-V8/ cd JavaScript-V8 perl Makefile.PL make test install distclean

The magic of Strandbeests

I was always fascinated my Strandbeests, the huge moving "animals" created by Theo Jansen. Although mostly made out of PVC tubes, they exhibit a really strange, lifelike movement.

The key part of this creatures of the length relationship between their eleven leg parts that lets them walk with very little effort. As Theo put it: "But even for the computer the number of possible ratios between 11 rods was immense. Suppose every rod can have 10 different lengths, then there are 10,000,000,000,000 possible curves. If the computer were to go through all these possibilities systematically, it would be kept busy for 100,000 years. I didn't have this much time, which is why I opted for the evolutionary method."

Computers? Doing evolution? Hell yeah, i needed to learn how thats done!

Why JavaScript?

While i'm a competent developer when it comes to PostgreSQL databases, HTML and similar stuff, a lot of the math required for analyzing and evaluating the movement of a Strandbeest leg is completely outside my comfort zone (i.e. i have absolutely no clue how to do it).

Thankfully, someone on Stackoverflow made a nice Javascript demo, which (for my Linuxdays thing) also solved the HTML visualization problem for me.

Perl to the rescue

This is where i came in. Now i had two options. Either convert the JS code to Perl (and keep it compatible with the JS version, so the HTML visu was in sync), or just use Javascript without the drawing functions from within Perl. I chose the latter, because it seemed easier.

To run the genetic evolution algorithm itself, i chose the AI::Genetic module, since this seemed the easiest interface for what i needed.

Before we begin, we need to define FileSlurp.pm (which is a simplified copy from the one in my maplat_helpers repo):

package FileSlurp; #---AUTOPRAGMASTART--- use 5.012; use strict; use warnings; use diagnostics; use mro 'c3'; use English qw( -no_match_vars ); use Carp; our $VERSION = 1.7; no if $] >= 5.017011, warnings => 'experimental::smartmatch'; use Fatal qw( close ); #---AUTOPRAGMAEND--- use base qw(Exporter); our @EXPORT_OK = qw(slurpTextFile slurpBinFile writeBinFile slurpBinFi +lehandle slurpBinFilePart); use File::Binary; sub slurpTextFile { my $fname = shift; # Read in file in binary mode, slurping it into a single scalar. # We have to make sure we use binmode *and* turn on the line termi +nation variable completly # to work around the multiple idiosynchrasies of Perl on Windows open(my $fh, "<", $fname) or croak($ERRNO); local $INPUT_RECORD_SEPARATOR = undef; binmode($fh); my $data = <$fh>; close($fh); # Convert line endings to a single format. This certainly is not p +erfect, # but it works in my case. So i don't f...ing care. $data =~ s/\015\012/\012/go; $data =~ s/\012\015/\012/go; $data =~ s/\015/\012/go; # Split the lines, which also removes the linebreaks my @datalines = split/\012/, $data; return @datalines; } sub slurpBinFile { my $fname = shift; # Read in file in binary mode, slurping it into a single scalar. # We have to make sure we use binmode *and* turn on the line termi +nation variable completly # to work around the multiple idiosynchrasies of Perl on Windows open(my $fh, "<", $fname) or croak($ERRNO); local $INPUT_RECORD_SEPARATOR = undef; binmode($fh); my $data = <$fh>; close($fh); return $data; } sub slurpBinFilePart { my ($fname, $start, $len) = @_; # Read in file in binary mode, slurping it into a single scalar. # We have to make sure we use binmode *and* turn on the line termi +nation variable completly # to work around the multiple idiosynchrasies of Perl on Windows my $fb = File::Binary->new($fname); $fb->seek($start); my $data = $fb->get_bytes($len); $fb->close(); return $data; } sub slurpBinFilehandle { my $fh = shift; # Read in file in binary mode, slurping it into a single scalar. # We have to make sure we use binmode *and* turn on the line termi +nation variable completly # to work around the multiple idiosynchrasies of Perl on Windows local $INPUT_RECORD_SEPARATOR = undef; binmode($fh); my $data = <$fh>; close($fh); return $data; } sub writeBinFile { my ($fname, $data) = @_; # Read in file in binary mode, slurping it into a single scalar. # We have to make sure we use binmode *and* turn on the line termi +nation variable completly # to work around the multiple idiosynchrasies of Perl on Windows open(my $fh, ">", $fname) or croak($ERRNO); local $INPUT_RECORD_SEPARATOR = undef; binmode($fh); print $fh $data; close($fh); return 1; } 1; __END__

We also need James Coglan's Sylvester Vector and Matrix library for JavaScript, saved as "sylvester.js"

And last but not least in our list of "support" files, the Strandbeest evaluation function itself, saved in a file with the name "strandbeest.js". This is the one with all the graphical functions removed:

// Theo Jansen's STRANDBEEST // <http://strandbeest.com/> // Code adapted from user heltonbiker at Stack Overflow // <http://stackoverflow.com/questions/6573415/evolutionary-algorithm- +for-the-theo-jansen-walking-mechanism> function fmod(a, b) { if (a < 0) { return b - (-a) % b } else { return a % b } } function fromPoint(p, d, theta) { return p.add(Vector.create([Math.cos(theta), Math.sin(theta)]).x(d +)) } function radians(d) { return d * Math.PI / 180 } // Return 2-dimensional vector cross product of p and q. function cross2(p, q) { var P = p.elements var Q = q.elements return P[0] * Q[1] - P[1] * Q[0] } // Return a point R that's distance l1 from p1, and distance l2 from p +2, // and p1-p2-R is clockwise. function inter(p1, l1, p2, l2) { var D = p2.subtract(p1) // Vector from p1 to p2. var d = D.modulus() // Dist from p2 to p1. var a = (l1*l1 - l2*l2 + d*d) / (2*d) // Dist from p1 to radical +line. var M = p1.add(D.x(a / d)) // Intersection of D w/radi +cal line var h = Math.sqrt(l1*l1 - a*a) // Distance from M to R1 or + R2. var R = D.x(h / d) var r = Vector.create([-R.elements[1], R.elements[0]]) // There are two results, but only one (the correct side of the // line) must be chosen var R1 = M.add(r) if (cross2(D, R1.subtract(p1)) < 0) { return M.subtract(r) } else { return R1 } } function Beest() { this.angle = 0; this.lines = ["AC", "CD", "BD", "BE", "CE", "DF", "BF", "FG", "EG", "GH", "EH"]; this.magic = ["Bx", "By"].concat(this.lines); this.update(); } Beest.prototype = { constructor: Beest, update: function () { var text = "" for (var i = 0; i < this.magic.length; ++i) { var m = this.magic[i] this[m] = parseFloat(params[m]); } this.footprint = []; this.linkageBroken = false; this.analyzedFootprint = false; this.tolerance = 2; // Range of values of Y that count a +s "ground" this.Ymax = 0; this.liftheight = 35; this.lifttolerance = 15; this.maxliftheight = 60; this.maxlifttolerance = 20; }, addPoint: function (label, p) { p.angle = this.angle p.label = label this.points.push(p) this[label] = p }, footprintGrounded: function (i) { return (Math.abs(this.Ymax - this.footprint[i].elements[1]) < this.tolerance) }, footprintLifted: function (i) { return (Math.abs((this.Ymax - this.liftheight) - this.footprin +t[i].elements[1]) < this.lifttolerance) }, analyzeFootprint: function () { var f = this.footprint; this.Ymax = 0; // Extremal value of Y: counts as "g +round" this.Ymin = 1000000; for (var i = 0; i < f.length; ++i) { this.Ymax = Math.max(this.Ymax, f[i].elements[1]); this.Ymin = Math.min(this.Ymin, f[i].elements[1]); } var groundAngle = 0; // Angle spent on the ground. var liftAngle = 0; var minVx = 1e10; var maxVx = -1e10; for (var i = 0; i < f.length; ++i) { if (this.footprintGrounded(i)) { var j = (i + 1) % f.length var a = f[j].angle var b = f[i].angle var dt if (a < b) { dt = b - a } else { dt = a - b - 360 } groundAngle += dt if (dt > 0) { var vx = (f[j].elements[0] - f[i].elements[0]) / d +t minVx = Math.min(minVx, vx) maxVx = Math.max(maxVx, vx) } } if (this.footprintLifted(i)) { var j = (i + 1) % f.length var a = f[j].angle var b = f[i].angle var dt if (a < b) { dt = b - a } else { dt = a - b - 360 } liftAngle += dt } } this.analyzedFootprint = true var text = "" for (var i = 0; i < this.magic.length; ++i) { var m = this.magic[i] text += m + "=" + this[m] + "; " } text += "groundScore: " + (groundAngle / 360.0).toFixed(3); text += "; dragScore: " + (Math.max(- maxVx + minVx)).toFixed( +3); text += "; liftScore: " + (liftAngle / 360.0).toFixed(3); var maxliftscore = (this.Ymax - this.Ymin - this.maxliftheight +) / this.maxlifttolerance; if(maxliftscore < 0.0) { maxliftscore = 0.0; } //write(text); setFinished('ground', (groundAngle / 360.0), 'drag', (Math.max +(- maxVx + minVx)), 'lift', (liftAngle / 360.0), 'maxlift', maxliftsc +ore); isFinished = 1; }, tick: function (dt) { this.angle += speed * dt; this.points = [] this.addPoint("A", Vector.create([0,0])) this.addPoint("B", Vector.create([this.Bx, -this.By])) this.addPoint("C", fromPoint(this.A, this.AC, radians(this.ang +le))) this.addPoint("D", inter(this.C, this.CD, this.B, this.BD)) this.addPoint("E", inter(this.B, this.BE, this.C, this.CE)) this.addPoint("F", inter(this.D, this.DF, this.B, this.BF)) this.addPoint("G", inter(this.F, this.FG, this.E, this.EG)) this.addPoint("H", inter(this.G, this.GH, this.E, this.EH)) if (isNaN(this.H.elements[0]) || isNaN(this.H.elements[1])) { this.linkageBroken = true; setFailed("Broken Linkage"); isFinished = 1; } else { this.footprint.push(this.H) } var footprintComplete = false while (this.footprint[0].angle - 360 > this.angle) { this.footprint.shift() footprintComplete = true } if (!this.analyzedFootprint && !this.linkageBroken && footprintComplete) { this.analyzeFootprint() } }, } var speed = -60; // Speed of crank rotation, degrees/s +ec. var lastFrame; var beest; var isFinished = 0; function beestTick() { var t = (new Date()).getTime() var dt = Math.min(1.0 / 30, (t - lastFrame) / 1000.0) lastFrame = t beest.tick(params.dt) } lastFrame = (new Date()).getTime(); beest = new Beest(); while(!isFinished) { beestTick(); }

Now that we have to copied portions of our code, let's write some of our own.

beest.pl

This is basically our caller for the main module and runs the main loop. First we check for some command line arguments, set up the evolver, and then run in an infinite loop.

We want to support 4 different arguments:

Here is the code (file "beest.pl"):

#/usr/bin/env perl #---AUTOPRAGMASTART--- use 5.012; use strict; use warnings; use diagnostics; use mro 'c3'; use English qw( -no_match_vars ); use Carp; our $VERSION = 1.7; no if $] >= 5.017011, warnings => 'experimental::smartmatch'; use Fatal qw( close ); #---AUTOPRAGMAEND--- BEGIN { push @INC, '.'; } use Evolver; use FileSlurp qw(slurpBinFile writeBinFile); use Array::Contains; my $bestscore = -10000; my $beest = Evolver->new(); $beest->resetStates; my $saving = 0; if(contains('--save', \@ARGV)) { print "Will save fittest to fittest.dat\n"; $saving = 1; } if(contains('--load', \@ARGV)) { if(!-f 'fittest.dat') { croak("File fittest.dat not found"); } my $data = slurpBinFile('fittest.dat'); $beest->crossPolinate($data); } foreach my $arg (@ARGV) { if($arg =~ /\-\-(.*)\=(.*)/) { $beest->config($1 => $2); } } while(1) { my ($generation, $newbestscore) = $beest->evolve; if($newbestscore > $bestscore) { print "** New best fittness score $bestscore\n"; my $fittest = $beest->getFittest; $bestscore = $newbestscore; if($saving) { writeBinFile('fittest.dat', $fittest); } } } sub doSpacePad { my ($val, $len) = @_; croak("$val longer than $len") if(length($val) > $len); #return $val if(length($val) == $len); $val .= ' ' x ($len - length($val)); return $val; } sub doTrim { my ($val) = @_; $val =~ s/\ +$//; return $val; }

Evolver.pm

Most of what Evolver.pm does, is a pretty straight forward wrapper around AI::Genetic, except the Javascript-Handling:

use JavaScript::V8; ... my $vectorjs = slurpBinFile('sylvester.js'); my $strandbeestjs = slurpBinFile('strandbeest.js'); my $js = $vectorjs . ' ' . $strandbeestjs; ... my $ok = -1; my $errortype = 'MATH_ERROR'; my %scores; my $ctx = JavaScript::V8::Context->new(); $ctx->bind_function(write => sub { print @_ }); $ctx->bind_function(setFailed => sub { $ok = 0; $errortype = shift @_; }); $ctx->bind_function(setFinished => sub { $ok = 1; %scores = @_; }); $ctx->bind(params => \%params); $ctx->eval($js); my $error = $@; my $total = -1000; # Default: Failed! if(defined($error)) { print("SCRIPT ERROR: $error\n"); } elsif($ok == -1) { print("Script didn't call setFailed() or setFinished()\n"); } ...

Here is the full code of Evolver.pm:

#/usr/bin/env perl package Evolver; #---AUTOPRAGMASTART--- use 5.012; use strict; use warnings; use diagnostics; use mro 'c3'; use English qw( -no_match_vars ); use Carp; our $VERSION = 1.7; no if $] >= 5.017011, warnings => 'experimental::smartmatch'; use Fatal qw( close ); #---AUTOPRAGMAEND--- use JavaScript::V8; use AI::Genetic; use FileSlurp qw[slurpBinFile]; use Time::HiRes qw(time); use Data::Dumper; my $vectorjs = slurpBinFile('sylvester.js'); my $strandbeestjs = slurpBinFile('strandbeest.js'); my $js = $vectorjs . ' ' . $strandbeestjs; my $precision = 10; my $crosspolinationcount = 3; my $popsize = 20; my $crosspopulated = 0; my @genetics = ( { name => 'Bx', min => -44, max => -32, }, { name => 'By', min => -12, max => -5, }, { name => 'AC', min => 8, max => 18, }, { name => 'CD', min => 40, max => 60, }, { name => 'BD', min => 30, max => 50, }, { name => 'BE', min => 30, max => 50, }, { name => 'CE', min => 50, max => 70, }, { name => 'DF', min => 45, max => 65, }, { name => 'BF', min => 30, max => 50, }, { name => 'FG', min => 30, max => 50, }, { name => 'EG', min => 28, max => 45, }, { name => 'GH', min => 55, max => 75, }, { name => 'EH', min => 40, max => 60, }, ); sub new { my ($proto, %config) = @_; my $class = ref($proto) || $proto; my $self = {}; bless $self, $class; $self->{generation} = 0; return $self; } sub config { my($self, %config) = @_; if(defined($config{population_size})) { $popsize = $config{population_size}; print "Setting population size to $popsize\n"; } if(defined($config{crosspolination_count})) { $crosspolinationcount = $config{crosspolination_count}; print "Settin crosspolination count to $crosspolinationcount\n +"; } } sub resetStates { my ($self) = @_; my $evolver = AI::Genetic->new( -fitness => \&getFitness, -type => 'rangevector', -population => $popsize, -crossover => 0.95, -mutation => 0.10, ); my @initargs; foreach my $genetic (@genetics) { my @pair = ($genetic->{min} * $precision, $genetic->{max} * $p +recision); push @initargs, \@pair; } $evolver->init(\@initargs); $self->{evolver} = $evolver; $self->{generation} = 0; return; } sub evolve { my ($self) = @_; my $starttime = time; $self->{evolver}->evolve('rouletteUniform', 1); my $endtime = time; my $timetaken = $endtime - $starttime; $timetaken = int($timetaken*100)/100; my ($top) = $self->{evolver}->getFittest(1); my $score = $top->score(); if($crosspopulated) { $self->{evolver}->size($popsize); # Reset size } $self->{generation}++; print "Generation ", $self->{generation}, " in $timetaken seconds: + Population size $popsize, Best fit: $score\n"; return ($self->{generation}, $score); } sub getFittest { my ($self) = @_; my @fittest = $self->{evolver}->getFittest($crosspolinationcount); my $i = 0; my @serialparts; foreach my $top (@fittest) { my @temp; my $score = $top->score(); push @temp, $score; my @genes = $top->genes(); foreach my $gene (@genes) { $gene /= $precision; push @temp, $gene; } push @serialparts, join('|', @temp); } my $serialized = join('#', @serialparts); return $serialized; } sub crossPolinate { my ($self, $extragenes) = @_; my @serialparts = split/\#/, $extragenes; foreach my $serialpart (@serialparts) { my ($score, @genes) = split/\|/, $serialpart; $self->{evolver}->inject(1, \@genes); } print "Injected ", scalar @serialparts, " crosspolinator\n"; $crosspopulated = 1; return; } sub getFitness { my ($genes) = @_; my $self; my %params = ( dt => 0.01, # virtual time tick ); for(my $i = 0; $i < scalar @genetics; $i++) { $params{$genetics[$i]->{name}} = $genes->[$i] / 10; } my $ok = -1; my $errortype = 'MATH_ERROR'; my %scores; my $ctx = JavaScript::V8::Context->new(); $ctx->bind_function(write => sub { print @_ }); $ctx->bind_function(setFailed => sub { $ok = 0; $errortype = shift @_; }); $ctx->bind_function(setFinished => sub { $ok = 1; %scores = @_; }); $ctx->bind(params => \%params); $ctx->eval($js); my $error = $@; my $total = -1000; # Default: Failed! if(defined($error)) { print("SCRIPT ERROR: $error\n"); } elsif($ok == -1) { print("Script didn't call setFailed() or setFinished()\n"); } if(!$ok) { #print "Strandbeest feet failed: $errortype\n"; } else { $total = 0; #print 'ground score: ', $scores{ground}, "\n"; $total += abs(0.5 - $scores{ground}); # We want close to 50% #print 'drag score: ', $scores{drag}, "\n"; $total += abs($scores{drag}); # We want close to 0 #print 'lift score: ', $scores{lift}, "\n"; $total += abs(0.2 - $scores{lift}) * 2; # We want close to 20% + at optimum target height #print 'maxlift score: ', $scores{maxlift}, "\n"; $total += abs($scores{maxlift}); # We want close to 0 if(!$total) { $total = 1; # No distance to prefered values } else { $total = -$total; } } #print "Total fitness score: $total (the higher the better)\n"; return $total; }

While i'm a bit sparse here with explanations (never was the type who could do the teaching stuff), it should give you a nice overview of both how to run Genetic algorithms in Perl, as well as how to use existing JavaScript code to solve a problem.

Additional information