#!/usr/bin/perl -w
# These are the warriors all others are tested against.
@BENCH = (
	  "bench/kat-5.red",
	  "bench/94x-1.red",
	  "bench/myconfuser.red",
	  "bench/request.red",
	  "bench/bigiffs.red",
	  "bench/fireandice2.red",
	  "bench/lithium.red"
	 );

$header = ";redcode-94x\n;strategy No humans were used in the creation of this warrior\n;author bvowk\n;assert (CORESIZE==55440) && (MAXPROCESSES==10000)\n;assert (MAXLENGTH==200)\n;assert (MINDISTANCE==200) && (PSPACESIZE==55440/16)\n";

#Longest allowed warrior
$maxlen = 200;

#Size of the core we're playing in
$CORESIZE = $coresize = 55440;
$distance = 200;
$cycles = 500000;
$processes = 10000;

$rounds = 10;
#How many rounds we test each warrior against the bench warriors for
$validrounds = 4;
#Minimum score a warrior needs before he is called good
$validscore = 6;

#Where we dump the top 3 warriors for skimming later
$save="save";
$data="data";
#Number of warriors we want to breed up to..
$totalpop = 30;
#Number of warriors we keep between generations
$keep = 20;

$count = 0;
srand( time() ^ ($$ + ($$ << 15)) );

$poolnum = int rand 100000;
$cribdeath = $wnum = 0;

print "Loading $data/*\n";
open(DATA,"ls $data|");
while (<DATA>) {
  chomp;
  my $W = $_;
  if (check_valid("$data/$W")) {
    $count++;
    print "\nGood Warrior";
    push(@WARRIORS,"$W");
  } else {
    print "\nGot a bad warrior";
    unlink("$data/$W");
  }
}

makepop($totalpop);

my $ints = 0;

while (1) {
  $ints++;
  print "Starting interation $ints\n";

  my $cnt = $totalpop;

  my $tmp = @WARRIORS;
  print "We have $tmp of $cnt\n";
  for ($i = 0; $i < @WARRIORS; $i++) {
    if($SCORES{$WARRIORS[$i]}){
      next;
    }
    for ($j = 0; $j < @BENCH;$j++) {

      open(PMARS,"pmars -r $rounds -s $coresize -c $cycles -p $processes -d $distance -l $maxlen -b $data/$WARRIORS[$i] $BENCH[$j]|");
      while (<PMARS>) {
	#Get scores
	chomp;
	if ($_ =~ /Results/) {	
	  my ($Trash,$S1,$S2,$Ties) = split;
	  if ($SCORES{$WARRIORS[$i]}) {
	    $SCORES{$WARRIORS[$i]}+=($S1*3) +$Ties;
	  } else {
	    $SCORES{$WARRIORS[$i]} = ($S1*3) +$Ties;
	  }
	}
      }
      close(PMARS);
    }
  }
  $HIGH = $AVG = $cnt = 0;
  $LOW = 999;
  foreach $W (sort {$SCORES{$b} <=> $SCORES{$a}} keys %SCORES) {
    $cnt++;
    if ($cnt <= $keep) {
      if ($cnt <= 3) {
	print "keeping $W with score $SCORES{$W}\n";
	system("cp $data/$W $save/");
      }
      if($HIGH < $SCORES{$W}){
	$HIGH = $SCORES{$W};
      }
      if($LOW > $SCORES{$W}){
	$LOW = $SCORES{$W};
      }
      $AVG = $AVG + $SCORES{$W};
      next;
    }
    for ($j=0;$j < @WARRIORS; $j++) {
      if ($WARRIORS[$j] eq $W) {
	unlink("$data/$W");
	delete $SCORES{$WARRIORS[$j]};
	splice(@WARRIORS,$j,1);
      }
    }
  }
  $AVG = $AVG / @WARRIORS;
  printf("%4.2fM Created %3.2f%% CribDeath %d\/%d\/%3.1f\n",$wnum/1000000,($cribdeath/$wnum)*100,$LOW,$HIGH,$AVG);
  @BREEDERS=@WARRIORS;
  for (;$totalpop > @WARRIORS;) {
    my $W1 = $BREEDERS[int rand (@BREEDERS)];
    my $W2 = $BREEDERS[int rand (@BREEDERS)];

    #print "Breeding $W1 and $W2\n";
    my $W3 = breed($W1,$W2);
    if (!(check_valid("$data/$W3"))) {
      unlink("$data/$W3");
      next;
    }
    push(@WARRIORS,$W3);
  }
}

