hibbified-249.p6

#!/usr/bin/env perl6
use v6;

# Return a string of $length bytes where each bit is 1 50% of the time
multi sub random-bytes(Int $length) returns array[uint8] {
  array[uint8].new((0x00..0xff).roll($length))
  # same thing and way faster
}

# Return a string of $length bytes where each bit is 1 with probability $prob
multi sub random-bytes(Int $length, Num() $prob --> array[uint8]) {
  sub random-byte() {
  	my uint8 $byte;
	$byte = $byte +^ 1 if rand < $prob;
    $byte = $byte +^ 2**1 if rand < $prob;
    $byte = $byte +^ 2**2 if rand < $prob;
    $byte = $byte +^ 2**3 if rand < $prob;
    $byte = $byte +^ 2**4 if rand < $prob;
    $byte = $byte +^ 2**5 if rand < $prob;
    $byte = $byte +^ 2**6 if rand < $prob;
    $byte = $byte +^ 2**7 if rand < $prob;
	$byte
  }

  array[uint8].new(random-byte() xx $length);
}

# Compute the number of bits that differ between $a and $b
sub hamming-distance(uint8 @a, uint8 @b) returns Int {
  my int $h = 0;
  for (@a »+^« @b) -> int $val is copy {
  	while $val != 0 {
		$h++;
		$val = $val +& ($val - 1);
	}
  }
  $h
}

# Return a string that randomly takes half of its bits from $a and half from $b
sub crossover(uint8 @a, uint8 @b --> array[uint8]) {
  array[uint8].new(@a »+^« ((@a »+^« @b) »+&« random-bytes(@a.elems)))
  # +++ .chars is the number of graphemes
}

# Return $a with each of its bits toggled with probability $prob
sub mutate(uint8 @a, Num() $prob --> array[uint8]) {
  array[uint8].new(@a »+^« random-bytes(@a.elems, $prob));
}

# Return up to the first $how-many of @candidates, sorted by $fitness
sub survival(@candidates, &fitness, :$how-many = 10) {
  @candidates.sort(&fitness).squish.head($how-many);
  # +++ @candidates.elems and @candidates.unique.elems are nearly all the time the same
  # .squish is a wee bit faster then .uniq
}

# Compute the next generation of @candidates. The top $elites automatically pass on
# to the next generation; the remainder is made up of $num-offspring offspring of
# random pairs of candidates, mutated at a rate of $mutation-rate
sub next-generation(@candidates, :$num-offspring is copy = 20, :$mutation-rate = 0.1, :$elites = 5) {
  my @offspring = do for @candidates X @candidates -> [$a, $b] {
	# +++ we may aswell do the X operator inline
    last unless $num-offspring--;
	# +++ there is no need to call .head if we do the counting ourselves
    mutate(crossover($a, $b), $mutation-rate) 
  }
  |@candidates.head($elites), |@offspring;
  # +++ don't flat, depending on $num-offspring, this list might get long
}

sub MAIN(Str $input-s = '1234567890abc') { 
  # Generate an initial random field
  state $avg;
  for ^10 {
  my uint8 @input.=new($input-s.ords);
  
  my @candidates = random-bytes(@input.elems) xx 10;

  my $gen = 1;
  my $rate = 0.03;

  while True {
    # Sort and see who lives
    @candidates = survival(@candidates, { hamming-distance(@input, $_) });

    # Print the status
    my $score = hamming-distance(@input, @candidates[0]);
	say "Gen: { $gen++ } | Distance: $score | { @candidates[0]».chr.join.perl }";

    # Quit if we have a winner
    last if $score == 0;

    # Create the next generation
    @candidates = next-generation(@candidates, mutation-rate => $rate);
    $rate *= 0.99;
  }
  put now - ENTER { now }, 's ', (now - ENTER { now }) / $gen, 's/generation' ; 
  $avg += (now - ENTER { now }) / $gen;
  # 0.220037430956862s/generation
  }
  dd $avg/11;
}

original: 0.334402338735231s/generation
final: 0.220037430956862s/generation