#!perl -w
# !"k$mwd(),eea/wh |4bc789w;y=xpnAgCDEF|tIsKmMNOPlRSTUgwro[u]^_i
BEGIN
{
    srand ($$ ^ time);
    push @INC, '.';
}

$boom = 0;
$SIG{USR1} = sub {
    $boom = 1;
};

# sub { open(DEATH,">>$$") and print DEATH "Dying from:\n",@_ };
# $SIG{__WARN__} = sub { open(WARN,">>$$") and print WARN "Warning about:\n",@_ };

use Victim qw( &individual &fitness $alphabet $target &intersection &other &alphabet &indexes &duplicates );

$pop_size = 1600;
@best_fitness = undef;
@best_individual = undef;

$mutate_prob = 0.001;
$invert_prob = 0.003;
$cheat_prob  = 0.006;

sub pront
{
    foreach (@_)
    {
        y/\r//;
        print;
    }
}

sub generate_population ($)
{
    my $i = shift;

    my (@pop, @inv);

    while( $i-- )
    {
	push @pop, [&individual];
    }

    @pop;
}

sub select_individual ($@)
{
    my $sum = shift;

    my( $rand, $partial_sum, $i ) = ( rand $sum, 0, scalar @_ );

    die $i unless $i > 0;
    while( $i-- && $partial_sum <= $rand )
    {
	$partial_sum += $_[$i];
    }

    --$i;
}

sub old_permute_crossover ($$)
{
    # OK, so they are hermaphrodites

    my( $mum, $dad ) = @_;

    my( $mum_l, $dad_l ) = (length $mum, length $dad);

    die "'$mum'\n'$dad'\nOops. $mum_l != $dad_l" unless $mum_l == $dad_l;

    my( $where, $length, $chop );

    # Note that this can crossover after the last character!

    $where = rand $mum_l;
    
    $chop = substr $mum, $where, 1;
    
    if( -1 != ($length = index ($dad, $chop, $where + 1)))
    {
#        die "'$chop' '" . substr ($dad, $length, 1) ."'\n";
	$length = $length - $where + 1;
    }
    else
    {
	$length = $mum_l - $where;
    }

    $chop = substr $mum, $where, $length;
    (substr $mum, $where, $length) = substr $dad, $where, $length;
    (substr $dad, $where, $length) = $chop;

    ($mum, $dad);
}

sub crossover ($$)
{
    # OK, so they are hermaphrodites

    my( $mum, $dad ) = @_;

    my( $mum_l, $dad_l ) = (length $$mum[0], length $$dad[0]);

    my( $sprog1, $sprog2 );
    die "'$mum'\n'$dad'\nOops. $mum_l != $dad_l" unless $mum_l == $dad_l;

    my( $where, $length, $chop );

    # Note that this can crossover after the last character!

    $where = rand $mum_l;
    $length = $mum_l - $where;

    $sprog1 = [@$mum];
    $sprog2 = [@$dad];

    (substr $$sprog1[0], $where, $length) = substr $$dad[0], $where, $length;
    (substr $$sprog2[0], $where, $length) = substr $$mum[0], $where, $length;

    # Unset cached fitness unless identical
    @$sprog1 = ($$sprog1[0]) unless $$sprog1[0] eq $$mum[0];
    @$sprog2 = ($$sprog2[0]) unless $$sprog2[0] eq $$dad[0];

#    print "Cache win\n" if defined $$sprog2[1];
    ($sprog1, $sprog2);
}

sub mutate ($)
{
    (substr $_[0], rand( length $_[0] ), 1)
	= substr $alphabet, rand (length $alphabet), 1;

    $_[0];
}

sub old_cheat ($)
{
    my ($where) = rand( length $_[0] );
    
    (substr $_[0], $where, 1)
	= substr $Victim::uuchars, $where, 1;

    $_[0];
}

