prime.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

sub is_prime;

# index: 0 1 2 3 4 5 6 7 9 10 11 ...
# value: 0 0 1 1 0 1 0 1 0 0 1 ...
my @primes_mask = map {is_prime($_)} (0..200);

# "DNA" instruction set
my $lang = '+-<>[]_';

# initial population: 1000 times worst one
my $best_fit = {prg => 'all your base are belong to us!', fit => 0};
my @population = ($best_fit) x 1000;

# mark *result* array of program, by counting good answers
sub fitness($)
{
  my $program = shift;
  my @arr = run($program);

  my $count = 0;
  for my $i (0 .. $#arr) {
    if($primes_mask[$i] ==  ($arr[$i]//0)) {
      $count++
    }
  }
  return $count;
}

# insert, append, delete, or let i be
sub mutate($)
{
  my $program = shift;

  my $r = int(rand(4));
  my $i = int(rand(length($program)+1));
  my $c = substr($lang, int(rand(length($lang))), 1);

  if($r == 0) {
    # delete
    return substr($program,0,$i).($i>=length($program)? '': substr($program,$i+1));
  }
  if($r == 1) {
    # insert $c
    return substr($program,0,$i).$c.substr($program,$i);
  }
  if($r == 2) {
    # append $c
    return $program . $c;
  }

  # nothing
  return $program;
}

# note: used only for construction array @prime_mask, to compute fitness
my %primes;
sub is_prime($)
{
  my $n = shift;
  return 0 if $n < 2;
  if(! defined($primes{$n}) ) {
    $primes{$n} = 1;
    for(my $i = int(sqrt($n)); $i > 1; $i--){
      if($n % $i == 0) {
        $primes{$n} = 0;
        last;
      }
    }
  }
  return $primes{$n};
}

# compile "DNA" and run, subset of Brainfuck laguage
# only '<>+-[]' istructions, no ',.'
# see https://en.wikipedia.org/wiki/Brainfuck
# function retuns array, which is result of brainfuck program
sub run($;$)
{
  my $program = shift;
  my $dbg = shift;
  my $code = "my \@a;my \$l=0;my \$p=0;\n";
  my $depth = 0;

  # translate brainfuck into perl
  for my $instr (split(//, $program)) {
    my $prefix = ' ' x $depth;
    my $c;
    if( $instr eq '<' )    { $c = '$p--;if($p<0) { return @a;}'}
    elsif( $instr eq '>' ) { $c = '$p++;'}
    elsif( $instr eq '+' ) { $c = '$a[$p]++;'; }
    elsif( $instr eq '-' ) { $c = '$a[$p]--;'; }
    elsif( $instr eq '[' ) { $c = 'while($a[$p]){if($l++ > 1_000_000){ return ();} '; $depth++ }
    elsif( $instr eq ']' ) { if( $depth > 0 ) {
                                  $c = '}';
                                  $depth--;
                                  $prefix = ' ' x $depth;
                              }
                              else {
                                next;
                              }
                            }
    else {
      next;
    }
    $code .= "$prefix$c\n";
  }
  while($depth--){
    $code .= '}';
  }

  $code .= "\nreturn \@a;\n#end\n";

  #run perl $code
  my @ret = eval $code;

  # should not happen: error in eval();
  die "died:$program: $@" if $@;

  # for debuging
  print "$code\n" if $dbg;

  # result
  return @ret;
}

# one small step in evolution:
# chose randomly 2 programs
# pick better (with higher fitness)
# copy it
# mutate them
# return them to population
sub step()
{
  my $p1 = int(rand(scalar(@population)-1));
  my $p2 = int(rand(scalar(@population)-1));
  my $f1 = $population[$p1]->{fit}//0;
  my $f2 = $population[$p2]->{fit}//0;

  my $sur = $f1 > $f2 ? $p1 : $p2;
  my $del = $f1 > $f2 ? $p2 : $p1;

  splice(@population, $del, 1);

  my $ori = $population[$sur]->{prg};

  # mutate new
  my $new_prg = mutate($ori);
  die "null $ori ($sur)\n" if  ! defined($new_prg);
  my $new = {prg => $new_prg, fit => fitness($new_prg)};
  push @population, $new;

  if($new->{fit} > ($best_fit->{fit}//0)) {
    $best_fit = $new;
    print "new best:fit=$best_fit->{fit},prg=$best_fit->{prg}\n";
  }

  # mutate orginal
  $population[$sur]->{prg} = mutate($population[$sur]->{prg});
  $population[$sur]->{fit} = fitness($population[$sur]->{prg});
}

################################################
## main

$|++;

my $cmd = shift @ARGV;
if ($cmd) {
  print join(",", map {$_//0} run($cmd,1)), "\n";
  exit;
}

# 640k steps must be enough for anyone
for my $s (1 .. 640_000) {
  step();
  my $p = $population[int(rand(1000))];
  print "step $s:fit=$p->{fit},prg=$p->{prg}\n" if $s % 1000 == 0;
}
print "best:fit=$best_fit->{fit},prg=$best_fit->{prg}\n";

# fit => 100,
# prg => "a]_>h>+>+>>+>_]>+>-_>>>+>>+>__>>>+>>__+>>]-+>>+>>]_>-+>>+]->+>[]>+[>>>]>]>[]>+>>>__]>+[-_+>>-++>>>+-_]]>+__>>>>>___-+_>+<+->>>>>]>>+>]>+_>>>>__-]_+>>+>>>+->+>_>[+<<]]+>>>+-_]_>>>->+->>>+-]+>>>>]+-[]>+-]>+]>>>>>>+->_>-+>]>>>>-+_",