软考程序员：标准的遗传算法求函数最大值
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
【编辑推荐】
- 程序员之程序设计知识点三(1)
- 程序员之程序设计知识点三
- 程序员之程序设计知识点五
- 更多软考资料请点击51CTO软考专题