时间: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 (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|