請大家幫我看一下這樣寫基因演算的方式對不對- 藍色小舖 BlueShop

台灣最大程式設計社群網站

∣免費加入會員∣登入 ∣回首頁∣ 您好

線上人數
614

會員總數：244390
討論主題：188629

登入

登出

歡迎您免費加入會員

討論區選單

開發工具

行動裝置開發

資料庫

多媒體 / 網管

綜合

文章區

討論區列表 >> VB6 >> 請大家幫我看一下這樣寫基因演算的方式對不對

[]

[我要回覆]

請大家幫我看一下這樣寫基因演算的方式對不對
價值 : 100 QP 點閱數:1501 回應數:0

樓主

DDL

0	1
24	0

發送站內信

最近因為學校作業上的需要, 必需要使用到VB來做演算法的編寫
所以算是才剛開始碰VB不久, 坊間的書籍也找了一兩本來做練習
不過對VB裡面的一些定義還是不太熟

手邊的演算法又只有C的 (對C也不太熟, 只會一些比較基本的邏輯, 因為以前都是念機械設計的Orz..)
所以先貼上來請各位幫我找出裡面的一些重要問題跟錯誤

這段主要是想用基因的方式來求y=sin(x)的解
現在遇到的狀況是, 計算出來的適應矩陣(fitness1)裡頭只有fitness1(0,9)有數值, 但是在演化的過程中這個數值卻沒有任何變更
然後在適應值(fitness_value)的部分, 計算出來的適應值也都沒有任何的變更

我自己先猜想了一下可能的原因
1.亂數的部分有問題
2.數值的形式的定義部分有問題

拜託大家可以幫我找找看還有哪些問題 (應該有超多...Orz..)

Private Sub Command1_Click()

Dim MGen As Single
Dim CGen As Single
Dim size1 As Single
Dim Size As Single
Dim cor As Single
Dim mut As Single
Dim pi As Single

MGen = 10      '母代染色體大小
CGen = 8       '子代染色體大小
size1 = 9      '染色體基因長度
Size = 100     '演化代數
cor = 0.8      '交叉率
mut = 0.1      '突變率
pi = 3.1415926 'pi值

Dim i, j, k, rand1, rand2
Dim fitness1(180, 9) As Double     '適應矩陣
Dim fitness_value(180) As Double   '適應值
Dim TGen(2, 9) As Double           '挑選染色體

Call GAcode(fitness1)
Call fitness(fitness1, fitness_value, 0, MGen)
Randomize
For i = 0 To Size
    For j = 0 To (j + CGen / 2)
    rand1 = Fix((32766 - 0 + 1) * Rnd) / 32767
    rand2 = Fix((32766 - 0 + 1) * Rnd) / 32767
    Call disk(fitness1, fitness_value, TGen)
    If rand1 < cor Then
    Call cross(TGen)
    If rand2 < mut Then
    Call mutation(TGen)
        
        For k = 0 To size1
        fitness1(MGen + j * 2, k) = TGen(0, k)
        fitness1(MGen + j * 2 + 1, k) = TGen(1, k)
        Next k
    End If
    End If
    Next j
Call fitness(fitness1, fitness_value, MGen, MGen + CGen)
Call selection(fitness1, fitness_value)
Print "第"; i + 1; "代"

For j = 0 To size1
Print fitness1(0, j)
Next j

Print fitness_value(0)
Next i

End Sub

Sub GAcode(a As Variant)     '初始化

For i = 0 To size1
    For j = 0 To CGen
    
    a(i, j) = Rnd(2)
    
    Next j
Next i

End Sub

Sub fitness(a As Variant, b As Variant, c As Single, d As Single)    '計算適應值
    
    Dim i, j As Single
    Dim sum(180)
    pi = 3.1415926
    For i = c To d
        For j = 0 To 9
        sum(i) = sum(i) + a(i, j) * (2 ^ j)
        Next j
    b(i) = (Sin(sum(i) * pi / 180)) ^ 2
    Next i
    
End Sub

Sub disk(a As Variant, b As Variant, c As Variant)        '圓盤法
Dim i, j, k As Single
Dim sum As Variant
Dim rand1 As Double
Dim percent(181) As Double

sum = 0
For i = 0 To 10
    sum = sum + b(i)
    Next i
percent(0) = 0
For i = 0 To 10
    percent(i + 1) = percent(i) + b(i) / sum
    Next i
Randomize
For i = 0 To 2
rand1 = Fix((32766 - 0 + 1) * Rnd) / 32767
    For j = 0 To 10
    If rand1 > percent(j) And rand1 <= percent(j + 1) Then
        For k = 0 To size1
        c(i, k) = a(j, k)
        Next k
    End If
    Next j
Next i

End Sub
Sub cross(a As Variant)       '交叉
Dim i, j As Single
Dim rand1 As Double
Dim temp1 As Double

i = 0
j = 0
Randomize
rand1 = Fix((size1 - 0 + 1) * Rnd)
For i = 0 To rand1
    temp1 = a(0, i)
    a(0, i) = a(1, i)
    a(1, i) = temp1
    Next i
End Sub

Sub mutation(a As Variant)    '突變
Dim i As Single
Dim j As Single
Dim rand1 As Double

For i = 0 To 2
Randomize
rand1 = Fix((size1 - 0 + 1) * Rnd)
If a(i, rand1) = 0 Then
a(i, rand1) = 1
Else
a(i, rand1) = 0
End If

Next i
End Sub

Sub selection(a As Variant, b As Variant)    '選擇 (淘汰)
Dim i, j As Single
Dim counter1 As Single
Dim temp1 As Double
Dim temp2 As Single

counter1 = 0

Do While counter1 < (MGen + CGen) - 1

For i = 0 To MGen + CGen - 1
    If b(i) < b(i + 1) Then
        temp1 = b(i)
        b(i) = b(i + 1)
        b(i + 1) = temp1
        
        For j = 0 To size1
        temp2 = a(i, j)
        a(i, j) = a(i + 1, j)
        a(i + 1, j) = temp2
        Next j
    End If
Next i
Loop
    
End Sub

搜尋相關Tags的文章： [ 基因演算 ] , [ 演算法 ] , [ GA ] ,
本篇文章發表於2007-08-20 11:43


別忘捐VP感謝幫助你的人	新手會員瞧一瞧

目前尚無任何回覆

回覆

如要回應,請先登入.