package AI::NaturalSelection;

sub new {
  my ($proto, $data)	= @_;
  my $class		= ref($proto) || $proto;
  my $self		= {};
  if (ref($data)) {
    $self = $data;
  }
  else {
    $self->{CHROMOSOMES} = $data;
  }

  $self->{FITGREAT}	= 1 unless defined($self->{FITGREAT});	# the greater the fitness value, the fitter
  $self->{FITNESS}	||= \&fitness;			# the function that returns fitness of dna
  $self->{SURVIVAL}	||= 2;				# the number of surviving chromosomes after
							# a generation OR a function that returns
							# the surviving chromosomes

  $self->{CHROMOSOMES}	||= 10;				# the number of chromosomes to live
  $self->{POPULATION}	= [() x $self->{CHROMOSOMES}];	# the actual, living chromosomes
  $self->{DNA}		= [() x $self->{CHROMOSOMES}];	# the data of each chromosome

  $self->{ENVIRONMENT}	||= \&generation;		# the function which gets exec'd
							# per chromosome per gen

  $self->{EVALUATE}	||= \&evaluate;			# the function that returns true when
							# we should stop the tournament

  $self->{GENERATION}	= 0;				# Current generation

  $self->{CROSSOVER}	||= \&crossover;		# crossover function
  $self->{MUTATE}	||= \&mutate;			# mutate function
  $self->{MUTATERATE}	||= 0.00;			# chance of mutation (max = 1.00)

  bless($self, $class);
  return $self;
}


sub spawn {
  my ($self)	= @_;

  # do we end the tournament just yet?
  while (!&{$self->{EVALUATE}}(++$self->{GENERATION}, \@{$self->{DNA}})) {

    foreach my $chromosome (0 .. $self->{CHROMOSOMES} - 1) {
      ($self->{DNA}[$chromosome]) = &{$self->{ENVIRONMENT}}($self, $self->{DNA}[$chromosome], $chromosome);
    }

    my @surviving;
    if (ref($self->{SURVIVAL})) {
      @surviving = &{$self->{SURVIVAL}}(@$self->{DNA}[$_]);
    }
    else {
      my @fitnesses = map { &{$self->{FITNESS}}($self->{DNA}[$_], $_) } 0 .. $self->{CHROMOSOMES} - 1;
      @surviving = (
	sort {
		$self->{FITGREAT} ?
		$fitnesses[$b] <=> $fitnesses[$a] :
		$fitnesses[$a] <=> $fitnesses[$b]
	} 0 .. $self->{CHROMOSOMES} - 1
      )[0 .. $self->{SURVIVAL} - 1];
    }

    foreach my $chromosome (0 .. $self->{CHROMOSOMES} - 1) {
      next if grep { $_ == $chromosome } @surviving;

      if (@surviving == 1) {
        $self->{DNA}[$chromosome] = &{$self->{CROSSOVER}}(
          (map { $self->{DNA}[$surviving[0]] } 1, 2), 0, 0,
        );
      }
      else {
        my ($mother, $father);
        do {
          $mother = int(rand(@surviving));
          $father = int(rand(@surviving));
        } while ($mother != $father);

        $self->{DNA}[$chromosome] =
          &{$self->{CROSSOVER}}($self->{DNA}[$surviving[$mother]], $self->{DNA}[$surviving[$father]], $mother, $father);
      }
      $self->{DNA}[$chromosome] = &{$self->{MUTATE}}($self, $self->{DNA}[$chromosome], $chromosome)
        if (rand(1) < $self->{MUTATERATE});
    }
  }
}


sub setDNA {
  my ($self, $dna, @select)	= @_;
  @select			= 0 .. $self->{CHROMOSOMES} - 1 unless @select;
  $self->{DNA}[$_]		= $dna foreach @select;
  return 1;
}
sub getDNA {
  my ($self, $select) = @_;
  return $self->{DNA}[$select];
}


sub setMutateRate {
  my ($self, $rate)	= @_;
  $self->{MUTATERATE}	= $rate;
  return 1;
}
sub getMutateRate {
  my ($self)	= @_;
  return $self->{MUTATERATE};
}


sub setMutationFunc {
  my ($self, $mutate)	= @_;
  $self->{MUTATE}	= $mutate;
  return 1;
}
sub getMutationFunc {
  my ($self)	= @_;
  return $self->{MUTATE};
}


sub setCrossoverFunc {
  my ($self, $crossover)	= @_;
  $self->{CROSSOVER}		= $crossover;
  return 1;
}
sub getCrossoverFunc {
  my ($self)	= @_;
  return $self->{CROSSOVER};
}


sub setPopulationSize {
  my ($self, $chromosomes)	= @_;
  return $self->{CHROMOSOMES}	= $chromosomes;
}
sub getPopulationSize {
  my ($self)	= @_;
  return $self->{CHROMOSOMES};
}


sub setSurvival {
  my ($self, $survive)	= @_;
  $self->{SURVIVAL}	= $survive;
  return 1;
}
sub getSurvival {
  my ($self)	= @_;
  return $self->{SURVIVAL};
}


sub setEnvironmentFunc {
  my ($self, $env)	= @_;
  $self->{ENVIRONMENT}	= $env;
  return 1;
}
sub getEnvironmentFunc {
  my ($self)	= @_;
  return $self->{ENVIRONMENT};
}


sub setFitnessFunc {
  my ($self, $fitness)	= @_;
  $self->{FITNESS}	= $fitness;
  return 1;
}
sub getFitnessFunc {
  my ($self)	= @_;
  return $self->{FITNESS};
}


sub setFitWhenGreater {
  my ($self, $great)	= @_;
  $self->{FITGREAT}	= $great;
  return 1;
}
sub getFitWhenGreater {
  my ($self)	= @_;
  return $self->{FITGREAT};
}


sub setEvaluateFunc {
  my ($self, $evaluate)	= @_;
  $self->{EVALUATE}	= $evaluate;
  return 1;
}
sub getEvaluateFunc {
  my ($self)	= @_;
  return $self->{EVALUATE};
}


sub getGeneration {
  my ($self)	= @_;
  return $self->{GENERATION};
}

1;