sub cheat ($)
{
    my ($g) = shift;
    my ($duplicates) = &duplicates ($g);
    

    if( defined $duplicates )
    {
	my $char = substr $duplicates, rand (length $duplicates), 1;

	my (@where) = indexes( $g, $char );

	my $where = $where[rand $#where];

	die "$where in '$g' isn't $char" . join( ',', @where )
	    unless $char eq substr $g, $where, 1;

	my $replacements = &other( $Victim::chars, $g );

	$replacements = $alphabet if( $replacements eq '' );
	
#	print STDERR"'$g' '$replacements'\n'$char' -> '";
	
	(substr $g, $where, 1)
	    = substr $replacements, rand (length $replacements), 1;

#	die ((substr $g, $where, 1) . "'\n'$g'" )
    }
    else
    {
	(substr $g, $where, 1)
	    = substr $Victim::uuchars, $where, 1;
    }

    $g;
}

sub invert ($)
{
    my ($in, $out) = (shift);
    
    my ($in_l, $i) = length $in;
    
    my ($where, $length);

    $where = int rand $in_l;
    $length = int rand ($in_l - $where);
    
#    print "$in_l $where $length\n";
#    print "$in\n";
    $out = substr $in, 0, $where;
    
    $i = $length;
    while( $i-- )
    {
        $out .= substr $in, $where + $i, 1;
    }
    
    $out .= substr $in, $where + $length;
#    print "$out\n";
    $out;
}


@population = generate_population( $pop_size );
$generation = 0;

print "Here we go\n";
$^W = 0; # Turn off warnings in the evals
do
{

    $sum_fitness = 0;
    @best_fitness = undef;
    @worst_fitness = undef;

    $i = $pop_size;
    while( $i-- )
    {
	$this = $population[$i];
	
	unless( defined $$this[1] )
	{
	    $genes = $$this[0];
	    $population[$i] = $this = [$genes, &fitness( $genes )];
	}

	$sum_fitness += $fitness[$i] = $$this[1];
     
	@best_fitness = @$this
	    unless( defined $best_fitness[1] and $$this[1] < $best_fitness[1] );
	@worst_fitness = @$this
	    unless( defined $worst_fitness[1] and $$this[1] > $worst_fitness[1] );
    }

    $mean_fitness = $sum_fitness / $pop_size;
    $best = $best_fitness[1];
    $worst = $worst_fitness[1];

    $shift = ($best - $worst) * +0 - $worst;

    pront "Generation $generation\tBest = $best"
	."\tMean = $mean_fitness\tWorst = $worst"
	    ."\n$Victim::uuchars"
	    ."\n$best_fitness[0]\n$best_fitness[2]\n$best_fitness[3]"
		." \t\t$best_fitness[4]\n";

    # print ($population[0] . "\n");

    $sec = 0;
    foreach( (@fitness) )
    {
        $_ += $shift;
	

	$_ = 0 unless $_ > 0;	# $_ *= $_;
        $sec += $_;
    }

#    $sum_fitness += $shift * $pop_size;
    
#    print "$sum_fitness $sec\n";
    @intermediate = ();
    $i = $pop_size;

#    printf "%s\n%s\n", ${$population[0]}[0], ${$population[1]}[0];

    while( $i-- )
    {
	push @intermediate,
	$population[select_individual($sec,@fitness)];
    }

#    printf "%s\n%s\n", ${$intermediate[0]}[0], ${$intermediate[1]}[0];

    @population = ();

    while( scalar @intermediate )
    {
	push @population, crossover( shift @intermediate, shift @intermediate );
    }

    $this_mutate = $mutate_prob * $pop_size;

    while( $this_mutate-- > 1 || (rand( 1 ) -1) < $this_mutate )
    {
	$victim = rand $pop_size;
	$genes = mutate( ${$population[$victim]}[0] );
	$population[$victim] = [$genes];
    }

    $this_cheat = $cheat_prob * $pop_size;

    while( $this_cheat-- > 1 || (rand( 1 ) -1) < $this_cheat )
    {
	$victim = rand $pop_size;
	$genes = cheat( ${$population[$victim]}[0] );
	$population[$victim] = [$genes];
    }
    
    $this_invert = $invert_prob * $pop_size;

    while( $this_invert-- > 1 || (rand( 1 ) -1) < $this_invert )
    {
	$victim = rand $pop_size;
	$genes = invert( ${$population[$victim]}[0] );
	$population[$victim] = [$genes];
    }
    
    $generation++;

    if( $boom )
    {
	$boom = 0;
	print "pop_size  = $pop_size\tmutate_prob = $mutate_prob\n";
	print "pop_size  = $pop_size\tcheat_prob = $cheat_prob\n";
	print "pop_size  = $pop_size\tinvert_prob = $invert_prob\n";
    }
}
while( 1 );




