#!/usr/bin/perl

use strict;
use warnings;
no warnings "uninitialized";
use Getopt::Long;
use Pod::Usage;

use constant CHANCE_CROSSBREED_WINNER	=> 30;

use constant DEFAULT_OUTPUT 			=> 'mutated.def';
use constant DEFAULT_PRIMITIVES_DIR 	=> 'primitives';
use constant DEFAULT_WINNERS_DIR		=> 'winners';
use constant DEFAULT_REMUTATE_EVERY		=> 100;
use constant DEFAULT_SHOW_MUTATIONS		=> 0;
use constant DEFAULT_POPULATION_SIZE	=> 100;

use constant EXEC_MUTATE				=> './mutate';
use constant EXEC_COBOSODA				=> './cobosoda';
use constant EXEC_COBOSODA_SPEED		=> 1001;
use constant EXEC_COBOSODA_DURATION		=> 100;

use constant FILENAME_BASE				=> 'wnr_';
use constant FINAL_BASE					=> 'final_';

use vars qw(@PRIMITIVES @WINNERS @HISTORY);

sub parse_command_line() {
	my %h;
	
	$h{'population'} = DEFAULT_POPULATION_SIZE;
	$h{'primitives'} = DEFAULT_PRIMITIVES_DIR;
	$h{'remutate'}   = DEFAULT_REMUTATE_EVERY;
	$h{'show'}		 = DEFAULT_SHOW_MUTATIONS;
	$h{'winners'}	 = DEFAULT_WINNERS_DIR;
	GetOptions(\%h,
		'help|h',
		'verbose|v+',
		'population|p=i',
		'primitives|P=s',
		'remutate|R=i',
		'show|S',
		'winners|W=s',
		'jump|J',
		'restart=i'
	);

	if ($h{'help'}) {
		pod2usage(-verbose=>1);
	}
	unless (@ARGV) {
		pod2usage(-verbose=>0, -message=> "No original given to mutate.\n");
	}

	$h{'input'}		 = shift(@ARGV);
	$h{'original_input'} = $h{'input'};

	unless (-e $h{'input'}) {
		pod2usage(-verbose=>0, -message=> "$h{'input'}: File not found.\n");
	}

	$h{'output'}	 = shift(@ARGV) || DEFAULT_OUTPUT;

	return \%h;
}

sub cpconcat {
	my $src = shift;
	my $dest = shift;
	local(*SRC,*DEST);

	open(SRC,$src);
	open(DEST,'>'.$dest);
	print DEST @_;
	while(<SRC>) { print DEST }
	close(SRC);
	close(DEST);
}

sub init_primitives($) {
	my $primitives_dir = shift;
	local(*DIR);
	
	@PRIMITIVES = ();
	opendir(DIR,$primitives_dir) || do {
		die "Couldn't read primitives from '$primitives_dir'.\n";
	};
	
	foreach(readdir(DIR)) {
		push(@PRIMITIVES,$_) unless /^\./ and not /\.def$/;
	}	
}

