view release on metacpan or  search on metacpan

lib/AI/FANN/Evolving.pm  view on Meta::CPAN

			$other->$prop($vals);
			$self->$prop($valo);
		}
	}
	
	# copy over the list properties
	my %list_properties = __PACKAGE__->_list_properties;
	for my $prop ( keys %list_properties ) {
		if ( rand(1) < $rr ) {
			my @values = $self->$prop;
			my @valueo = $other->$prop;
			$other->$prop(@values);
			$self->$prop(@valueo);
		}
	}
	
	# copy over the layer properties
	my %layer_properties = __PACKAGE__->_layer_properties;
	for my $prop ( keys %layer_properties ) {
		for my $i ( 0 .. $self->num_layers - 1 ) {
			for my $j ( 0 .. $self->layer_num_neurons($i) - 1 ) {
				my $val = $self->$prop($i,$j);
				$other->$prop($i,$j,$val);			
			}
		}
	}
	return $self;	
}

=item mutate

Mutates the object by the provided mutation rate

=cut

sub mutate {
	my ( $self, $mu ) = @_;
	$log->debug("going to mutate at rate $mu");
	
	# mutate the simple properties
	$log->debug("mutating scalar properties");
	my %scalar_properties = __PACKAGE__->_scalar_properties;
	for my $prop ( keys %scalar_properties ) {
		my $handler = $scalar_properties{$prop};
		my $val = $self->$prop;
		if ( ref $handler ) {
			$self->$prop( $handler->($val,$mu) );
		}
		else {
			$self->$prop( _mutate_enum($handler,$val,$mu) );
		}
	}	
	
	# mutate the list properties
	$log->debug("mutating list properties");
	my %list_properties = __PACKAGE__->_list_properties;
	for my $prop ( keys %list_properties ) {
		my $handler = $list_properties{$prop};		
		my @values = $self->$prop;
		if ( ref $handler ) {
			$self->$prop( map { $handler->($_,$mu) } @values );
		}
		else {
			$self->$prop( map { _mutate_enum($handler,$_,$mu) } @values );
		}		
	}	
	
	# mutate the layer properties
	$log->debug("mutating layer properties");
	my %layer_properties = __PACKAGE__->_layer_properties;
	for my $prop ( keys %layer_properties ) {
		my $handler = $layer_properties{$prop};
		for my $i ( 1 .. $self->num_layers ) {
			for my $j ( 1 .. $self->layer_num_neurons($i) ) {
				my $val = $self->$prop($i,$j);
				if ( ref $handler ) {
					$self->$prop( $handler->($val,$mu) );
				}
				else {
					$self->$prop( _mutate_enum($handler,$val,$mu) );
				}
			}
		}
	}
	return $self;
}

sub _mutate_double {
	my ( $value, $mu ) = @_;
	my $scale = 1 + ( rand( 2 * $mu ) - $mu );
	return $value * $scale;
}

sub _mutate_int {
	my ( $value, $mu ) = @_;
	if ( rand(1) < $mu ) {
		my $inc = ( int(rand(2)) * 2 ) - 1;
		while( ( $value < 0 ) xor ( ( $value + $inc ) < 0 ) ) {
			$inc = ( int(rand(2)) * 2 ) - 1;
		}
		return $value + $inc;
	}
	return $value;
}

sub _mutate_enum {
	my ( $enum_name, $value, $mu ) = @_;
	if ( rand(1) < $mu ) {
		my ($newval) = shuffle grep { $_ != $value } values %{ $enum{$enum_name} };
		$value = $newval if defined $newval;
	}
	return $value;
}

sub _list_properties {
	(
#		cascade_activation_functions   => 'activationfunc',
		cascade_activation_steepnesses => \&_mutate_double,
	)
}

sub _layer_properties {
	(
#		neuron_activation_function  => 'activationfunc',

lib/AI/FANN/Evolving.pm  view on Meta::CPAN

=item neurons

Getter/setter for the number of neurons. Default is 15

=cut

sub neurons {
	my $self = shift;
	if ( @_ ) {
		my $value = shift;
		$log->debug("setting neurons to $value");
		return $self->{'neurons'} = $value;
	}
	else {
		$log->debug("getting neurons");
		return $self->{'neurons'};
	}
}

=item neuron_printfreq

Getter/setter for the number of cascading neurons after which progress is printed. 
default is 10

=cut

sub neuron_printfreq {
	my $self = shift;
	if ( @_ ) {
		my $value = shift;
		$log->debug("setting neuron printfreq to $value");
		return $self->{'neuron_printfreq'} = $value;
	}
	else {	
		$log->debug("getting neuron printfreq");
		return $self->{'neuron_printfreq'};
	}
}

=item train_type

Getter/setter for the training type: 'cascade' or 'ordinary'. Default is ordinary

=cut

sub train_type {
	my $self = shift;
	if ( @_ ) {
		my $value = lc shift;
		$log->debug("setting train type to $value"); 
		return $self->{'train_type'} = $value;
	}
	else {
		$log->debug("getting train type");
		return $self->{'train_type'};
	}
}

=item activation_function

Getter/setter for the function that maps inputs to outputs. default is 
FANN_SIGMOID_SYMMETRIC

=back

=cut

sub activation_function {
	my $self = shift;
	if ( @_ ) {
		my $value = shift;
		$log->debug("setting activation function to $value");
		return $self->{'activation_function'} = $value;
	}
	else {
		$log->debug("getting activation function");
		return $self->{'activation_function'};
	}
}

# this is here so that we can trap method calls that need to be 
# delegated to the FANN object. at this point we're not even
# going to care whether the FANN object implements these methods:
# if it doesn't we get the normal error for unknown methods, which
# the user then will have to resolve.
sub AUTOLOAD {
	my $self = shift;
	my $method = $AUTOLOAD;
	$method =~ s/.+://;
	
	# ignore all caps methods
	if ( $method !~ /^[A-Z]+$/ ) {
	
		# determine whether to invoke on an object or a package
		my $invocant;
		if ( ref $self ) {
			$invocant = $self->{'ann'};
		}
		else {
			$invocant = 'AI::FANN';
		}
		
		# determine whether to pass in arguments
		if ( @_ ) {
			my $arg = shift;
			$arg = $constant{$arg} if exists $constant{$arg};
			return $invocant->$method($arg);
		}
		else {		
			return $invocant->$method;
		}
	}
	
}

1;