AI-FANN-Evolving
5 results

 view release on metacpan or  search on metacpan

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

sub new {
	my $class = shift;
	my %args  = @_;
	my $self  = {};
	bless $self, $class;
	$self->_init(%args);
	
	# de-serialize from a file
	if ( my $file = $args{'file'} ) {
		$self->{'ann'} = AI::FANN->new_from_file($file);
		$log->debug("instantiating from file $file");
		return $self;
	}
	
	# build new topology from input data
	elsif ( my $data = $args{'data'} ) {
		$log->debug("instantiating from data $data");
		$data = $data->to_fann if $data->isa('AI::FANN::Evolving::TrainData');
		
		# prepare arguments
		my $neurons = $args{'neurons'} || ( $data->num_inputs + 1 );
		my @sizes = ( 
			$data->num_inputs, 
			$neurons,
			$data->num_outputs
		);

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

		else {
			$self->{'ann'} = AI::FANN->new_standard( @sizes );
		}
		
		# finalize the instance
		return $self;
	}
	
	# build new ANN using argument as a template
	elsif ( my $ann = $args{'ann'} ) {
		$log->debug("instantiating from template $ann");
		
		# copy the wrapper properties
		%{ $self } = %{ $ann };
		
		# instantiate the network dimensions
		$self->{'ann'} = AI::FANN->new_standard(
			$ann->num_inputs, 
			$ann->num_inputs + 1,
			$ann->num_outputs,
		);

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


Uses the object as a template for the properties of the argument, e.g.
$ann1->template($ann2) applies the properties of $ann1 to $ann2

=cut

sub template {
	my ( $self, $other ) = @_;
	
	# copy over the simple properties
	$log->debug("copying over simple properties");
	my %scalar_properties = __PACKAGE__->_scalar_properties;
	for my $prop ( keys %scalar_properties ) {
		my $val = $self->$prop;
		$other->$prop($val);
	}
	
	# copy over the list properties
	$log->debug("copying over list properties");
	my %list_properties = __PACKAGE__->_list_properties;
	for my $prop ( keys %list_properties ) {
		my @values = $self->$prop;
		$other->$prop(@values);
	}
	
	# copy over the layer properties
	$log->debug("copying over 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;

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

}

=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 {

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

}

=item clone

Clones the object

=cut

sub clone {
	my $self = shift;
	$log->debug("cloning...");
	
	# we delete the reference here so we can use 
	# Algorithm::Genetic::Diploid::Base's cloning method, which
	# dumps and loads from YAML. This wouldn't work if the 
	# reference is still attached because it cannot be 
	# stringified, being an XS data structure
	my $ann = delete $self->{'ann'};
	my $clone = $self->SUPER::clone;
	
	# clone the ANN by writing it to a temp file in "FANN/FLO"

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


=item train

Trains the AI on the provided data object

=cut

sub train {
	my ( $self, $data ) = @_;
	if ( $self->train_type eq 'cascade' ) {
		$log->debug("cascade training");
	
		# set learning curve
		$self->cascade_activation_functions( $self->activation_function );
		
		# train
		$self->{'ann'}->cascadetrain_on_data(
			$data,
			$self->neurons,
			$self->neuron_printfreq,
			$self->error,
		);
	}
	else {
		$log->debug("normal training");
	
		# set learning curves
		$self->hidden_activation_function( $self->activation_function );
		$self->output_activation_function( $self->activation_function );
		
		# train
		$self->{'ann'}->train_on_data(
			$data,
			$self->epochs,
			$self->epoch_printfreq,

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

=item error

Getter/setter for the error rate. Default is 0.0001

=cut

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

=item epochs

Getter/setter for the number of training epochs, default is 500000

=cut

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

=item epoch_printfreq

Getter/setter for the number of epochs after which progress is printed. default is 1000

=cut

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

=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 {

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


=over

=item recombine

Recombines properties of the AI during meiosis in proportion to the crossover_rate

=cut

sub recombine {
	$log->debug("recombining chromosomes");
	# get the genes and columns for the two chromosomes
	my ( $chr1, $chr2 ) = @_;
	my ( $gen1 ) = map { $_->mutate } $chr1->genes;
	my ( $gen2 ) = map { $_->mutate } $chr2->genes;	
	my ( $ann1, $ann2 ) = ( $gen1->ann, $gen2->ann );
	$ann1->recombine($ann2,$chr1->experiment->crossover_rate);
	
	# assign the genes to the chromosomes (this because they are clones
	# so we can't use the old object reference)
	$chr1->genes($gen1);

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

=cut

sub workdir {
	my $self = shift;
	if ( @_ ) {
		my $value = shift;
		$log->info("assigning new workdir $value");
		$self->{'workdir'} = $value;
	}
	else {
		$log->debug("retrieving workdir");
	}
	return $self->{'workdir'};
}

=item traindata

Getter/setter for the L<AI::FANN::TrainData> object.

=cut

sub traindata {
	my $self = shift;
	if ( @_ ) {
		my $value = shift;
		$log->info("assigning new traindata $value");
		$self->{'traindata'} = $value;
	}
	else {
		$log->debug("retrieving traindata");
	}
	return $self->{'traindata'};
}

=item run

Runs the experiment!

=cut

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

	for my $i ( 1 .. $self->ngens ) {
	
		# modify workdir
		my $wd = $self->{'workdir'};
		$wd =~ s/\d+$/$i/;
		$self->{'workdir'} = $wd;
		mkdir $wd;
		
		my $optimum = $self->optimum($i);
		
		$log->debug("optimum at generation $i is $optimum");
		my ( $fittest, $fitness ) = $self->population->turnover($i,$self->env,$optimum);
		push @results, [ $fittest, $fitness ];
	}
	my ( $fittest, $fitness ) = map { @{ $_ } } sort { $a->[1] <=> $b->[1] } @results;
	return $fittest, $fitness;
}

=item optimum

The optimal fitness is zero error in the ANN's classification. This method returns

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

=item ann

Getter/setter for an L<AI::FANN::Evolving> ANN

=cut

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

=item make_function

Returns a code reference to the fitness function, which when executed returns a fitness
value and writes the corresponding ANN to file

=cut

sub make_function {
	my $self = shift;
	my $ann = $self->ann;
	my $error_func = $self->experiment->error_func;
	$log->debug("making fitness function");
	
	# build the fitness function
	return sub {		
	
		# train the AI
		$ann->train( $self->experiment->traindata );
	
		# isa TrainingData object, this is what we need to use
		# to make our prognostications. It is a different data 
		# set (out of sample) than the TrainingData object that

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

		# this is a number which we try to keep as near to zero
		# as possible
		my $fitness = 0;
		
		# iterate over the list of input/output pairs
		for my $i ( 0 .. ( $env->length - 1 ) ) {
			my ( $input, $expected ) = $env->data($i);
			my $observed = $ann->run($input);
			
			use Data::Dumper;
			$log->debug("Observed: ".Dumper($observed));
			$log->debug("Expected: ".Dumper($expected));
			
			# invoke the error_func provided by the experiment
			$fitness += $error_func->($observed,$expected);
		}
		$fitness /= $env->length;
		
		# store result
		$self->{'fitness'} = $fitness;

		# store the AI

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

}

=item read_data

Reads provided input file

=cut

sub read_data {
	my ( $self, $file ) = @_; # file is tab-delimited
	$log->debug("reading data from file $file");
	open my $fh, '<', $file or die "Can't open $file: $!";
	my ( %header, @table );
	while(<$fh>) {
		chomp;
		next if /^\s*$/;
		my @fields = split /\t/, $_;
		if ( not %header ) {
			my $i = 0;
			%header = map { $_ => $i++ } @fields;
		}

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

	# compute number of different dependent patterns and ratios of each
	my @dependents = $self->dependent_data;
	my %seen;
	for my $dep ( @dependents ) {
		my $key = join '/', @{ $dep };
		$seen{$key}++;
	}
	
	# adjust counts to sample size
	for my $key ( keys %seen ) {
		$log->debug("counts: $key => $seen{$key}");
		$seen{$key} = int( $seen{$key} * $sample );
		$log->debug("rescaled: $key => $seen{$key}");
	}

	# start the sampling	
	my @dc = map { $self->{'header'}->{$_} } $self->dependent_columns;
	my @new_table; # we will populate this
	my @table = @{ $clone1->{'table'} }; # work on cloned instance
	
	# as long as there is still sampling to do 
	SAMPLE: while( grep { !!$_ } values %seen ) {
		for my $i ( 0 .. $#table ) {
			my @r = @{ $table[$i] };
			my $key = join '/', @r[@dc];
			if ( $seen{$key} ) {
				my $rand = rand(1);
				if ( $rand < $sample ) {
					push @new_table, \@r;
					splice @table, $i, 1;
					$seen{$key}--;
					$log->debug("still to go for $key: $seen{$key}");
					next SAMPLE;
				}
			}
		}
	}
	$clone2->{'table'} = \@new_table;
	$clone1->{'table'} = \@table;
	return $clone2, $clone1;
}

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


sub size { scalar @{ shift->{'table'} } }

=item to_fann

Packs data into an L<AI::FANN> TrainData structure

=cut

sub to_fann {
	$log->debug("encoding data as FANN struct");
	my $self = shift;
	my @cols = @_ ? @_ : $self->predictor_columns;
	my @deps = $self->dependent_data;
	my @pred = $self->predictor_data( 'cols' => \@cols );
	my @interdigitated;
	for my $i ( 0 .. $#deps ) {
		push @interdigitated, $pred[$i], $deps[$i];
	}
	return AI::FANN::TrainData->new(@interdigitated);
}



( run in 1.265 second using v1.01-cache-2.11-cpan-49f99fa48dc )