perlquestion
thealienz1
<p>Hello, monks... before I say anything I want to state the following question is relation to a programming project for school, so if you have any qualms about helping a student of programming - STOP READING!!!</p>
<p>Alright, currently what I have been working on is < a href="http://www.geneticprogramming.com/Tutorial/">genetic programming</a> - similar to genetic algorithm just with programming trees. Currently in my programming I have built a my programming tree using hashes (soemthing similar to a binary tree structure). The tree represents aither a logical operation (AND, OR, NOT) and a variable of a bit (a0, a1, d0, d1, d2, d3).</p>
<p> I am using genetic programming to create a tree that I hope to find a logical function that will evaluate the following truth table:</p>
<p><code> if($a0 eq "0" && $a1 eq "0" && $d0 eq "1") {return 1;}
if($a0 eq "1" && $a1 eq "0" && $d1 eq "1") {return 1;}
if($a0 eq "0" && $a1 eq "1" && $d2 eq "1") {return 1;}
if($a0 eq "1" && $a1 eq "1" && $d3 eq "1") {return 1;}
return 0;
</code></p>
<p>That table is predetermined knowledge my schematic for the logical equation. I have to find a logical that follows that table for all cases from 0-63 (being the 6 bits used for a0, a1, d0, d1, d2, d3).</p>
<p>The following is my code for the gp solution:
<readmore>
<code>#!/usr/bin/perl
use strict;
use List::Util qw(shuffle);
#possible values the node of a tree can be
my(@node_values) = ("a1","a0","d0","d1","d2","d3","AND","OR","NOT");
#probability of one of the following next genereation functions will happen
my(@prob) = (10, #Reproduction
95, #Crossover
5);#Mutation
#the minimum fitness a person must have to be considered for any nexy genereation functions
my($min_fitness) = 10;
#defines the possible values for the truth table
my(%range) = ();
#will generate a logic equation and place it in a tree format
#it is done recursively to a certain depth (defined in level)
#this is called for intializing a population
sub generate_tree() {
my( $node, $level) = @_;
unless($node) {
$node = {};
$node->{left} = undef;
$node->{right} = undef;
$node->{op} = 0;
}
if($level > 0) {
my($op) = @node_values[int(rand($#node_values))];
if($op eq "AND") {
&generate_tree($node->{left}, $level-1 );
&generate_tree($node->{right}, $level-1 );
}
if($op eq "OR") {
&generate_tree($node->{left}, $level-1 );
&generate_tree($node->{right}, $level-1 );
}
if($op eq "NOT") {
&generate_tree($level-1, $node->{left});
$node->{right} = undef;
}
$node->{op} = $op;
}
if($level == 0) {
$node = {};
$node->{left} = undef;
$node->{right} = undef;
$node->{op} = (@node_values[int(rand(6))]);
}
$_[0] = $node;
return;
}
#converts a decimal number to a binary string
#used to generate values for range
sub dec2bin {
my $str = unpack("B32", pack("N", shift));
$str =~ s/^0+(?=\d)//; # otherwise you'll get leading zeros
return $str;
}
#this initializes a population of possible solutions at a certain size
sub initialize() {
my($size) = shift;
my(@people) = {};
print "Intial String:\n";
for(my $i = 0; $i < $size; $i++) {
$people[$i]{'fitness'} = 0;
&generate_tree($people[$i]->{'tree'}, int(rand(6))+1 );
print &string_tree($people[$i]->{'tree'}) . "\n";
}
#the following generates the truth table
#the equation be looked for needs to match
for(my $i = 0; $i < 64; $i++) {
my $value = &dec2bin($i);
my($a0,$a1,$d0,$d1,$d2,$d3) = split(//,$value);
$range{$value} = 0;
if($a0 eq "0" && $a1 eq "0" && $d0 eq "1") {$range{$value} = 1;}
if($a0 eq "1" && $a1 eq "0" && $d1 eq "1") {$range{$value} = 1;}
if($a0 eq "0" && $a1 eq "1" && $d2 eq "1") {$range{$value} = 1;}
if($a0 eq "1" && $a1 eq "1" && $d3 eq "1") {$range{$value} = 1;}
}
return(@people);
}
#takes a tree and evaluates it into an actual logical equation
sub eval_tree() {
my($tree) = shift;
my($value) = shift;
if($tree->{op} eq "AND") {return(&eval_tree($tree->{left},$value) & &eval_tree($tree->{right}, $value));}
if($tree->{op} eq "OR") {return(&eval_tree($tree->{left},$value) | &eval_tree($tree->{right}, $value));}
if($tree->{op} eq "NOT") {return(!(&eval_tree($tree->{left},$value)));}
if($tree->{op} eq "a0") {return(substr($value,0));}
if($tree->{op} eq "a1") {return(substr($value,1));}
if($tree->{op} eq "d0") {return(substr($value,2));}
if($tree->{op} eq "d1") {return(substr($value,3));}
if($tree->{op} eq "d2") {return(substr($value,4));}
if($tree->{op} eq "d3") {return(substr($value,5));}
}
sub calc_fitness() {
my(@people) = @_;
for(my $i = 0; $i < $#people; $i++) {
$people[$i]{'fitness'} = 0;
foreach my $value (keys %range) {
if(&eval_tree($people[$i]{'tree'}, $value) == $range{$value}) {$people[$i]{'fitness'}++;}
}
}
return(@people);
}
#takes a tree and converts it into a string
sub string_tree() {
my($tree) = shift;
my($value) = shift;
if($tree->{op} eq "AND") {return("(" . &string_tree($tree->{left},$value) . " AND " . &string_tree($tree->{right}, $value) . ")");}
if($tree->{op} eq "OR") {return("(" . &string_tree($tree->{left},$value) . " OR " . &string_tree($tree->{right}, $value) . ")");}
if($tree->{op} eq "NOT") {return("(NOT " . (&string_tree($tree->{left},$value)) . ")");}
if($tree->{op} eq "a0") {return("a0");}
if($tree->{op} eq "a1") {return("a1");}
if($tree->{op} eq "d0") {return("d0");}
if($tree->{op} eq "d1") {return("d1");}
if($tree->{op} eq "d2") {return("d2");}
if($tree->{op} eq "d3") {return("d3");}
}
sub found_solution() {
my(@people) = @_;
for(my $i = 0; $i < $#people; $i++) {
if($people[$i]->{'fitness'} == 64) {
print "Solution Found:\n";
print &string_tree($people[$i]->{'tree'});
return(1);
}
}
return(0);
}
sub get_all_Descendents() {
my($node) = shift;
my(@children) = ();
if($node->{left} ne undef) {push(@children, &get_all_Descendents($node->{left}));}
push(@children, \$node);
if($node->{right} ne undef) {push(@children, &get_all_Descendents($node->{right}));}
return(@children);
}
for(my $size = 100; $size < 101; $size++) {
print "Size: $size\n";
my(@population) = &initialize($size);
my($generation) = 0;
my $quit = 0;
while($quit == 0){
@population = &calc_fitness(@population);
if(&found_solution(@population)) {
print "\tFinal Generation: $generation\n";
$quit = 1;
} else{
my(@children) = ();
my($children_size) = 0;
while($children_size < $size) {
my($choice) = int(rand(100) + 1);
if(($choice >= 1) && ($choice <= $prob[0])) {
#Reproduction
my($person_a) = int(rand($size));
while($population[$person_a]->{'fitness'} < $min_fitness) {$person_a = int(rand($size));}
push(@children,$population[$person_a]);
$children_size++;
}
if(($choice > $prob[0]) && ($choice <= $prob[1])) {
#Crossover
my($person_a)= int(rand($size));
my($person_b)= int(rand($size));
while($population[$person_a]->{'fitness'} < $min_fitness && $population[$person_b]->{'fitness'} < $min_fitness) {
$person_a = int(rand($size));
$person_b = int(rand($size));
}
print "Person A: ";
print &string_tree($population[$person_a]{'tree'}) . "\n";
my($child_a) = (shuffle &get_all_Descendents($population[$person_a]->{'tree'}))[0];
my($child_b) = (shuffle &get_all_Descendents($population[$person_b]->{'tree'}))[0];
($child_a, $child_b) = ($child_b, $child_a);
print "Child A: " . &string_tree($population[$person_a]->{'tree'}) . "\n";
push(@children,$population[$person_a]);
push(@children,$population[$person_b]);
$children_size+=2;
}
if(($choice > $prob[1]) && ($choice <= 100)) {
#Mutations
my($person_a) = int(rand($size));
while($population[$person_a]->{'fitness'} < $min_fitness) {$person_a = int(rand($size));}
my($child_a) = (shuffle &get_all_Descendents($population[$person_a]->{'tree'}))[0];
&generate_tree($child_a, int(rand(3))+1);
push(@children,$population[$person_a]);
$children_size++;
}
}
$generation++;
@population = @children;
}
}
}</code></p></readmore>
<p>I believe it to logically work, but am having trouble with one section of my code. I have represented the data of the tree using a hash based on <a href="http://iis1.cps.unizar.es/Oreilly/perl/cookbook/ch11_16.htm">some code found.</a> I know my tree structure is working correctly because I can tranverse the tree and evaluate correctly, but my problem lies in the fact that crossover and mutation.</p>
<readmore>
<p>Crossover and mutation are fundamental in the process of genetic algorithm or programming, but with the tree hash structure I am having a bit of a problem. Crossover is when two individuals exchange nodes of their tree and mutation is when a random node of an individual is changed in value. Well the problem I having is selecting that random node, since my tree is a hash within a hash (ie $tree->{left}{left}{right} = "AND") I do not know how to select that random node.</p>
<p>Currently, I have created a function that tranverses a tree and is supposed to genereate a array of hash references - as seen in <tt>sub get_all_Descendents</tt>, but it does not appear to work for my purposes. I will admit this is because of a lack of understanding on my part.</p>
</readmore>
<p>I'd appreciate any insight into this problem. I posted all my code on here, so people could tinker with it if they wanted too.</p>
<p>Regards,<br />JT Archie</p>