view release on metacpan or  search on metacpan

lib/AI/ANN/Evolver.pm  view on Meta::CPAN

			for (my $j = 0; $j < $inputcount; $j++) {
				$networkdata3->[$i]->{'inputs'}->[$j] = 
					(rand() > 0.5) ?
					$networkdata1->[$i]->{'inputs'}->[$j] :
					$networkdata2->[$i]->{'inputs'}->[$j];
				# Note to self: Don't get any silly ideas about dclone()ing 
				# these, that's a good way to waste half an hour debugging.
			}
			for (my $j = 0; $j <= $neuroncount; $j++) {
				$networkdata3->[$i]->{'neurons'}->[$j] =
					(rand() > 0.5) ?
					$networkdata1->[$i]->{'neurons'}->[$j] :
					$networkdata2->[$i]->{'neurons'}->[$j];
			}
		} else {
			$networkdata3->[$i] = dclone(
				(rand() > 0.5) ?
				$networkdata1->[$i] :
				$networkdata2->[$i] );
		}		
	}
	my $network3 = $class->new ( 'inputs' => $inputcount, 
								  'data' => $networkdata3,
								  'minvalue' => $minvalue,
								  'maxvalue' => $maxvalue,
								  'afunc' => $afunc,
								  'dafunc' => $dafunc);
	return $network3;
}


sub mutate {
	my $self = shift;
	my $network = shift;
	my $class = ref($network);
	my $networkdata = $network->get_internals();
	my $inputcount = $network->input_count();
	my $minvalue = $network->minvalue();
	my $maxvalue = $network->maxvalue();
	my $afunc = $network->afunc();
	my $dafunc = $network->dafunc();
	my $neuroncount = $#{$networkdata}; # BTW did you notice that this 
										# isn't what it says it is?
	$networkdata = dclone($networkdata); # For safety.
	for (my $i = 0; $i <= $neuroncount; $i++) {
		# First each input/neuron pair
		for (my $j = 0; $j < $inputcount; $j++) {
			my $weight = $networkdata->[$i]->{'inputs'}->[$j];
			if (defined $weight && $weight != 0) {
				if (rand() < $self->{'mutation_chance'}) {
					$weight += (rand() * 2 - 1) * $self->{'mutation_amount'};
					if ($weight > $self->{'max_value'}) { 
						$weight = $self->{'max_value'};
					}
					if ($weight < $self->{'min_value'}) { 
						$weight = $self->{'min_value'} + 0.000001;
					}
				} 
				if (abs($weight) < $self->{'mutation_amount'}) {
					if (rand() < $self->{'kill_link_chance'}) {
						$weight = undef;
					}
				}
			} else {
				if (rand() < $self->{'add_link_chance'}) {
					$weight = rand() * $self->{'mutation_amount'};
					# We want to Do The Right Thing. Here, that means to 
					# detect whether the user is using weights in (0, x), and
					# if so make sure we don't accidentally give them a 
					# negative weight, because that will become 0.000001. 
					# Instead, we'll generate a positive only value at first 
					# (it's easier) and then, if the user will accept negative 
					# weights, we'll let that happen.
					if ($self->{'min_value'} < 0) {
						($weight *= 2) -= $self->{'mutation_amount'};
					}
					# Of course, we have to check to be sure...
					if ($weight > $self->{'max_value'}) { 
						$weight = $self->{'max_value'};
					}
					if ($weight < $self->{'min_value'}) { 
						$weight = $self->{'min_value'} + 0.000001;
					}
					# But we /don't/ need to to a kill_link_chance just yet.
				}
			}
			# This would be a bloody nightmare if we hadn't done that dclone 
			# magic before. But look how easy it is!
			$networkdata->[$i]->{'inputs'}->[$j] = $weight;
		}
		# Now each neuron/neuron pair
		for (my $j = 0; $j <= $neuroncount; $j++) {
		# As a reminder to those cursed with the duty of maintaining this code:
		# This should be an exact copy of the code above, except that 'inputs' 
		# would be replaced with 'neurons'. 
			my $weight = $networkdata->[$i]->{'neurons'}->[$j];
			if (defined $weight && $weight != 0) {
				if (rand() < $self->{'mutation_chance'}) {
					$weight += (rand() * 2 - 1) * $self->{'mutation_amount'};
					if ($weight > $self->{'max_value'}) { 
						$weight = $self->{'max_value'};
					}
					if ($weight < $self->{'min_value'}) { 
						$weight = $self->{'min_value'} + 0.000001;
					}
				} 
				if (abs($weight) < $self->{'mutation_amount'}) {
					if (rand() < $self->{'kill_link_chance'}) {
						$weight = undef;
					}
				}

			} else {
				if (rand() < $self->{'add_link_chance'}) {
					$weight = rand() * $self->{'mutation_amount'};
					# We want to Do The Right Thing. Here, that means to 
					# detect whether the user is using weights in (0, x), and
					# if so make sure we don't accidentally give them a 
					# negative weight, because that will become 0.000001. 
					# Instead, we'll generate a positive only value at first 
					# (it's easier) and then, if the user will accept negative 
					# weights, we'll let that happen.
					if ($self->{'min_value'} < 0) {
						($weight *= 2) -= $self->{'mutation_amount'};
					}
					# Of course, we have to check to be sure...
					if ($weight > $self->{'max_value'}) { 
						$weight = $self->{'max_value'};
					}
					if ($weight < $self->{'min_value'}) { 
						$weight = $self->{'min_value'} + 0.000001;
					}
					# But we /don't/ need to to a kill_link_chance just yet.
				}
			}
			# This would be a bloody nightmare if we hadn't done that dclone 
			# magic before. But look how easy it is!
			$networkdata->[$i]->{'neurons'}->[$j] = $weight;
		}
		# That was rather tiring, and that's only for the first neuron!!
	}
	# All done. Let's pack it back into an object and let someone else deal
	# with it.
	$network = $class->new ( 'inputs' => $inputcount, 
							 'data' => $networkdata,
							 'minvalue' => $minvalue,
							 'maxvalue' => $maxvalue,
							 'afunc' => $afunc,
							 'dafunc' => $dafunc);
	return $network;
}


sub mutate_gaussian {
    my $self = shift;
    my $network = shift;
	my $class = ref($network);
	my $networkdata = $network->get_internals();
	my $inputcount = $network->input_count();
	my $minvalue = $network->minvalue();
	my $maxvalue = $network->maxvalue();
	my $afunc = $network->afunc();
	my $dafunc = $network->dafunc();
	my $neuroncount = $#{$networkdata}; # BTW did you notice that this 
										# isn't what it says it is?
	$networkdata = dclone($networkdata); # For safety.
	for (my $i = 0; $i <= $neuroncount; $i++) {
        my $n = 0;
        for (my $j = 0; $j < $inputcount; $j++) {