sub random_winner() {
	return $WINNERS[int(rand($#WINNERS+1))];
}

sub random_winner_topten() {
	my $topten = ($#WINNERS+1) / 10;

	return $WINNERS[int(rand($topten))];
}

sub random_primitive() {
	return $PRIMITIVES[int(rand($#PRIMITIVES+1))];
}

sub mutate($$) {
	my($source,$dest) = @_;

	my $mate;
	do {
	 	$mate = ($#WINNERS>10 && int(rand(100))<CHANCE_CROSSBREED_WINNER) ?
			random_winner()->{filename} :
			random_primitive();
	} while(!$mate);
	
	my $seed = int(rand(32767*32767)) % 90000000 + 10000000;

	_mutate($source,$mate,$dest,$seed);

	return {
		before => $source,
		after => $dest,
		seed => $seed,
		mate => $mate
	};
}

sub _mutate($$$$) {
	my($source,$mate,$dest,$seed) = @_;

	my $cmd = join(' ',EXEC_MUTATE,$source,$mate,$dest,$seed);
	`$cmd`;
}

sub test($$) {
	my($filename,$jump) = @_;

	my $cmd = join(' ',
		EXEC_COBOSODA,
		$filename,
		EXEC_COBOSODA_SPEED,
		EXEC_COBOSODA_DURATION
	);
	my $result = `$cmd`;
	
	my $score;
	if ($jump) {
		($score) = $result =~ /Highest Jump = ([\-\.\d]+)/;
	}
	else {
		($score) = $result =~ /Final Velocity = ([\-\.\d]+)/
	}
		
	if ($score) {
		return $score;
	}
	else {
		warn "$filename: Cobosoda failed to execute.  Model is a reject.\n";
		cpconcat($filename,'reject.def',"# Reject\n");
		return 0;
	}		
}

sub insert_into_population($$$) {
	my($model,$dir,$size) = @_;

	unless ($#WINNERS+1<$size) {
		my $deadfn = $WINNERS[$#WINNERS]->{filename};
		if ($deadfn) {
			unlink $deadfn ||
				warn "$deadfn: Couldn't unlink\n";
		}
	}
	
	my $newfn = $dir . '/' . FILENAME_BASE . sprintf("%08d",$model->{run}) . '.def';
	$model->{filename} = $newfn;
	
	cpconcat(
		$model->{after},
		$newfn,
		@HISTORY,
		"# Run $model->{run} Seed $model->{seed} Mate $model->{mate}\n"
	);
	
	pop(@WINNERS) unless ($#WINNERS+1<$size);
	push(@WINNERS,$model);
	@WINNERS = sort {
		$$b{'score'} <=> $$a{'score'}
	} @WINNERS;
}

sub save_final($$) {
	my($model,$dir) = @_;

	my $newfn = $dir .'/'.FINAL_BASE.sprintf("%08d",$model->{run}).'.def';
	cpconcat($model->{filename},$newfn);
}

sub remutate() {
	my $model = random_winner_topten();

	push(@HISTORY,
		"# Run $model->{run} Seed $model->{seed} Mate $model->{mate}\n");
	
	return $model->{filename};
}

sub main() {
	my $cmdline = parse_command_line();
	my $run = 0;

	init_primitives($cmdline->{primitives});
	while(1) {
		$run++;

		iteration($run,$cmdline);
		unless ($run % $cmdline->{remutate}) {
			$cmdline->{input} = remutate();
			print "Remutating with $cmdline->{input}\n" if
				$cmdline->{verbose};	

			if($cmdline->{verbose}) {
				print "\n----------------------------------------\n";
				print "Run #$run\n";
				print "Mutatating $cmdline->{input}\n";
				print "Population ",$#WINNERS+1," critters\n";
				for(my $x=0;$x<10;$x++) {
					printf("%02d:\t%20s\t%0.8f\n",
						$x,
						$WINNERS[$x]->{filename},
						$WINNERS[$x]->{score}
					);
				}
			}

			if ($cmdline->{show}) {
				print "Displaying $WINNERS[0]->{filename}\n";
				display($WINNERS[0]->{filename},$cmdline->{remutate});
			}
		}


		if ($cmdline->{restart} && $run % $cmdline->{restart}==0) {
			if($cmdline->{verbose}) {
				print "\n\n*** RESTARTING MUTATION TREE ***\n\n";
				save_final($WINNERS[0],$cmdline->{winners});

				sleep 1; ## So restarts don't cause empty displays.
				foreach(@WINNERS) {
					unlink $_->{filename};
				}
				
				@WINNERS = ();
				@HISTORY = ();
				$cmdline->{input} = $cmdline->{original_input};		
			}
		}
	}
}

sub iteration($$) {
	my($run,$cmdline) = @_;
	
	## Make a new mutation.
	if ($cmdline->{verbose}>3) {
		print "Mutating $cmdline->{input} => $cmdline->{output}\n";
	}
	my $model = mutate($cmdline->{input},$cmdline->{output});

	## Label the model with its run number.
	$model->{run} = $run;
	
	## Test the mutation.
	if ($cmdline->{verbose}>3) {
		print "Testing $model->{after}\n";
	}
	$model->{score} = test($model->{after},$cmdline->{jump});
	if ($cmdline->{verbose}>2) {
		print "Run #$run scored $model->{score}\n";
	}

	## If it is better than the worst score, include it in the population.
	if ($model->{score} >= 0 && 
		($#WINNERS+1 < $cmdline->{population} || $model->{score} > $WINNERS[$#WINNERS]->{score})) {
		if ($cmdline->{verbose}>2) {
			print "Inserting $model->{after} into population\n";
		}
		insert_into_population($model,$cmdline->{winners},$cmdline->{population});
	}
}

sub display {
	my($filename,$time) = @_;

	my $cmd = join(' ',EXEC_COBOSODA,$filename,int(EXEC_COBOSODA_SPEED/$time),EXEC_COBOSODA_DURATION);
	system "$cmd > /dev/null &";
}

main();
__END__

=head1 NAME

runmutations - Run a series of mutations on a cobosoda definition

=head1 SYNOPSIS

runmutations [options] original.def [mutated.def]

 Options:
   -h                        See full documentation
   -v                        Vebose mode (recommended)
   -J,--jump                 Test for jumping instead of velocity
   -p,--population=NUM       Set the population size
   -P,--primitives=DIR       Directory of primitives for cross-breeding
   -R,--remutate=NUM         Re-mutate every NUM interations
   -S,--show                 Fork off a display of each new mutation
   -W,--winners=DIR          Directory to save winners in
   --restart=NUM             Save and Restart every NUM iterations

=head1 OPTIONS

=over 8

=item B<-h>

Show the documentation.  You're looking at it.

=item B<-v>

Verbose mode.  It's use is recommended.  Repeat for greater verbosity.

=item B<--jump>

Select for jumping height rather than velocity.

=item B<--population=NUM>

Sets the size of the population to NUM.  As mutatations are made and tested
the top NUM definitions will be saved in the winners directory (see
--winners).  Cross-breeding is selected at random from this population.  In
addition, a random defintion from the top 10% of the population will be used
for re-mutation (see --remutate-every).

=item B<--primitives=DIR>

Sets the directory for primitives to be used for cross-breeding.  Primitives
are a set of simple definitions to be used as building blocks for mutations.
Cross-breeding is 60% from primitives and 30% from winners.

=item B<--remutate=NUM>

Every NUM iterations, select a random definition from the top 10% of the 
population for remutation.  This definition is now used as the basis for
mutation, effectively making any changes it had previously aquired 
permenant.

=item B<--show>

When remutatation takes place, fork off a copy of cobosoda to display to
the screen.  This is a good way to keep up with the mutations as they
are occuring.

=item B<--winners=DIR>

Store the current population in DIR.  The number of definitions inside
this directory should be less than or equal to the population-size.

=item B<--restart=NUM>

Save the best mutation as a final mutatation (winners/final_*.def) and
restart mutating from the original.  This allows you to generate distinct
mutation trees every NUM iterations.

=head1 SEE ALSO

=item cobosoda(1), mutate(1)

=head1 BUGS

Occasionally runmutaitons will mis-call mutate on remutaiton if the
population isn't large enough.  Broken definitions will appear as
numbered filenames (the seed number to be exact).

=head1 LICENSE

This sofware is (C)2002 Justin Day and is available for use under
the GNU Public License.  See the packaged document LICENSE for
details.