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__
[download]

// 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();
}
[download]

#/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;
}
[download]

#/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;
}
[download]