view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Run.pm  view on Meta::CPAN

=cut

sub new {
  my $class = shift;

  my $param = shift;
  my $fitness_object = shift; # Can be undef
  my $self;
  if ( ! ref $param ) { #scalar => read yaml file
      $self = LoadFile( $param ) || carp "Can't load $param: is it a file?\n";
  } else { #It's a hashref
      $self = $param;
  }
  
#----------------------------------------------------------#
# Variation operators
  my $m = new Algorithm::Evolutionary::Op::Bitflip( 1, $self->{'mutation'}->{'priority'}  );
  my $c;
  #Big hack here
  if ( $self->{'crossover'} ) {
    $c = new Algorithm::Evolutionary::Op::Crossover($self->{'crossover'}->{'points'}, $self->{'crossover'}->{'priority'} );
  } elsif ($self->{'gene_boundary_crossover'}) {
    $c = new Algorithm::Evolutionary::Op::Gene_Boundary_Crossover($self->{'gene_boundary_crossover'}->{'points'}, 
								  $self->{'gene_boundary_crossover'}->{'gene_size'} , 
								  $self->{'gene_boundary_crossover'}->{'priority'} );
  } elsif ($self->{'quad_xover'} ) {
    $c = new Algorithm::Evolutionary::Op::QuadXOver($self->{'crossover'}->{'points'}, $self->{'crossover'}->{'priority'} );
  }
  
# Fitness function
  if ( !$fitness_object ) {
    my $fitness_class = "Algorithm::Evolutionary::Fitness::".$self->{'fitness'}->{'class'};
    eval  "require $fitness_class" || die "Can't load $fitness_class: $@\n";
    my @params = $self->{'fitness'}->{'params'}? @{$self->{'fitness'}->{'params'}} : ();
    $fitness_object = eval $fitness_class."->new( \@params )" || die "Can't instantiate $fitness_class: $@\n";
  }
  $self->{'_fitness'} = $fitness_object;
  
#----------------------------------------------------------#
#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.
  my $algorithm_class = "Algorithm::Evolutionary::Op::".($self->{'algorithm'}?$self->{'algorithm'}:'Easy');
  my $generation = eval $algorithm_class."->new( \$fitness_object , \$self->{'selection_rate'} , [\$m, \$c] )" 
    || die "Can't instantiate $algorithm_class: $@\n";;
  
#Time
  my $inicioTiempo = [gettimeofday()];
  
#----------------------------------------------------------#
  bless $self, $class;
  $self->reset_population;
  for ( @{$self->{'_population'}} ) {
    if ( !defined $_->Fitness() ) {
      $_->evaluate( $fitness_object );
    }
  }

  $self->{'_generation'} = $generation;
  $self->{'_start_time'} = $inicioTiempo;
  return $self;
}

=head2 population_size( $new_size )

Resets the population size to the C<$new_size>. It does not do
anything to the actual population, just resests the number. You should
do a C<reset_population> afterwards.

=cut

sub population_size {
  my $self = shift;
  my $new_size = shift || croak "Too small!";
  $self->{'pop_size'} = $new_size;
}


=head2 reset_population()

Resets population, creating a new one; resets fitness counter to 0

=cut 

sub reset_population {
  my $self = shift;
  #Initial population
  my @pop;

  #Creamos $popSize individuos
  my $bits = $self->{'length'}; 
  for ( 1..$self->{'pop_size'} ) {
      my $indi = Algorithm::Evolutionary::Individual::BitString->new( $bits );
      $indi->evaluate( $self->{'_fitness'} );
      push( @pop, $indi );
  }
  $self->{'_population'} = \@pop;
  $self->{'_fitness'}->reset_evaluations;
}

=head2 step()

Runs a single step of the algorithm, that is, a single generation 

=cut

sub step {
    my $self = shift;
    $self->{'_generation'}->apply( $self->{'_population'} );
    $self->{'_counter'}++;
}

=head2 run()

Applies the different operators in the order that they appear; returns the population
as a ref-to-array.

=cut

sub run {
  my $self = shift;
  $self->{'_counter'} = 0;
  do {
      $self->step();
      
  } while( ($self->{'_counter'} < $self->{'max_generations'}) 
	 && ($self->{'_population'}->[0]->Fitness() < $self->{'max_fitness'}));

}

=head2 random_member()

Returns a random guy from the population

=cut

sub random_member {
    my $self = shift;
    return $self->{'_population'}->[rand( @{$self->{'_population'}} )];
}

=head2 results()
 
Returns results in a hash that contains the best, total time so far
 and the number of evaluations. 

=cut

sub results {
  my $self = shift;
  my $population_size = scalar @{$self->{'_population'}};
  my $last_good_pos = $population_size*(1-$self->{'selection_rate'});
  my $results = { best => $self->{'_population'}->[0],
		  median => $self->{'_population'}->[ $population_size / 2],
		  last_good => $self->{'_population'}->[ $last_good_pos ],
		  time =>  tv_interval( $self->{'_start_time'} ),
		  evaluations => $self->{'_fitness'}->evaluations() };
  return $results;

}

=head2 evaluated_population()

Returns the portion of population that has been evaluated (all but the new ones)

=cut 

sub evaluated_population {
  my $self = shift;
  my $population_size = scalar @{$self->{'_population'}};
  my $last_good_pos = $population_size*(1-$self->{'selection_rate'}) - 1;
  return @{$self->{'_population'}}[0..$last_good_pos];
}


=head2 compute_average_distance( $individual )

Computes the average hamming distance to the population 

=cut

sub compute_average_distance {
  my $self = shift;
  my $other = shift || croak "No other\n";
  my $distance;
  for my $p ( @{$self->{'_population'}} ) {
    $distance += hamming( $p->{'_str'}, $other->{'_str'} );
  }
  $distance /= @{$self->{'_population'}};
}

=head2 compute_min_distance( $individual )

Computes the average hamming distance to the population 

=cut

sub compute_min_distance {
  my $self = shift;
  my $other = shift || croak "No other\n";
  my $min_distance = length( $self->{'_population'}->[0]->{'_str'} );
  for my $p ( @{$self->{'_population'}} ) {
    my $this_distance = hamming( $p->{'_str'}, $other->{'_str'} );
    $min_distance = ( $this_distance < $min_distance )?$this_distance:$min_distance;
  }
  return $min_distance;

}

=head1 Copyright
  
  This file is released under the GPL. See the LICENSE file included in this distribution,
  or go to http://www.fsf.org/licenses/gpl.txt

=cut