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