Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 pondering the Monastery: (2)
    As of 2024-07-19 17:55 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?
      erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.