Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) 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); }

In reply to Re^3: Curious about Perl's strengths in 2018 by bliako
in thread Curious about Perl's strengths in 2018 by Crosis

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2024-03-28 17:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found