回复 5楼 dhdj866
'优化主函数
Public Function Hecmp(ByVal N As Integer, ByVal M As Integer, _
a() As Double, b() As Double, ByVal alpha As Double, _
ByVal eps As Double, x() As Double, xx() As Double, ByVal K As Integer) As Integer
Dim rn() As Double
Dim r As Integer, G As Integer, i As Integer, j As Integer, it As Integer, kt As Integer, jt As Integer, kk As Integer
Dim fj As Double, fr As Double, fg As Double, z As Double, rr As Double
Dim C() As Double, D() As Double, W() As Double, xt() As Double, xf() As Double
Dim mm As Double
ReDim C(M - 1)
ReDim D(M - 1)
ReDim W(M - 1)
ReDim xt(N - 1)
ReDim xf(N - 1)
'利用随机数产生可用的初始点
Do
Hecmpfs N, M, x(), C(), D(), W()
r = 0: G = 0
While ((r < N) And G = 0) '判断初始点x是否满足约束条件
If ((C(r) <= W(r)) And (D(r) >= W(r))) Then
r = r + 1
Else
G = 1
For i = 0 To N - 1 '利用随机数产生初始点
x(i) = a(i) + (b(i) - a(i)) * Rnd
Next i
End If
Wend
Loop While G = 1
rr = 0#
'Randomize '初始化随机数
For i = 0 To N - 1
xx(i * N * 2) = x(i)
Next i
xx(N * N * 2) = Hecmpf(x(), N)
For j = 1 To 2 * N - 1
For i = 0 To N - 1
'
rr = 2053# * rr + 13849#
'
mm = rr / 65536#
'
rr = rr - mm * 65536#
'
xx(i * N * 2 + j) = a(i) + (b(i) - a(i)) * (rr / 65536#)
'Randomize '初始化随机数
xx(i * N * 2 + j) = a(i) + (b(i) - a(i)) * Rnd
x(i) = xx(i * N * 2 + j)
Next i
it = 1
While it = 1
it = 0: r = 0: G = 0
While ((r < N) And G = 0)
If ((a(r) <= x(r)) And (b(r) >= x(r))) Then
r = r + 1
Else
G = 1
End If
Wend
If (G = 0) Then
Hecmpfs N, M, x(), C(), D(), W()
r = 0
While ((r < M) And (G = 0))
If ((C(r) <= W(r)) And (D(r) >= W(r))) Then
r = r + 1
Else
G = 1
End If
Wend
End If
If (G <> 0) Then
For r = 0 To N - 1
z = 0#
For G = 0 To j - 1
z = z + xx(r * N * 2 + G) / (1# * j)
Next G
xx(r * N * 2 + j) = (xx(r * N * 2 + j) + z) / 2#
x(r) = xx(r * N * 2 + j)
Next r
it = 1
Else
xx(N * N * 2 + j) = Hecmpf(x, N)
End If
Wend
Next j
kk = 1: it = 1
While (it = 1)
it = 0
fr = xx(N * N * 2): r = 0
For i = 1 To 2 * N - 1
If (xx(N * N * 2 + i)) > fr Then r = i: fr = xx(N * N * 2 + i)
Next i
G = 0: j = 0: fg = xx(N * N * 2)
If r = 0 Then
G = 1: j = 1: fg = xx(N * N * 2 + 1)
End If
For i = j + 1 To 2 * N - 1
If (i <> r) Then
If (xx(N * N * 2 + i) > fg) Then
G = i: fg = xx(N * N * 2 + i)
End If
End If
Next i
For i = 0 To N - 1
xf(i) = 0#
For j = 0 To 2 * N - 1
If j <> r Then
xf(i) = xf(i) + xx(i * N * 2 + j) / (2# * N - 1#)
End If
Next j
xt(i) = (1# + alpha) * xf(i) - alpha * xx(i * N * 2 + r)
Next i
jt = 1
While jt = 1
jt = 0
z = Hecmpf(xt, N)
While z > fg
For i = 0 To N - 1
xt(i) = (xt(i) + xf(i)) / 2#
Next i
z = Hecmpf(xt, N)
Wend
j = 0
For i = 0 To N - 1
If (a(i) > xt(i)) Then
xt(i) = xt(i) + 0.0001: j = 1
End If
If (b(i) < xt(i)) Then
xt(i) = xt(i) - 0.0001: j = 1
End If
Next i
If j <> 0 Then
jt = 1
Else
Hecmpfs N, M, xt(), C(), D(), W()
j = 0: kt = 1
While ((kt = 1) And (j < M))
If ((C(j) <= W(j)) And (D(j) >= W(j))) Then
j = j + 1
Else
kt = 0
End If
Wend
If (j < M) Then
For i = 0 To N - 1
xt(i) = (xt(i) + xf(i)) / 2#
Next i
jt = 1
End If
End If
Wend
For i = 0 To N - 1
xx(i * N * 2 + r) = xt(i)
Next i
xx(N * N * 2 + r) = z
fr = 0#: fg = 0#
For j = 0 To 2 * N - 1
fj = xx(N * N * 2 + j)
fr = fr + fj / (2# * N)
fg = fg + fj * fj
Next j
fr = (fg - 2# * N * fr * fr) / (2# * N - 1#)
If (fr >= eps) Then
kk = kk + 1
If (kk < K) Then it = 1
End If
Wend
For i = 0 To N - 1
x(i) = 0#
For j = 0 To 2 * N - 1
x(i) = x(i) + xx(i * N * 2 + j) / (2# * N)
Next j
Next i
z = Hecmpf(x, N): x(N) = z
Hecmpfs N, M, x(), C(), D(), W()
Hecmp = kk
End Function
2011-03-27 14:32
