Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

comment on
( [id://3333]=superdoc: print w/replies, xml ) Need Help??

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!!!

Alright, currently what I have been working on is genetic programming - 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).

I am using genetic programming to create a tree that I hope to find a logical function that will evaluate the following truth table:

        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;

[download]

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).

The following is my code for the gp solution: 

#!/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 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 $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{$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_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_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) {
                        $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($popu
+lation[$person_a]->{'tree'}))[0];
                    my($child_b) = (shuffle &get_all_Descendents($popu
+lation[$person_b]->{'tree'}))[0];
                    ($child_a, $child_b) = ($child_b, $child_a);
                    print "Child A: " . &string_tree($population[$pers
+on_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_f
+itness) {$person_a = int(rand($size));}
                    my($child_a) = (shuffle &get_all_Descendents($popu
+lation[$person_a]->{'tree'}))[0];
                    &generate_tree($child_a, int(rand(3))+1);
                    push(@children,$population[$person_a]);
                    $children_size++;
                }
            }
            $generation++;
            @population = @children;
        }
    }
}

[download]

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 some code found. 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.

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.

Currently, I have created a function that tranverses a tree and is supposed to genereate a array of hash references - as seen in sub get_all_Descendents, but it does not appear to work for my purposes. I will admit this is because of a lack of understanding on my part.

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.

Regards,
JT Archie

In reply to 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 learning in the Monastery: (3)
As of 2024-04-25 06:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found