in reply to GP problem with tree structure using hash

As per your suggestions, the following is the updated code, but as of now it gives me an error of "Out of memory!" after running for a while. It might that I am testing it out on a school system with several people online, or that I am just using too much memory with $hashes. I will let you know the results when I get home.

#!/usr/bin/perl use strict; use warnings; #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 h +appen 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 substr($str, -6); } #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{$valu +e}) {$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->{l +eft},$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_random_node() { my($tree) = shift; my($prob) = int(rand(100)); if($prob < 40 && defined ($tree->{left})) {return(get_random_node( +$tree->{left}));} if($prob > 60 && defined ($tree->{right})) {return(get_random_node +($tree->{right}));} return($tree); } sub replace_node() { my($tree,$a,$b) = @_; if($tree == $a) { $tree = $b; } else{ if(defined($tree->{left})) {&replace_node($tree->{left},$a,$b) +;} if(defined($tree->{right})) {&replace_node($tree->{right},$a,$ +b);} } $_[0] = $tree; return; } sub crossover() { my($tree_a, $tree_b) = @_; my($node_a) = &get_random_node($tree_a); my($node_b) = &get_random_node($tree_b); &replace_node($tree_a, $node_a, $node_b); &replace_node($tree_b, $node_b, $node_a); return($tree_a, $tree_b); } sub mutation() { my($tree) = shift; my($node_a) = &get_random_node($tree); my($node_b) = {}; &generate_tree($node_b, int(rand(3))+1 ); &replace_node($tree, $node_a, $node_b); return($tree); } 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_f +itness) {$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_f +itness && $population[$person_b]->{'fitness'} < $min_fitness && $pers +on_a != $person_b) { $person_a = int(rand($size)); $person_b = int(rand($size)); } my($child_a, $child_b) = {}; #print "A : " . &string_tree($population[$person_a +]->{'tree'}) . "\n"; ($child_a->{'tree'},$child_b->{'tree'}) = &crossov +er($population[$person_a]->{'tree'},$population[$person_b]->{'tree'}) +; #print "CA : " . &string_tree($child_a->{'tree'}) +. "\n"; push(@children,$child_a); push(@children,$child_b); $children_size+=2; } if(($choice > $prob[1]) && ($choice <= 100)) { #Mutations my($person_a) = int(rand($size)); while($population[$person_a]->{'fitness'} < $min_f +itness) {$person_a = int(rand($size));} my($child_a) = {}; #print "MA : " . &string_tree($population[$person_ +a]->{'tree'}) . "\n"; ($child_a->{'tree'}) = (&mutation($population[$per +son_a]->{'tree'})); #print "MA1 : " . &string_tree($child_a->{'tree'}) + . "\n"; push(@children,$child_a); $children_size++; } } $generation++; @population = @children; } } }

Thanks for the help.

Replies are listed 'Best First'. | |
---|---|

Re^2: GP problem with tree structure using hash
by BrowserUk (Patriarch) on Oct 13, 2004 at 07:10 UTC |

In Section
Seekers of Perl Wisdom

Comment onRe: GP problem with tree structure using hashDownloadCode