- 论坛徽章:
- 0
|
本帖最后由 aef25u 于 2020-01-06 19:21 编辑
仿照python用perl6实现了最简单的遗传算法,但感觉臃肿,请大牛帮精简或改写地更perler一些,只改部分代码均行。
其中:1、dot函数自已实现的只适用简单情况,不知perl6有没有现成的或哪个模块能提供?
2、np.random.choice(python版函数),我用自己想的方法进行模拟(位于select()函数内),求改写地更简洁或更好的版本
- my @p=@fitness.map: {$_/sum(@fitness)};
- my %h=(0..@p.elems-1).map: {$_=>($POP_SIZE* @p[$_]*10).round(1)+1};
- my @sample;
- for %h.kv -> $key, $value {
- #say("$key=>$value");
- push(@sample,$key) for (1..$value);
- }
- my @samshuffle=@sample.sort: { rand };
- my @idx = @samshuffle.roll($POP_SIZE);
复制代码
- my $DNA_SIZE = 10; # DNA 长度
- my $POP_SIZE = 100; # 种群总数
- my $CROSS_RATE = 0.8; # 交叉配对比率 (DNA crossover)
- my $MUTATION_RATE = 0.003; # 变异率 mutation probability
- my $N_GENERATIONS = 200; # 繁殖代数
- my @X_BOUND = (0, 5); # x坐标范围
- sub dot(@a,@b) {
- fail "Vector @a length not equal to @b!" unless +@a == +@b;
- my @c = @a <<*>> @b;
- }
- # 查找某函数在X_BOUND范围内的最大值
- sub F(@x) {return @x.map:{sin(10*$_)*$_ + cos(2*$_)*$_}}
- #适应度函数(y值占所有y值合计的占比越大越有优势)
- #如果函数会产生负值,将横坐标轴下移,令所有y值均大于0,
- #因遗传选择时select(),@p=@fitness.map: {$_/sum(@fitness)};不能为负值且分母不能为0
- sub get_fitness(@pred) { return @pred.map: {$_ + 1e-3 - min(@pred)}}
- # DNA翻译规则:即x,二进制表示的DNA转为十进制,并将其归一化至(0, 5)
- sub translateDNA(@pop){return @pop.map: { [+](dot($_,(0..^$DNA_SIZE).reverse.map: { 2** $_} )) / (2**$DNA_SIZE-1)*@X_BOUND[1]}}
- #遗传选择函数,适者生存,不适者淘汰
- #按编号返回优势者个体列表;$p参数:表示选择标准(此例中按照比例来选择,适应度得分高的p有越大的概率被留下来)
- sub select(@pop, @fitness){
- my @p=@fitness.map: {$_/sum(@fitness)};
- my %h=(0..@p.elems-1).map: {$_=>($POP_SIZE* @p[$_]*10).round(1)+1};
- my @sample;
- for %h.kv -> $key, $value {
- #say("$key=>$value");
- push(@sample,$key) for (1..$value);
- }
- my @samshuffle=@sample.sort: { rand };
- my @idx = @samshuffle.roll($POP_SIZE);
- return @pop[@idx];
- }
- #繁衍,优势个体作为父亲,按交叉配对比率CROSS_RATE在优势种群中选择母亲,生成小孩
- sub crossover($parent, @pop) {
- if (rand < $CROSS_RATE) {
- my $i=(0..^$POP_SIZE).roll(1);
- say("PARENT<=>MOTHER:["~$parent~"]<=>["~ @pop[$i]~"]");
- my @cross_points =Bool.roll($DNA_SIZE);
- say(@cross_points);
- @cross_points[$_] ?? ($parent[$_]=@pop[$i][$_]) !! $parent[$_] for (0..@cross_points.elems-1);
- say("CHILD:["~$parent~"]");
- }
- return $parent;
- }
- #变异(在DNA_SIZE中的每一位(0/1)基因根据变异率MUTATION_RATE突变为(1/0))
- sub mutate($child) {
- for 0..^$DNA_SIZE ->$point {
- if rand < $MUTATION_RATE {
- ($child[$point] == 0) ?? ($child[$point] = 1) !! 0;
- }
- }
- return $child;
- }
- sub Pop{
- my @pop;
- @pop[$_]= roll($DNA_SIZE, ^2).Array for ^$POP_SIZE;
- return @pop;
- }
- ### 01INPUT:初始化种群DNA
- my @pop=Pop();
- #say(@pop);
- for (1..$N_GENERATIONS) {
- #二进制DNA转为十进制并输入函数,得出y值
- my @F_values = F(translateDNA(@pop));
-
- ### 02PROCESS:遗传选择过程
- #计算适应度得分,评价个体的优劣
- my @fitness = get_fitness(@F_values);
- my $midx=@fitness.first: * == max(@fitness), :k;
- my $MF_pop=@pop[$midx];
- say("Most fitted DNA: ["~$MF_pop~"]"~translateDNA(Array($MF_pop)));
- #say(@fitness[$midx] ~"="~max(@fitness));
- #模拟自然环境的优胜劣汰,输入种群与适应度得分,返回优势种群
- my @pop_sel = select(@pop, @fitness);
- my @pop_copy=@pop_sel;
- for @pop_sel -> $parent is rw {
- #在优势种群中找到母亲,并与父亲进行繁衍
- my $child = crossover($parent, @pop_copy);
- ###03OUTPUT:产生更多优势个体
- #变异
- $child = mutate($child);
- #小孩列表更换为父亲列表
- $parent= $child;
- say("Most fitted CHILD=>["~$parent~"]"~translateDNA(Array($parent)));
- }
- }
复制代码
|
|