求精簡和修改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. }

復制代碼