Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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.


In reply to Re: GP problem with tree structure using hash by thealienz1
in thread GP problem with tree structure using hash by thealienz1

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? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2023-02-01 12:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (2 votes). Check out past polls.

    Notices?