求精简和修改perl6写的遗传算法GA

aef25u

仿照python用perl6实现了最简单的遗传算法，但感觉臃肿，请大牛帮精简或改写地更perler一些，只改部分代码均行。
其中：1、dot函数自已实现的只适用简单情况，不知perl6有没有现成的或哪个模块能提供?
        2、np.random.choice（python版函数），我用自己想的方法进行模拟（位于select()函数内），求改写地更简洁或更好的版本

1.     my @p=@fitness.map: {$_/sum(@fitness)};
   
2.     my %h=(0..@p.elems-1).map: {$_=>($POP_SIZE* @p[$_]*10).round(1)+1};
   
3.     my @sample;
   
4.     for %h.kv -> $key, $value {
   
5.         #say("$key=>$value");
   
6.         push(@sample,$key) for (1..$value);      
   
7.     }
   
8.     my @samshuffle=@sample.sort: { rand };
   
9.     my @idx = @samshuffle.roll($POP_SIZE);

复制代码

1. my $DNA_SIZE = 10;            # DNA 长度
   
2. my $POP_SIZE = 100;           # 种群总数
   
3. my $CROSS_RATE = 0.8;        # 交叉配对比率 (DNA crossover)
   
4. my $MUTATION_RATE = 0.003;    # 变异率 mutation probability
   
5. my $N_GENERATIONS = 200;      # 繁殖代数
   
6. my @X_BOUND = (0, 5);         # x坐标范围
   
7. 
   
8. sub dot(@a,@b) {
   
9.     fail "Vector @a length not equal to @b!" unless +@a == +@b;
   
10.     my @c = @a <<*>> @b;
    
11. }
    
12. 
    
13. # 查找某函数在X_BOUND范围内的最大值
    
14. sub F(@x) {return @x.map:{sin(10*$_)*$_ + cos(2*$_)*$_}}
    
15. 
    
16. #适应度函数（y值占所有y值合计的占比越大越有优势）
    
17. #如果函数会产生负值，将横坐标轴下移，令所有y值均大于0，
    
18. #因遗传选择时select（），@p=@fitness.map: {$_/sum(@fitness)};不能为负值且分母不能为0
    
19. sub get_fitness(@pred) { return @pred.map: {$_ + 1e-3 - min(@pred)}}
    
20. 
    
21. # DNA翻译规则：即x，二进制表示的DNA转为十进制，并将其归一化至(0, 5)
    
22. sub translateDNA(@pop){return @pop.map: { [+](dot($_,(0..^$DNA_SIZE).reverse.map: { 2** $_} )) / (2**$DNA_SIZE-1)*@X_BOUND[1]}}
    
23. 
    
24. #遗传选择函数，适者生存，不适者淘汰
    
25. #按编号返回优势者个体列表；$p参数：表示选择标准（此例中按照比例来选择，适应度得分高的p有越大的概率被留下来）
    
26. sub select(@pop, @fitness){
    
27.     my @p=@fitness.map: {$_/sum(@fitness)};
    
28.     my %h=(0..@p.elems-1).map: {$_=>($POP_SIZE* @p[$_]*10).round(1)+1};
    
29.     my @sample;
    
30.     for %h.kv -> $key, $value {
    
31.         #say("$key=>$value");
    
32.         push(@sample,$key) for (1..$value);      
    
33.     }
    
34.     my @samshuffle=@sample.sort: { rand };
    
35.     my @idx = @samshuffle.roll($POP_SIZE);
    
36.     return @pop[@idx];
    
37. }
    
38. 
    
39. #繁衍，优势个体作为父亲，按交叉配对比率CROSS_RATE在优势种群中选择母亲，生成小孩
    
40. sub crossover($parent, @pop) {
    
41.     if (rand <  $CROSS_RATE) {
    
42.         my $i=(0..^$POP_SIZE).roll(1);
    
43.         say("PARENT<=>MOTHER:["~$parent~"]<=>["~ @pop[$i]~"]");
    
44.         my @cross_points =Bool.roll($DNA_SIZE);
    
45.         say(@cross_points);
    
46.         @cross_points[$_] ?? ($parent[$_]=@pop[$i][$_]) !! $parent[$_] for (0..@cross_points.elems-1);
    
47.         say("CHILD:["~$parent~"]");
    
48.         }
    
49.         return $parent;
    
50. }
    
51. 
    
52. 
    
53. #变异（在DNA_SIZE中的每一位（0/1)基因根据变异率MUTATION_RATE突变为(1/0)）
    
54. sub mutate($child) {
    
55.      for 0..^$DNA_SIZE ->$point {
    
56.           if rand < $MUTATION_RATE {
    
57.                  ($child[$point] == 0) ?? ($child[$point] = 1) !! 0;
    
58.           }
    
59.     }
    
60.     return $child;
    
61. }
    
62. 
    
63. sub Pop{
    
64.      my @pop;
    
65.      @pop[$_]= roll($DNA_SIZE, ^2).Array for ^$POP_SIZE;
    
66.      return @pop;
    
67. }
    
68. 
    
69. ### 01INPUT：初始化种群DNA
    
70. my @pop=Pop();
    
71. #say(@pop);
    
72. 
    
73. for (1..$N_GENERATIONS) {
    
74.     #二进制DNA转为十进制并输入函数，得出y值
    
75.     my @F_values = F(translateDNA(@pop));
    
76.    
    
77.     ### 02PROCESS：遗传选择过程
    
78.     #计算适应度得分，评价个体的优劣
    
79.     my @fitness = get_fitness(@F_values);
    
80. 
    
81.     my $midx=@fitness.first: * == max(@fitness), :k;
    
82.     my $MF_pop=@pop[$midx];
    
83.     say("Most fitted DNA: ["~$MF_pop~"]"~translateDNA(Array($MF_pop)));
    
84.     #say(@fitness[$midx] ~"="~max(@fitness));
    
85. 
    
86.     #模拟自然环境的优胜劣汰,输入种群与适应度得分，返回优势种群
    
87.     my @pop_sel = select(@pop, @fitness);
    
88.     my @pop_copy=@pop_sel;
    
89.     for @pop_sel -> $parent  is rw {
    
90.          #在优势种群中找到母亲，并与父亲进行繁衍
    
91.          my $child = crossover($parent, @pop_copy);
    
92.          ###03OUTPUT：产生更多优势个体
    
93.          #变异
    
94.          $child = mutate($child);
    
95.          #小孩列表更换为父亲列表
    
96.          $parent= $child;
    
97.          say("Most fitted CHILD=>["~$parent~"]"~translateDNA(Array($parent)));
    
98.     }
    
99. }

复制代码