view release on metacpan or  search on metacpan

scripts/rectangle-coverage.pl  view on Meta::CPAN

=back

This program also demonstrates the use of caches in the fitness
evaluation, so be careful if you use too many bits or too many
generations, check out memory usage.

Console output shows the number of generations, the winning chromosome, and
fitness. After finishing, it outputs time, cache ratio and some other
things. 

=cut

use Tk;
use strict;
use warnings;

use Algorithm::RectanglesContainingDot;

use lib qw(lib ../lib);
use Algorithm::Evolutionary qw( Individual::BitString Op::Easy 
				Op::Bitflip Op::Crossover );


my $width = 600;
my $height = 500;

# Create MainWindow and configure:
my $mw = MainWindow->new;
$mw->configure( -width=>$width, -height=>$width );
$mw->resizable( 0, 0 ); # not resizable in any direction

my $num_rects = shift || 300;
my $arena_side = shift || 10;

my $bits = shift || 32;
my $pop_size = shift || 64; #Population size
my $number_of_generations = shift || 200; #Max number of generations
my $selection_rate = shift || 0.2;
my $scale_x = $arena_side/$width;
my $scale_y = $arena_side/$height;

my $alg = Algorithm::RectanglesContainingDot->new;
my $fitness;
my $generation;
my @pop;
# Start Evolutionary Algorithm
my $contador=0;
my $dot_size = 6;
my $mini_dot_size = $dot_size/2;
my @dot_population;

# Create and configure the widgets
my $f = $mw->Frame(-relief => 'groove',
		   -bd => 2)->pack(-side => 'top',
				   -fill => 'x');

for my $v ( qw( num_rects arena_side bits pop_size number_of_generations selection_rate ) ){
  create_and_pack( $f, $v );
}

my $canvas = $mw->Canvas( -cursor=>"crosshair", -background=>"white",
              -width=>$width, -height=>$height )->pack;
$mw->Button( -text    => 'Start',
	     -command => \&start,
	   )->pack( -side => 'left',
		    -expand => 1);
$mw->Button( -text    => 'End',
	       -command => \&finished,
	     )->pack( -side => 'left',
		      -expand => 1 );
$mw->Button( -text    => 'Exit',
	     -command => sub { exit(0);},
	   )->pack( -side => 'left',
		    -expand => 1 );

$mw->eventAdd('<<Gen>>' => '<Control-Shift-G>'); # Improbable combination
$mw->eventAdd('<<Fin>>' => '<Control-C>');
$mw->bind('<<Gen>>' => \&generation);
$mw->bind('<<Fin>>' => \&finished );


sub create_and_pack {
  my $frame = shift;
  my $var = shift;
  my $f = $frame->Frame();
  my $label = $f->Label(-text => $var )->pack(-side => 'left');
  my $entry = $f->Entry( -textvariable => eval '\$'.$var )->pack(-side => 'right' );
  $f->pack();
}

sub start {
  #Generate random rectangles
  for my $i (0 .. $num_rects) {
    
    my $x_0 = rand( $arena_side );
    my $y_0 = rand( $arena_side);
    my $side_x = rand( $arena_side - $x_0 );
    my $side_y = rand($arena_side-$y_0);
    $alg->add_rectangle("rectangle_$i", $x_0, $y_0, 
			$x_0+$side_x, $x_0+$side_y );
    my $val = 255*$i/$num_rects;
    my $color = sprintf( "#%02x%02x%02x", $val, $val, $val );
    $canvas->createRectangle( $x_0/$scale_x, $y_0/$scale_y, 
			      $side_x/$scale_x, $side_y/$scale_y, 
			    -outline =>$color );
  }

  #Declare fitness function
  $fitness = sub {
    my $individual = shift;
    my ( $dot_x, $dot_y ) = $individual->decode($bits/2,0, $arena_side);
    my @contained_in = $alg->rectangles_containing_dot($dot_x, $dot_y);
    return scalar @contained_in;
  };



  #----------------------------------------------------------#
  #Initial population
  #Creamos $pop_size individuos
  for ( 0..$pop_size ) {