autodataming的个人博客分享 http://blog.sciencenet.cn/u/autodataming

博文

perl 遗传算法

已有 2875 次阅读 2014-4-28 17:06 |个人分类:算法|系统分类:科研笔记| Perl, 遗传算法, 单基因的遗传算法

需要解决的问题是

求     #> y=x*sin(10*pi*x)+2

#> x<-seq(-1,2,0.01)


在x的范围内y的最大值对应的x,精确到4位小数

属于单基因的遗传算法,交叉不能带来新的基因

#################################################################

生物和计算的交叉,给计算引入了遗传算法

染色体 基因 突变 交叉(重组)  选择


计算和生物的交叉,带来了计算机辅助药物设计



####################




#!/usr/bin/perl -w

#use strict;


#> x<-seq(-1,2,0.01)


use AI::Genetic;

my $ga = new AI::Genetic(
       -fitness    => \&fitnessFunc,
       -type       => 'rangevector',
       -population => 500,
       -crossover  => 0.9,   #一个基因的话 没有交叉的必要0.9
       -mutation   => 0.1,  
       -terminate  => \&terminateFunc,
      );


my @gene1;

   
   
$ga->init([[-10000,20000]]);#基因的数目
$ga->evolve('rouletteTwoPoint', 100);     # 选择的方法                   一共进化的代数
 
my $individual=$ga->getFittest(1);

my $resultx=$individual->genes();
$resultx=@$resultx[0]/10000;
print "Best score = ", $individual->score(),"  correspond genes: ", $resultx,"  \n";

sub fitnessFunc
{
    my $genes = shift;

    my $fitness;
    # assign a number to $fitness based on the @$genes
    # ...
    #> y=x*sin(10*pi*x)+2
    my $genes1=@$genes[0]/10000;
    $fitness=$genes1*sin(10*3.14159*$genes1)+2;
       # print " $genes1    $fitness\n";
    return $fitness;
 }

 sub terminateFunc
 {
    my $ga = shift;
     
    # terminate if reached some threshold.
    my $THRESHOLD=4;
    return 1 if $ga->getFittest->score > $THRESHOLD;
    return 0;
 }



#######################

算的答案是Best score = 3.8492704037941  correspond genes: 1.8495

Best score = 3.84999793705916  correspond genes: 1.8511

######################


########需要修改pm中的optMutation.pm文件###############################


##### for my $g (@$genes)修改为 for my $g (@$genes-1)##################################


package AI::Genetic::OpMutation;

use strict;

1;

# This package implements various mutation
# algorithms. To be used as static functions.

# sub bitVector():
# each gene is a bit: 0 or 1. arguments are mutation
# prob. and anon list of genes.
# returns anon list of mutated genes.

sub bitVector {
 my ($prob, $genes) = @_;

 for my $g (@$genes) {
   next if rand > $prob;

   $g = $g ? 0 : 1;
 }

 return $genes;
}

# sub rangeVector():
# each gene is a floating number, and can be anything
# within a range of two numbers.
# arguments are mutation prob., anon list of genes,
# and anon list of ranges. Each element in $ranges is
# an anon list of two numbers, min and max value of
# the corresponding gene.

sub rangeVector {
 my ($prob, $ranges, $genes) = @_;
my $n=  scalar(@$genes);


#print "end: $n \n";
my $i = -1;
 for my $g (@$genes-1) {
   $i++;
   next if rand > $prob;

   # now randomly choose another value from the range.
   my $abs = $ranges->[$i][1] - $ranges->[$i][0] + 1;
   $g = $ranges->[$i][0] + int rand($abs);
 }

 return $genes;
}

# sub listVector():
# each gene is a string, and can be anything
# from a list of possible values supplied by user.
# arguments are mutation prob., anon list of genes,
# and anon list of value lists. Each element in $lists
# is an anon list of the possible values of
# the corresponding gene.

sub listVector {
 my ($prob, $lists, $genes) = @_;

 my $i = -1;
 for my $g (@$genes) {
   $i++;
   next if rand > $prob;

   # now randomly choose another value from the lists.
   my $new;

   if (@{$lists->[$i]} == 1) {
     $new = $lists->[$i][0];
   } else {
     do {
   $new = $lists->[$i][rand @{$lists->[$i]}];
     } while $new eq $g;
   }

   $g = $new;
 }

 return $genes;
}

__END__

=head1 NAME

AI::Genetic::OpMutation - A class that implements various mutation operators.

=head1 SYNOPSIS

See L<AI::Genetic>.

=head1 DESCRIPTION

This package implements a few mutation mechanisms that can be used in user-defined
strategies. The methods in this class are to be called as static class methods,
rather than instance methods, which means you must call them as such:

 AI::Genetic::OpCrossover::MethodName(arguments)

=head1 CLASS METHODS

There is really one kind of mutation operator implemented in this class, but it
implemented for the three default individuals types. Each gene of an individual
is looked at separately to decide whether it will be mutated or not. Mutation is
decided based upon the mutation rate (or probability). If a mutation is to happen,
then the value of the gene is switched to some other possible value.

For the case of I<bitvectors>, an ON gene switches to an OFF gene.

For the case of I<listvectors>, a gene's value is replaced by another one from
the possible list of values.

For the case of I<rangevectors>, a gene's value is replaced by another one from
the possible range of integers.

Thus, there are only three methods:

=over

=item B<bitVector>(I<mut_prob, genes>)

The method takes as input the mutation rate, and an anonymous list of genes of
a bitvector individual. The return value is an anonymous list of mutated genes.
Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.

=item B<listVector>(I<mut_prob, genes, possibleValues>)

The method takes as input the mutation rate, an anonymous list of genes of
a listvector individual, and a list of lists which describe the possible
values for each gene. The return value is an anonymous list of mutated genes.
Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.

=item B<rangeVector>(I<mut_prob, genes, rangeValues>)

The method takes as input the mutation rate, an anonymous list of genes of
a rangevector individual, and a list of lists which describe the range of
possible values for each gene. The return value is an anonymous list of
mutated genes. Note that
it is possible that no mutation will occur, and thus the returned genes are
identical to the given ones.

=back

=head1 AUTHOR

Written by Ala Qumsieh I<aqumsieh@cpan.org>.

=head1 COPYRIGHTS

(c) 2003,2004 Ala Qumsieh. All rights reserved.
This module is distributed under the same terms as Perl itself.

=cut

genetic.pl

OpMutation.pm




https://wap.sciencenet.cn/blog-950202-789489.html

上一篇:pymol中小分子的叠合 ligand align,atom align,pair_fit
下一篇:rapaquaro的一天内的科学网轨迹
收藏 IP: 196.122.145.*| 热度|

0

该博文允许注册用户评论 请点击登录 评论 (0 个评论)

数据加载中...

Archiver|手机版|科学网 ( 京ICP备07017567号-12 )

GMT+8, 2024-4-26 04:10

Powered by ScienceNet.cn

Copyright © 2007- 中国科学报社

返回顶部