用perl实现简单的遗传算法

抽空写了个遗传算法实例，在[0.63]中寻找f(x)=x*x的最大值，问题很简单。如果用遗传算法可以把染色体编码为6位二进制数，这里染色体重组率为100%，突变率为1%，适应度函数即为求解函数，模拟成轮盘赌，用随机数去实现染色体复制。终止设为一定的循环数，终止时统计很多代中的染色体出现频次，频次最高即为局部最优解。

程序看起来比较乱，能测试通就懒得改了

#!/usr/bin/perl -w

use strict;


# function f(x)=x^2; search max value in [0,63] 


my $raw_num=30;
my $recom_rate=1;
my $mutation_rate=0.1;
my %stat;
my $iter=0;
my (@array_num,@array_seq);
for(my $i=0;$i<$raw_num;$i++){
my $num=int(rand(64));
push @array_num,$num;
$num=ten2bi($num);
if((length $num)!=6){
my $prefix='0'x(6-length $num);
$num=$prefix.$num;
}
push @array_seq,$num;
}
my @fit_rate=@array_num;
fitness(\@fit_rate);
my %fitrate_seq;
my %hash;
make_region(\@fit_rate);
my $rand_number=generate_rand($raw_num);
@array_seq=();
duplicate(\@array_seq);
%hash=();
for (my $i=1;$i<=10000;$i++){
@array_num=();
$iter++;
for(my $j=0;$j!=$raw_num;$j++){
my $tmp=bi2ten($array_seq[$j],$array_num[$j]);
push @array_num,$tmp;
}
my @array_new;
for(my $k=0;$k!=$raw_num;$k+=2){
my($new_num1,$new_num2)=recombination($array_num[$k],$array_num[$k+1]);
die "$new_num1\t$new_num2\tline_45\n" if ($new_num1>63 || $new_num2>63);
push @array_new,$new_num1;
push @array_new,$new_num2;
}
@fit_rate=@array_new;
@array_seq=();
for(my $j=0;$j!=$raw_num;$j++){
my $num=ten2bi($array_new[$j]);
if((length $num)!=6){
my $prefix='0'x(6-length $num);
$num=$prefix.$num;
}
push @array_seq,$num;
}

my ($fit_return)=fitness(\@fit_rate);
@fit_rate=@{$fit_return};
%hash=();
make_region(\@fit_rate);
foreach my$ele(keys %hash){
}
$rand_number=generate_rand($raw_num);
@array_seq=();
duplicate(\@array_seq);
my @output=@array_seq;
for(my $k=0;$k!=$raw_num;$k+=1){
my $output_num=bi2ten($array_seq[$k],0);
#print "$output_num\t";
if($iter>50){
$stat{$output_num}++;
}
}
foreach my$ele(sort {$a cmp $b} keys %hash){
}
#print "\n";
if($iter>500){
my $iter2=0;
foreach my$ele(sort {$stat{$b} <=> $stat{$a}} keys %stat){
$iter2++;
print "$ele\t$stat{$ele}\n" if $iter2<=10;
die "done\n" if $iter>1000;
}
}
}


sub bi2ten{
my($num1,$num2)=@_;
my $iter=0;
for(my $i=(length $num1)-1;$i>=0;$i--){
my $bit=substr($num1,$i,1);
$num2+=$bit*(2**$iter);
$iter++;
}
return $num2;
}
sub duplicate{
my ($array_seq_s)=@_;
foreach my$ele(@{$rand_number}){
foreach my$ele2(sort {$a cmp $b} keys %hash){
my($start,$end)=split /\t/,$ele2;
if($ele>=$start && $ele<$end){
push @{$array_seq_s},$hash{$ele2};
last;
}
}
}
}


sub generate_rand{
my $nums=shift @_;
my @rand_0_1;
for(my $i=0;$i<$nums;$i++){
push @rand_0_1,rand(1);
}
return \@rand_0_1;
}
sub ten2bi{
my $num=shift @_;
my $value;
if($num/2==0){
$value=$num;
}
while($num/2!=0){
$value.=$num%2;
$num=int($num/2);
}
$value=reverse $value;
return $value;
}


