时间：2010-6
作者：skyseraph
实现工具：VB.NET 2005+sql2005
题目：
用共轭梯度法求解下列问题：
1. min (x1-2)2+2(x2-1)2
2. min 2x12+2x1x2+x22+3x1-4x2
3. min 2x12+2x1x2+5x22
解答：运行结果如下各图所示。
共轭梯度法
1. min (x1-2)2+2(x2-1)2
2. min 2x12+2x1x2+x22+3x1-4x2
3. min 2x12+2x1x2+5x22
程序清单：
Imports System.Data.sqlClient '导入命名空间 使用sql
'Imports System.Data.OleDb '导入命名空间 使用Access
Imports System.math
Public Class Form1
'矩阵A，即梯度函数的系数
Public a As Integer = 2 'f'(x1)/x1
Public b As Integer = 0 'f(x1)/x2
Public c As Integer = 0 'f(x2)/x1
Public d As Integer = 4 'f(x2)/x2
Function fx(ByVal x1 As Double,ByVal x2 As Double) As Double '目标函数 返回函数值
Dim y As Double
'y = x1 * x1 + 2 * x2 * x2
y = x1 * x1 - 4 * x1 + 4 + 2 * x2 * x2 - 4 * x2 + 2
' y = 2 * x1 * x1 + 2 * x1 * x2 + x2 * x2 + 3 * x1 - 4 * x2
'y = 2 * x1 * x1 + 2 * x2 * x1 + 5 * x2 * x2
Return y
'Return Format$(y,"0.000")
End Function
Function ff(ByVal x1 As Double,ByVal x2 As Double) As Double '目标函数的导数 返回d导数的值
Dim y As Double
If x2 = 0 Then
'y = 2 * x1
y = 2 * x1 - 4
' y = 4 * x1 + 2 * x2 + 3
' y = 4 * x1 + 2 * x2
ElseIf x1 = 0 Then
'y = 4 * x2
y = 4 * x2 - 4
'y = 2 * x1 + 2 * x2 - 4
'y = 2 * x1 + 10 * x2
Else
' y = 2 * x1 + 4 * x2
y = 2 * x1 - 4 + 4 * x2 - 4
'y = 4 * x1 + 2 * x2 + 3 + 2 * x1 + 2 * x2 - 4
'y = 4 * x1 + 2 * x2 + 2 * x1 + 10 * x2
End If
Return y
'Return Format$(y,"0.000")
End Function
Function Grad(ByVal x1 As Double,ByVal x2 As Double) As Double '梯度函数 返回梯度值
Dim y As Double
y = Abs((2 * x1) * (2 * x1) + (4 * x2) * (4 * x2)) '自己算梯度的绝对值
Return Format$(y,"0.000")
End Function
Private Sub b_Run_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles b_Run.Click
'每次计算前清除数据库中保存的上一次的计算数据
Dim sqlstr As String
sqlstr = "delete from GongETiDu"
UpdateData(sqlstr)
If Me.tb_x1.Text = "" Or Me.tb_x2.Text = "" Then
MsgBox("请输入初始值",MsgBoxStyle.OkOnly + _
MsgBoxStyle.Exclamation,"请输入数据")
Exit Sub
End If
Dim x1 As Double = CDbl(tb_x1.Text) '初始点坐标x1、x2
Dim x2 As Double = CDbl(tb_x2.Text)
Dim k As Integer = 1 '迭代次数
Dim xk11 As Double = x1 'x(k)
Dim xk12 As Double = x2
Dim xk21 As Double 'x(k+1)
Dim xk22 As Double
Dim gk01 As Double 'g(k-1)
Dim gk02 As Double
Dim gk11 As Double = ff(xk11,0) '= a * xk11 'g(k)
Dim gk12 As Double = ff(0,xk12) '= b * xk12
'Dim gk(,) As Double = {{xk21},{xk22}}
Dim dk01 As Double = -1 * gk01 'd(k-1) 搜索方向
Dim dk02 As Double = -1 * gk02
Dim dk11 As Double 'd(k)
Dim dk12 As Double
Dim bk0 As Double '因子 b(k-1)= g(k)*g(k)/g(k-1)*g(k-1) 当k=1时，bk0=0
Dim rk1 As Double ''步长r(k)
Do While Not (ff(xk11,0) = 0 And ff(0,xk12) = 0 Or k > 5)
If (k = 1) Then
bk0 = 0
'tb_f.Text = dk11 '-10
'tb_grad.Text = dk12 '-20
Else
bk0 = (gk11 * gk11 + gk12 * gk12) / (gk01 * gk01 + gk02 * gk02)
'tb_f.Text = bk0
End If
'tb_f.Text = gk01
'tb_grad.Text = gk02
dk11 = (-1.0) * gk11 + (bk0) * (dk01)
dk12 = (-1.0) * gk12 + (bk0) * (dk02)
' tb_f.Text = dk11
'tb_grad.Text = dk12
rk1 = ((-1) * (gk11 * (dk11) + gk12 * (dk12))) / ((dk11 * (a * dk11 + c * dk12)) + (dk12 * (b * dk11 + d * dk12))) '(a * dk01 * (dk01) + b * dk02 * (dk02)) '步长
'tb_f.Text = rk1
xk21 = xk11 + (rk1) * (dk11)
xk22 = xk12 + (rk1) * (dk12)
' tb_f.Text = CDbl(xk21)
'tb_grad.Text = CDbl(xk22)
gk01 = gk11
gk02 = gk12
gk11 = ff(xk21,0) 'a * xk21
gk12 = ff(0,xk22) 'b * xk22
' tb_f.Text = gk11
'tb_grad.Text = gk12
xk11 = xk21
xk12 = xk22
dk01 = dk11
dk02 = dk12
'把值写入()
Dim sqlstr0 As String
sqlstr0 = "INSERT INTO GongETiDu(k,b,r,x1,x2,f) VALUES ('" & k & "','" & Format$(bk0,"0.000") & "','" & Format$(rk1,'" & Format$(xk11,'" & Format$(xk12,'" & Format$(fx(xk21,xk22),"0.000") & "')"
UpdateData(sqlstr0)
k = k + 1
Loop
tb_k.Text = CDbl(k - 1)
tb_minx1.Text = Format$(CDbl(xk21),"0.000")
tb_minx2.Text = Format$(CDbl(xk22),"0.000")
tb_minf.Text = Format$(fx(xk21,"0.000")
Me.GongETiDuTableAdapter1.Fill(Me.SkyDBDataSet1.GongETiDu)
End Sub
Private Sub b_Exit_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles b_Exit.Click
Me.Close()
End Sub
Private Sub Form1_Load(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles MyBase.Load
'TODO: 这行代码将数据加载到表“SkyDBDataSet1.GongETiDu”中。您可以根据需要移动或移除它。
'Me.GongETiDuTableAdapter1.Fill(Me.SkyDBDataSet1.GongETiDu)
'TODO: 这行代码将数据加载到表“SkyDBDataSet.GongETiDu”中。您可以根据需要移动或移除它。
'Me.GongETiDuTableAdapter.Fill(Me.SkyDBDataSet.GongETiDu)
End Sub
Private Sub b_Clear_Click(ByVal sender As System.Object,ByVal e As System.EventArgs) Handles b_Clear.Click '清数据表 Dim sqlstr As String sqlstr = "delete from GongETiDu" UpdateData(sqlstr) Me.GongETiDuTableAdapter1.Fill(Me.SkyDBDataSet1.GongETiDu) tb_k.Text = "" tb_minx1.Text = "" tb_minx2.Text = "" tb_minf.Text = "" End Sub End Class