view release on metacpan or  search on metacpan

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

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 ) {
    my $indi = Algorithm::Evolutionary::Individual::BitString->new( $bits );
    push( @pop, $indi );
  }

#----------------------------------------------------------#
  # Variation operators
  my $m = Algorithm::Evolutionary::Op::Bitflip->new; # Rate = 1
  my $c = Algorithm::Evolutionary::Op::Crossover->new(2, 9 ); # Rate = 9
  
  #----------------------------------------------------------#
  #Usamos estos operadores para definir una generación del algoritmo. Lo cual
  # no es realmente necesario ya que este algoritmo define ambos operadores por
  # defecto. Los parámetros son la función de fitness, la tasa de selección y los
  # operadores de variación.
  $generation = Algorithm::Evolutionary::Op::Easy->new( $fitness , $selection_rate , [$m, $c] ) ;


#----------------------------------------------------------#
  for ( @pop ) {
    if ( !defined $_->Fitness() ) {
      my $this_fitness = $fitness->($_);
      $_->Fitness( $this_fitness );
    }
  }