軟考程序員：標準的遺傳算法求函數最大值
Dim N2（30） As Long 用來保存2的N次方的數據
Dim Script As Object 調用其Eval函數
Public Enum CrossOver
OnePointCrossOver單點交叉
TwoPointCrossOver兩點交叉
UniformCrossOver 平均交叉
End Enum
Public Enum Selection
RouletteWheelSelection輪盤賭選擇
StochasticTourament 隨機競爭選擇
RandomLeagueMatches 隨機聯賽選擇
StochasticUniversalSampleing 隨機遍歷取樣
End Enum
Public Enum EnCoding
Binary 標準二進制編碼
Gray格雷碼
End Enum
Private Type GAinfo
Max As Double
Cordinate（） As Double
End Type
*********************************** 二進制碼轉格雷碼 ***********************************
函 數 名： BinaryToGray
參數： Value - 要轉換的二進制數的實值
說明：如3對應的二進制表示為0011，而用格雷碼表示為0010，這個函數的value為0011代表的實數
而返回的是0010所代表的實數（2）
返 回 值： 返回格雷碼對應的二進制數的實值
*********************************** 二進制碼轉格雷碼 ***********************************
Public Function BinaryToGray（Value As Long） As Long
Dim V As Long, Max As Long
Dim start As Long, mEnd As Long, Temp As Long, Counter As Long
Dim Flag As Boolean
V = Value: Max = 1
While V > 0
V = V / 2
Max = Max * 2
Wend
If Max = 0 Then Exit Function
Flag = True
mEnd = Max - 1
While start < mEnd
Temp = （mEnd + start - 1） / 2
If Value <= Temp Then
If Not Flag Then
Counter = Counter + （mEnd - start + 1） / 2
End If
mEnd = Temp
Flag = True
Else
If Flag Then
Counter = Counter + （mEnd - start + 1） / 2
End If
Temp = Temp + 1
start = Temp
Flag = False
End If
Wend
BinaryToGray = Counter
End Function
*********************************** 格雷碼轉二進制碼 ***********************************
函 數 名： BinaryToGray
參數： Value - 要轉換的二進制數的實值
說明：如3對應的二進制表示為0011，而用格雷碼表示為0010，這個函數的value為0010代表的實數
而返回的是0010所代表的實數（2）
返 回 值： 返回格雷碼對應的二進制數的實值
*********************************** 格雷碼轉二進制碼 ***********************************
Public Function GrayToBinary（Value As Long） As Long
Dim V As Long, Max As Long
Dim start As Long, mEnd As Long, Temp As Long, Counter As Long
Dim Flag As Boolean
V = Value: Max = 1
While V > 0
V = V / 2
Max = Max * 2
Wend
Flag = True
mEnd = Max - 1
While start < mEnd
Temp = Counter + （mEnd - start + 1） / 2
If Flag Xor （Value < Temp） Then
If Flag Then Counter = Temp
start = （start + mEnd + 1） / 2
Flag = False
Else
If Not Flag Then Counter = Temp
mEnd = （start + mEnd - 1） / 2
Flag = True
End If
Wend
GrayToBinary = start
End Function
*********************************** 十進制轉轉二進制碼 ***********************************
函 數 名： DecToBinary
參數： Value - 要轉換的十進制數
返 回 值： 返回對應的二進制數
*********************************** 十進制轉轉二進制碼 ***********************************
Private Function DecToBinary（ByVal Value As Long） As String
Dim StrTemp As String
Dim ModNum As Integer
Do While Value > 0
ModNum = Value Mod 2
Value = Value \ 2
StrTemp = ModNum & StrTemp
Loop
DecToBinary = StrTemp
End Function
************************************* 二十進制轉換 **********************************
函 數 名： BinToDec
參數： BinCode - 二進制字符串
返 回 值： 轉換后的十進制數
說明：二進制字符串轉換位十進制數
************************************* 二十進制轉換 **********************************
Public Function BinToDec（BinCode As String） As Long
Dim i As Integer, Dec As Long, Length As Integer
Length = Len（BinCode）
For i = 1 To Length
If Mid（BinCode, i, 1） = “1” Then
Dec = Dec + N2（Length - i）
End If
Next
BinToDec = Dec
End Function
*********************************** 編碼 ***********************************
過 程 名： Coding
參數： Bits - 需要編碼的位數
BinGroup - 保存群體編碼數據的數組
說明：編碼，準確的說應該是初始化種群，對于二進制碼和格雷碼這個過程一樣的
*********************************** 編碼 ***********************************
Public Sub Coding（Bits As Integer, BinGroup（） As String）
Dim i As Integer, j As Integer
Dim Temp As String
Randomize
For i = 1 To UBound（BinGroup, 1）
Temp = “”
For j = 1 To Bits
If Rnd >= 0.5 Then
Temp = Temp & “1”
Else
Temp = Temp & “0”
End If
Next
BinGroup（i） = Temp
Next
End Sub
【編輯推薦】
