Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on
( [id://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;
        }
    }
}

[download]

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?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2024-04-19 04:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found