sub recombination{
my($num1,$num2)=@_;
$num1=ten2bi($num1);
$num2=ten2bi($num2);
if((length $num1)!=6){
my $prefix='0'x(6-length $num1);
$num1=$prefix.$num1;
}
if((length $num2)!=6){
my $prefix='0'x(6-length $num2);
$num2=$prefix.$num2;
}
my $recom_pos=int(rand((length $num1)-2))+1;
my $num1_pre=substr($num1,0,$recom_pos);
my $num1_suf=substr($num1,$recom_pos,);
my $num2_pre=substr($num2,0,$recom_pos);
my $num2_suf=substr($num2,$recom_pos,);
my $new_num1=$num1_pre.$num2_suf;
my $new_num2=$num2_pre.$num1_suf;
my ($new_mut_num1,$new_mut_num2);
my $mut_des1=rand(1);
my $mut_des2=rand(1);
if($mut_des1<$mutation_rate){
my $mut_pos=int(rand(length $new_num1));
for(my $i=0;$i!=length $new_num1;$i++){
if($i!=$mut_pos){
$new_mut_num1.=substr($new_num1,$i,1);
}else{
my $mut_base=substr($new_num1,$i,1);
if($mut_base=~/1/){
$new_mut_num1.="0";
}else{
$new_mut_num1.="1";
}
}
}
}else{
$new_mut_num1=$new_num1;
}
if($mut_des2<$mutation_rate){
my $mut_pos=int(rand(length $new_num2));
for(my $i=0;$i!=length $new_num2;$i++){
if($i!=$mut_pos){
$new_mut_num2.=substr($new_num2,$i,1);
}else{
my $mut_base=substr($new_num2,$i,1);
if($mut_base=~/1/){
$new_mut_num2.="0";
}else{
$new_mut_num2.="1";
}
}
}
}else{
$new_mut_num2=$new_num2;
}
$new_mut_num1=bi2ten($new_mut_num1);
$new_mut_num2=bi2ten($new_mut_num2);
return ($new_mut_num1,$new_mut_num2);
}


sub fitness{
my ($arr)=@_;
my $sum;
my @return_array;
my @num_fit;
foreach my$ele(@{$arr}){
my $tmp=fitness_function($ele);
$sum+=$tmp;
push @num_fit,$tmp;
}
for(my $i=0;$i<$raw_num;$i++){
my $tmp=$num_fit[$i]/$sum;
push @return_array,$tmp;
}
return \@return_array;
}


sub fitness_function{
my $num=shift @_;
my $num2;
$num2=$num**2;
die "$num\t$num2\n" if $num2<0;
return $num2;
}
sub make_region{
my($fit_rate)=@_;
my @tmp_fit_rate=@{$fit_rate};
%fitrate_seq=();
for(my $i=0;$i<=$#tmp_fit_rate;$i++){
$fitrate_seq{$tmp_fit_rate[$i]}=$array_seq[$i] if not exists $fitrate_seq{$tmp_fit_rate[$i]};
}
my %uniq;
foreach my$ele(keys %fitrate_seq){
}
foreach my$ele(@tmp_fit_rate){
$uniq{$ele}++;
die "$ele\there\n" if not exists $fitrate_seq{$ele};
}
my $key_num=scalar keys %uniq;
if(scalar keys %uniq<=3){
%hash=();
my @tmp=sort {$a <=> $b} keys %uniq;
if(scalar keys %uniq==3){
$hash{"0 0.15"}=$fitrate_seq{$tmp[0]};
$hash{"0.15 0.3"}=$fitrate_seq{$tmp[1]};
$hash{"0.3 1"}=$fitrate_seq{$tmp[2]};
}elsif(scalar keys %uniq==2){
$hash{"0 0.3"}=$fitrate_seq{$tmp[0]};
$hash{"0.3 1"}=$fitrate_seq{$tmp[1]};
}else{
$hash{"0 1"}=$fitrate_seq{$tmp[0]};
}
}else{
%hash=();
my @tmp_fit_rate2;
my $tmp_sum=0;
foreach my$ele(@{$fit_rate}){
$tmp_sum+=$ele;
die if $tmp_sum<0;
push @tmp_fit_rate2,$tmp_sum;
}
for(my $i=0;$i<=$#tmp_fit_rate2;$i++){
if($i==0){
$hash{"0\t$tmp_fit_rate2[0]"}=$array_seq[$i];
}else{
$hash{"$tmp_fit_rate2[$i-1]\t$tmp_fit_rate2[$i]"}=$array_seq[$i];
}
}
}
}