Perl-Sensitive Sunglasses PerlMonks

### Re^3: Curious about Perl's strengths in 2018

by bliako (Monsignor)
 on Apr 16, 2018 at 13:27 UTC Need Help??

At the end all these languages are Turing complete and will eventually arrive at the same tape square. What interests me is the spirit and the inspiration. Pretty metaphysical I agree... A comment to your side-note: I am not sure what is more "scary": genes dying out or ideas? Ideas I should think.

I have whipped up some code to get me started with Perl's evolutionary computing toolkit.

```#!/usr/bin/env perl

# Brief and dirty attempt to solve a system of simultaneous equations
+(2)
# using Genetic Algorithms in particular CPAN module
#   Algorithm::Evolutionary
#   Perl module for performing paradigm-free evolutionary algorithms
#   by J. J. Merelo, jmerelo (at) geneura.ugr.es
# (parts of my program were copied from manpage)
#
# The toy problem here is to find INTEGER solutions to the system of e
+quations y-x=2 and y-2x=11
# wrt x and y.
# Our 2 genes are 'x' and 'y'. We encode these as 8-bit integers
# 7+1sign bit. The algorithm will mutate/crossover etc the bit string
+of each member of
# the population. Then it will evaluate how well the genes of each mem
+ber of the population
# solve the problem at hand. This is called the fitness. The fittest g
+enes survive and the
# rest are discarded, with some probability.
# Author: bliako
# Date: 16/04/2018

use strict;
use warnings;

use Algorithm::Evolutionary::Experiment;
use Algorithm::Evolutionary::Op::Easy;
use Algorithm::Evolutionary::Op::Bitflip;
use Algorithm::Evolutionary::Op::Crossover;

my \$num_genes = 2;

my \$fitness = sub {
my \$individual = shift;
my \$genes = chromosome2genes(\$individual->Chrom());
return calculate_discrepancy(\$genes);
};

my \$m = Algorithm::Evolutionary::Op::Bitflip->new(2); # flip this numb
+er of bits randomly
my \$c = Algorithm::Evolutionary::Op::Crossover->new(2); # crossover wi
+th 2 points
# every iteration applies the above operations to the population along
+ with a fitness function
# and selection rate (prob of good genes to survive, lower means more
+"bad" genes enter the next generation)
my \$ez = new Algorithm::Evolutionary::Op::Easy \$fitness, 0.4, [\$m,\$c];
my \$popSize = 500; # population size, each individual in this pop has
+a chromosome which consists of 2 genes
my \$indiType = 'BitString'; # the chromosome is a sequence of bits as
+a string
my \$indiSize = 8*\$num_genes; # 8 bits per gene
my \$e = new Algorithm::Evolutionary::Experiment \$popSize, \$indiType, \$
+indiSize, \$ez;
my \$populationRef;
my \$previous_fitness = 0;
my (\$current_fitness, \$best);
while(1){
\$populationRef = \$e->go();
\$best = \$populationRef->[0];
print "Best so far: ", \$best->asString(), " (", individual2string(
+\$best),")\n";
\$current_fitness = \$best->Fitness();
if( \$current_fitness == 0 ){ print "bingo!\n"; last }
#if( (\$previous_fitness - \$current_fitness) == 0 ){ last }
\$previous_fitness = \$current_fitness;
}

print "\nI tried to solve the system of equations: y-x=2 and y-2x=11.
+The solution should be x=3, y=5\n";
print "Final solution found: ".individual2string(\$best)."\n";

exit(0);

sub individual2string {
my \$individual = \$_[0];
my \$genes = chromosome2genes(\$individual->Chrom());
my \$fit = calculate_discrepancy(\$genes);
return genes2string(\$genes) . " -> discrepancy=" . \$fit
}
# interpret an array of genes wrt our problem, i.e. an x and a y
sub genes2string {
my \$genes = \$_[0];
return "x=".\$genes->[0].", y=".\$genes->[1];
}
# convert a huge bit string into an array of genes
# the array to place the genes in is given
sub chromosome2genes {
my \$achromosome = \$_[0]; # chromosome bit string containing all ge
+nes as 10101

my @retgenes = (0)x\$num_genes;

# convert a chromosome which consists of genes which consist of bi
+ts(alleles)
# into a set of numbers to be applied to our problem.
# each chromosome below consists of 2 genes which consist of 8 bit
+s (1sign+7)
# these 8bits are interpreted as integers in +-127 range (which is
+ enough for our problem
# however if solution involved bigger numbers we need to increase
+range/bits)
my \$i=0;
while( \$achromosome =~ /([01])([01]{7})/g ){
my \$sig = \$1 eq '1' ? -1 : 1;
my \$g2 = \$2;

# Here is how a sequence of 8bits is converted to integers. 1s
+t bit is sign.
# I am sure there is a better way using pack.
my \$g = 0;
my \$j = 1;
map { \$g += \$_*\$j; \$j*=2; } split(//, \$g2);
\$g *= \$sig;

\$retgenes[\$i++] = \$g;
#print "\$g2->num=\$g\n";
}
return \@retgenes
}
sub    calculate_discrepancy {
my \$genes = \$_[0];

# Our problem is to solve the simultaneous equation: y-x=2 and y-2
+x=11
# where genes[0] -> y, genes[1]->x
my \$e1 = \$genes->[0] - \$genes->[1] - 2;
my \$e2 = \$genes->[0] + 2*\$genes->[1] - 11;
# we calculate discrepancy but we need to return fitness:
return -(\$e1*\$e1 + \$e2*\$e2);
}

Replies are listed 'Best First'.
Re^4: Curious about Perl's strengths in 2018
by Crosis (Beadle) on Apr 23, 2018 at 06:52 UTC

Nice example code!

thanks, a lot of it is from the manpage of said module. Finally we agreed on something :))) bw. bliako

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1212989]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (None)
As of 2024-05-24 01:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found