1 2package AI::Genetic::Defaults; 3 4use strict; 5use AI::Genetic::OpSelection; 6use AI::Genetic::OpCrossover; 7use AI::Genetic::OpMutation; 8 91; 10 11# this implements the default strategies. 12 13sub rouletteSinglePoint { 14 # initialize the roulette wheel 15 AI::Genetic::OpSelection::initWheel($_[0]->people); 16 17 push @_ => 'vectorSinglePoint', 'rouletteUnique'; 18 goto &genericStrategy; 19} 20 21sub rouletteTwoPoint { 22 # initialize the roulette wheel 23 AI::Genetic::OpSelection::initWheel($_[0]->people); 24 25 push @_ => 'vectorTwoPoint', 'rouletteUnique'; 26 goto &genericStrategy; 27} 28 29sub rouletteUniform { 30 # initialize the roulette wheel 31 AI::Genetic::OpSelection::initWheel($_[0]->people); 32 33 push @_ => 'vectorUniform', 'rouletteUnique'; 34 goto &genericStrategy; 35} 36 37sub tournamentSinglePoint { 38 push @_ => 'vectorSinglePoint', 'tournament', [$_[0]->people]; 39 goto &genericStrategy; 40} 41 42sub tournamentTwoPoint { 43 push @_ => 'vectorTwoPoint', 'tournament', [$_[0]->people]; 44 goto &genericStrategy; 45} 46 47sub tournamentUniform { 48 push @_ => 'vectorUniform', 'tournament', [$_[0]->people]; 49 goto &genericStrategy; 50} 51 52sub randomSinglePoint { 53 push @_ => 'vectorSinglePoint', 'random', [$_[0]->people]; 54 goto &genericStrategy; 55} 56 57sub randomTwoPoint { 58 push @_ => 'vectorTwoPoint', 'random', [$_[0]->people]; 59 goto &genericStrategy; 60} 61 62sub randomUniform { 63 push @_ => 'vectorUniform', 'random', [$_[0]->people]; 64 goto &genericStrategy; 65} 66 67# generic sub that implements everything. 68sub genericStrategy { 69 my ($ga, $Xop, $selOp, $selArgs) = @_; 70 71 #perhaps args should be: 72 # ($ga, [xop, xargs], [selop, selargs]) ? 73 74 my $pop = $ga->people; 75 76 # now double up the individuals, and get top half. 77 my $size = $ga->size; 78 my $ind = $ga->indType; 79 80 my @newPop; 81 82 # optimize 83 my $crossProb = $ga->crossProb; 84 85 # figure out mutation routine to use, and its arguments. 86 my @mutArgs = ($ga->mutProb); 87 my $mutOp = 'bitVector'; 88 if ($ind =~ /IndRangeVector/) { 89 $mutOp = 'rangeVector'; 90 push @mutArgs => $pop->[0]->ranges; 91 } elsif ($ind =~ /IndListVector/) { 92 $mutOp = 'listVector'; 93 push @mutArgs => $pop->[0]->lists; 94 } 95 96 my ($ssub, $xsub, $msub); 97 { 98 no strict 'refs'; 99 $ssub = \&{"AI::Genetic::OpSelection::$selOp"}; 100 $xsub = \&{"AI::Genetic::OpCrossover::$Xop"}; 101 $msub = \&{"AI::Genetic::OpMutation::$mutOp"}; 102 } 103 104 for my $i (1 .. $size/2) { 105 my @parents = $ssub->(@$selArgs); 106 @parents < 2 and push @parents => $ssub->(@$selArgs); 107 108 my @cgenes = $xsub->($crossProb, map scalar $_->genes, @parents); 109 110 # check if two didn't mate. 111 unless (ref $cgenes[0]) { 112 @cgenes = map scalar $_->genes, @parents; 113 } 114 115 # mutate them. 116 $_ = $msub->(@mutArgs, $_) for @cgenes; 117 118 # push them into pop. 119 push @newPop => map $pop->[0]->new($_), @cgenes; 120 } 121 122 # assign the fitness function. This is UGLY. 123 my $fit = $pop->[0]->fitness; 124 $_->fitness($fit) for @newPop; 125 126 # now chop in half and reassign the population. 127 $ga->people(AI::Genetic::OpSelection::topN([@$pop, @newPop], $size)); 128} 129