无约束多维优化坐标轮换法vb编程

VB

坐标轮换法程序框图

VB

Vb运行界面

Vb编程程序

Private Sub Command1_Click()

Dim s110 As Double

Dim s100 As Double

Dim s200 As Double

Dim s210 As Double

Dim x100(10000000) As Double

Dim x110(10000000) As Double

Dim x200(10000000) As Double

Dim x210(10000000) As Double

Dim αα1 As Double

Dim αα2 As Double

Dim k As Long

Dim a1#, a2#, a3#, a4#, a5#, a6#

Dim h#, e1#, e#

Dim α0#, α1#, α2#, α3#, a#, b#

Dim xx1#, xx2#, yy1#, yy2#, yy3#

Dim f2#, f1#, fxx#

α0 = Val(Text10.Text)

h = Val(Text11.Text)

e1 = Val(Text12.Text)

x100(0) = Val(Text7.Text)

x110(0) = Val(Text8.Text)

VB

a1 = Val(Text1.Text): a2 = Val(Text2.Text): a3 = Val(Text3.Text): a4 = Val(Text4.Text): a5 = Val(Text5.Text): a6 = Val(Text6.Text)

e = Val(Text9.Text)

k = 0

m1: s100 = 1: s110 = 0

'一维搜索求最优解

α1 = α0

xx1 = x100(k) + s100 * α1: xx2 = x110(k) + s110 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

α2 = α0 + h

xx1 = x100(k) + s100 * α2: xx2 = x110(k) + s110 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

If yy1 > yy2 Then

h = 2 * h

Else

h = -0.25 * h

α3 = α1

α1 = α2

α2 = α3

yy3 = yy1

yy1 = yy2

yy2 = yy3

End If

α3 = α0 + h

xx1 = x100(k) + s100 * α3: xx2 = x110(k) + s110 * α3: yy3 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Do While yy2 > yy3

h = 2 * h

α1 = α2

yy1 = yy2

α2 = α3

yy2 = yy3

α3 = α0 + h

xx1 = x100(k) + s100 * α3: xx2 = x110(k) + s110 * α3: yy3 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Loop

If h > 0 Then

a = α1

ya = yy1

b = α3

yb = yy3

Else

a = α3

b = α1

VB

yb = yy1

End If

α1 = a + 0.382 * (b - a)

α2 = a + 0.618 * (b - a)

xx1 = x100(k) + s100 * α1: xx2 = x110(k) + s110 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

xx1 = x100(k) + s100 * α2: xx2 = x110(k) + s110 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Do While Abs(b - a) > e1

If yy1 < yy2 Then

n0 = 0

b = α2

α2 = α1

yy2 = yy1

Else

n0 = 1

a = α1

α1 = α2

yy1 = yy2

End If

If n0 = 0 Then

α1 = a + 0.382 * (b - a)

xx1 = x100(k) + s100 * α1: xx2 = x110(k) + s110 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Else

α2 = a + 0.618 * (b - a)

xx1 = x100(k) + s100 * α2: xx2 = x110(k) + s110 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

End If

Loop

αα1 = (a + b) / 2

x200(k) = x100(k) + s100 * αα1

x210(k) = x110(k) + s110 * αα1

s200 = 0: s210 = 1

'一维搜索求最优解

α1 = α0

xx1 = x200(k) + s200 * α1: xx2 = x210(k) + s210 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

α2 = α0 + h

xx1 = x200(k) + s200 * α2: xx2 = x210(k) + s210 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

If yy1 > yy2 Then

VB

Else

h = -0.25 * h

α3 = α1

α1 = α2

α2 = α3

yy3 = yy1

yy1 = yy2

yy2 = yy3

End If

α3 = α0 + h

xx1 = x200(k) + s200 * α3: xx2 = x210(k) + s210 * α3: yy3 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Do While yy2 > yy3

h = 2 * h

α1 = α2

yy1 = yy2

α2 = α3

yy2 = yy3

α3 = α0 + h

xx1 = x200(k) + s200 * α3: xx2 = x210(k) + s210 * α3: yy3 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Loop

If h > 0 Then

a = α1

ya = yy1

b = α3

yb = yy3

Else

a = α3

b = α1

ya = yy3

yb = yy1

End If

α1 = a + 0.382 * (b - a)

α2 = a + 0.618 * (b - a)

xx1 = x200(k) + s200 * α1: xx2 = x210(k) + s210 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

xx1 = x200(k) + s200 * α2: xx2 = x210(k) + s210 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Do While Abs(b - a) > e1

If yy1 < yy2 Then

n0 = 0

b = α2

VB

α2 = α1

yy2 = yy1

Else

n0 = 1

a = α1

α1 = α2

yy1 = yy2

End If

If n0 = 0 Then

α1 = a + 0.382 * (b - a)

xx1 = x200(k) + s200 * α1: xx2 = x210(k) + s210 * α1: yy1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Else

α2 = a + 0.618 * (b - a)

xx1 = x200(k) + s200 * α2: xx2 = x210(k) + s210 * α2: yy2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

End If

Loop

αα2 = (a + b) / 2

x200(k + 1) = x200(k) + s200 * αα2

x210(k + 1) = x210(k) + s210 * αα2

xx1 = x200(k): xx2 = x210(k): f1 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

xx1 = x200(k + 1): xx2 = x210(k + 1): f2 = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

If Abs((x200(k + 1) - x200(k)) ^ 2 + (x210(k + 1) - x210(k)) ^ 2) <= e And Abs((f2 - f1) / f2) <= e Then

xx1 = x200(k + 1): xx2 = x210(k + 1)

fxx = a1 * xx1 ^ 2 + a2 * xx2 ^ 2 + a3 * xx1 * xx2 + a4 * xx1 + a5 * xx2 + a6

Else

x100(k + 1) = x200(k): x110(k + 1) = x210(k)

k = k + 1

GoTo m1

End If

Text13.Text = xx1

Text14.Text = xx2

Text15.Text = fxx

End Sub

Private Sub Command2_Click()

Unload Me

End Sub

本文来源：https://www.bwwdw.com/article/q894.html