共轭梯度法

时间：2010-6

作者：skyseraph

实现工具：VB.NET 2005+SQL2005

题目：

用共轭梯度法求解下列问题：

1.    min (x₁-2)²+2(x₂-1)²

2.    min 2x₁²+2x₁x₂+x₂²+3x₁-4x₂

3.    min 2x₁²+2x₁x₂+5x₂²

 

解答：运行结果如下各图所示。

共轭梯度法

1. min (x₁-2)²+2(x₂-1)²

 

 

 

 

 

2. min 2x₁²+2x₁x₂+x₂²+3x₁-4x₂

 

 

 

 

 

 

 

3. min 2x₁²+2x₁x₂+5x₂²

 

 

 

程序清单：

 

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, "0.000") & "','" & Format$(xk11, "0.000") & "','" & Format$(xk12, "0.000") & "','" & 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, xk22), "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