sub dec2bin { my $str = unpack("B32", pack("N", shift)); return substr($str, -6); } #### Deep recursion on subroutine "main::replace_node" at P:\test\398622.pl line 155. #### 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; } #### $_[0] = $tree; return; #### srand(1); #### #!/usr/bin/perl use strict; use warnings; srand(1); ### ONLY FOR DEBUGGING!!! my(@node_values) = ( 'a1', 'a0', 'd0', 'd1', 'd2', 'd3', 'AND', 'OR', 'NOT' ); my(@prob) = (10, 95, 5); my($min_fitness) = 10; my %range; 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; } sub dec2bin { my $str = unpack('B32', pack('N', shift @_)); return substr($str, -6); } 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"; } for (my $i = 0; $i < 64; ++$i) { my $value = dec2bin($i); my($a0, $a1, $d0, $d1, $d2, $d3) = split(//, $value, 7); $range{$value} = 0; if ($a0 eq '0' and $a1 eq '0' and $d0 eq '1') { $range{$value} = 1; } if ($a0 eq '1' and $a1 eq '0' and $d1 eq '1') { $range{$value} = 1; } if ($a0 eq '0' and $a1 eq '1' and $d2 eq '1') { $range{$value} = 1; } if ($a0 eq '1' and $a1 eq '1' and $d3 eq '1') { $range{$value} = 1; } } return @people; } 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; } 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_random_node { my($tree) = shift @_; my($prob) = int rand 100; if ($prob < 40 and defined $$tree{'left'}) { return get_random_node($$tree{'left'}); } if ($prob > 60 and 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 and $choice <= $prob[0]) { 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] and $choice <= $prob[1]) { my($person_a) = int rand $size; my($person_b) = int rand $size; while ($population[$person_a]{'fitness'} < $min_fitness and $population[$person_b]{'fitness'} < $min_fitness and $person_a != $person_b ) { $person_a = int rand $size; $person_b = int rand $size; } my($child_a, $child_b) = {}; ($$child_a{'tree'}, $$child_b{'tree'}) = crossover( $population[$person_a]{'tree'}, $population[$person_b]{'tree'} ); push @children, $child_a; push @children, $child_b; $children_size += 2; } if ($choice > $prob[1] and $choice <= 100) { my($person_a) = int rand $size; while ($population[$person_a]{'fitness'} < $min_fitness) { $person_a = int rand $size; } my($child_a) = {}; ($$child_a{'tree'}) = mutation($population[$person_a]{'tree'}); push @children, $child_a; ++$children_size; } } ++$generation; @population = @children; } } } __END__ P:\test>398622 Size: 100 Intial String: d2 (d2 AND d1) ((d3 AND a0) OR (d3 AND d2)) a1 d0 a0 d1 a1 d1 d2 d2 d3 d0 d2 (d2 AND d0) d3 (d2 OR a0) a0 a0 (((d2 OR d1) OR d0) AND d0) a1 a1 a1 (a0 OR a0) d3 d3 a0 d1 (d3 OR a1) d1 d2 d0 a0 (d2 AND ((d0 AND a0) OR d3)) a1 d2 (a1 OR d3) d0 a1 d3 (d2 OR d1) a0 d1 d2 d1 d2 (d3 AND d1) d0 a1 d3 a1 (d2 OR d0) d0 d0 d0 d0 d2 ((d0 AND d1) AND (a1 OR d3)) a1 a0 d3 a0 a1 d3 (d0 OR d0) d3 d3 d3 a0 a1 (a0 AND a1) a1 d1 d3 a1 a0 d0 a0 d2 a0 (d3 OR (a0 OR d0)) (d1 OR (a1 OR d1)) d1 a1 d0 (d1 AND a0) d2 d1 d3 (d2 AND d3) d1 d3 (a0 OR a0) d3 d0 a1 d2 d3 a0 ((d2 OR d3) AND a1) Use of uninitialized value in numeric lt (<) at P:\test\398622.pl line 243. Use of uninitialized value in numeric lt (<) at P:\test\398622.pl line 248. Deep recursion on subroutine "main::replace_node" at P:\test\398622.pl line 188. Deep recursion on subroutine "main::replace_node" at P:\test\398622.pl line 191. Terminating on signal SIGINT(2)