view release on metacpan or  search on metacpan

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

use strict; #-*-CPerl-*-
use warnings;

use lib qw( ../../../lib );

=head1 NAME

Algorithm::Evolutionary::Utils - Container module with a hodgepodge of functions
                 
=head1 SYNOPSIS
  
  use Algorithm::Evolutionary::Utils qw(entropy genotypic_entropy hamming consensus average random_bitstring random_number_array decode_string vector_compare );

  my $this_entropy = entropy( $population );

  #Computes consensus sequence (for binary chromosomes
  my $this_consensus = consensus( $population); 

=head1 DESCRIPTION

Miscellaneous class that contains functions that might be useful
    somewhere else, especially when computing EA statistics.  

=cut


=head1 METHODS

=cut

package Algorithm::Evolutionary::Utils;

use Exporter;
our @ISA = qw(Exporter);

our $VERSION =   sprintf "3.4";

our @EXPORT_OK = qw( entropy genotypic_entropy consensus hamming 
		     random_bitstring random_number_array average 
		     parse_xml decode_string vector_compare);

use Carp;
use String::Random;
use XML::Parser;
use Statistics::Basic qw(mean);

=head2 entropy( $population)

Computes the entropy using the well known Shannon's formula: L<http://en.wikipedia.org/wiki/Information_entropy>
'to avoid botching highlighting

=cut

sub entropy {
  my $population = shift;
  my %frequencies;
  map( (defined $_->Fitness())?$frequencies{$_->Fitness()}++:1, @$population );
  my $entropy = 0;
  my $gente = scalar(@$population); # Population size
  for my $f ( keys %frequencies ) {
    my $this_freq = $frequencies{$f}/$gente;
    $entropy -= $this_freq*log( $this_freq );
  }
  return $entropy;
}

=head2 genotypic_entropy( $population)

Computes the entropy using the well known Shannon's formula:
L<http://en.wikipedia.org/wiki/Information_entropy> 'to avoid botching
highlighting; in this case we use chromosome frequencies instead of
fitness. 

=cut

sub genotypic_entropy {
  my $population = shift;
  my %frequencies;
  map( $frequencies{$_->{'_str'}}++, @$population );
  my $entropy = 0;
  my $gente = scalar(@$population); # Population size
  for my $f ( keys %frequencies ) {
    my $this_freq = $frequencies{$f}/$gente;
    $entropy -= $this_freq*log( $this_freq );
  }
  return $entropy;
}

=head2 hamming( $string_a, $string_b )

Computes the number of positions that are different among two strings, the well known Hamming distance. 

=cut

sub hamming {
    my ($string_a, $string_b) = @_;
    return ( ( $string_a ^ $string_b ) =~ tr/\1//);
}

=head2 consensus( $population, $rough = 0 )

Consensus sequence representing the majoritary value for each bit;
returns the consensus binary string. If "rough", then the bit is set only if the 
difference is bigger than 0.4 (60/40 proportion).

=cut

sub consensus {
  my $population = shift;
  my $rough = shift;
  my @frequencies;
  for ( @$population ) {
      for ( my $i = 0; $i < $_->size(); $i ++ ) {
	  if ( !$frequencies[$i] ) {
	      $frequencies[$i]={ 0 => 0,
			     1 => 0};
	  }
	  $frequencies[$i]->{substr($_->{'_str'}, $i, 1)}++;
      }
  }
  my $consensus;
  for my $f ( @frequencies ) {
    if ( !$rough ) {
      if ( $f->{'0'} > $f->{'1'} ) {
	$consensus.='0';
      } else {
	$consensus.='1';
      }
    } else {