sub breed {
  my $W1 = shift;
  my $W2 = shift;

  @AW1 = readwarrior($W1);
  @AW2 = readwarrior($W2);

  $C = getwarriorname();
  open(MYC,">$data/$C");
  print MYC "$header;name $C-eve2\nORG 50\n";
  $output = 0;
  for (my $i = 0; $i < $maxlen && $output < $maxlen; $i++) {
    $num = (int rand 100);
    if ($num < 35) {
      if ($AW1[$i]) {
	$nextline = mutate($AW1[$i]);
      } else {
	$nextline = genline();
      }
    }
    if ($num >= 35) {
      if ($AW2[$i]) {
	$nextline = mutate($AW2[$i]);
      } else {
	$nextline = genline();
      }
    }
    #if (int rand 1000 < 10 && $i < $maxlen) {
    #  #repeat gene mutation
    #  $nextline = "$nextline$nextline";
    #  $output++;
    #}
    if (int rand 1000 < 15 && $i < $maxlen) {
      #dropped gene mutation
      $i++;
    }
    if (int rand 1000 < 100 && $i < $maxlen) {
      #new line mutation
      $nextline = genline();
    }
    $output++;
    print MYC "$nextline";
  }
  for(; $output < $maxlen; $output++){
    print MYC genline();
  }

  close(MYC);
  return ($C);
}

sub getwarriorname{
  $wnum++;
  $name = "$wnum-$poolnum";
  return $name;
}


sub genline{
  @MODIFIERS = (
				".A",
				".B",
				".BA",
				".F",
				".X",
				".I",
				" ",
				" "
				);

  @AMODES = (
			 "*",
			 "{",
			 "}",
			 ">",
			 "<",
			 "\#",
			 "\$",
			 "\@"
			 );

  @INSTRUCTIONS = (
				   "MUL",
				   "DIV",
				   "MOD",
				   "SEQ",
				   "SNE",
				   "MOV",
				   "ADD",
				   "SUB",
				   "JMP",
				   "JMZ",
				   "JMN",
				   "DJN",
				   "SPL",
				   "SLT",
				   "CMP",
				   "SEQ",
				   "DAT",
				   "SNE",
				   "SPL"
				   );

  $ins = $INSTRUCTIONS[int rand @INSTRUCTIONS];
  $mod = $MODIFIERS[int rand @MODIFIERS];

  $line = sprintf("%s%s %s %d, %s %d\n",$ins,$mod,$AMODES[int rand @AMODES],getint(),$AMODES[int rand @AMODES],getint());
  return $line;
}

sub getint{
  $s = rand 100;
  $ret = 0;
  if($s < 30){
    $ret = rand 5;
  }
  if($s >= 30 && $s < 40){
    $ret = rand 10;
  }
  if($s >= 40 && $s < 60){
    $ret = rand 100;
  }
  if($s >= 60 && $s < 70){
    $ret = rand ($CORESIZE / ((rand 20)+1));
  }
  if($s >= 70 && $s < 80){
    $ret = rand ($CORESIZE / ((rand 5)+1));
  }
  if($s >= 80 && $s < 100){
    $ret = $CORESIZE / ((rand 5) + 1);
  }

  #/* 20% chance itll be negative */
  $s = rand 100;
  if($s > 80){
    $ret *= -1;
  }
  return $ret;
}

sub mutate{
  if (int rand 1000 <= 10) {
    return genline();
  }
  return shift;
}

sub makepop{
  my $total = shift;
  print "Making warriors: \n";
  for (my $i = 0; @WARRIORS < $total ; $i++) {
    push(@WARRIORS,makenew());
  }
}

sub makenew{
  my $lines;
  my $C;

  #$lines = (int rand 100)+$minlen; #Shortest possible is $minlen
  $C = getwarriorname();
  #print "$C with $lines lines\n";
  open(MYA,">data/$C");  
  print MYA "$header;name $C-eve2\nORG 50\n";
  for (my $j = 0; $j < 200 ; $j++) {
    my $thisline = genline();
    print MYA "$thisline";
  }
  close(MYA);
  return $C;
}

sub check_valid{
  my $W = shift;
  $validwarrior = $BENCH[int rand @BENCH];
  open(PMARS,"pmars -r $validrounds -s $coresize -c $cycles -d $distance -p $processes -l $maxlen -b $W $validwarrior |");
  while (<PMARS>) {
    chomp;	
    if (/scores/) {
      my ($T1,$by,$who,$trash,$score) = split;
      close(PMARS);
      if (!($T1 eq $validwarrior) && ($score < $validscore)) {
	$cribdeath++;
	return 0;
      }
      return 1;
    }
  }
}

sub readwarrior{
  my $W = shift;
  my @RET;
  open(MYW,"< $data/$W");
  while (<MYW>) {
    $_ =~ s/START//g;
    if (/(;)|(ORG)/) {
      next;
    }
    push(@RET,$_);
  }
  close(MYW);
  return @RET;
}