谢谢

[ 本帖最后由 ylg146394424 于 2014-5-27 21:10 编辑 ]

不知道数学公式原型，看不懂。
'无解，返回
If Abs(d) = 1 = 1 Then　　　‘好似VB没这种写法

    legauss = False
   
    Exit Function
   
End If

修改了几处，发现求解成功（不是我看懂了算法，只是根据常识和上下文关联得到的），修改后代码如下（红色部分为修改部分）：

Sub main()
    Dim n As Integer, nmaxit As Integer
    Dim t As Double, h As Double
    Dim s As String
    '3次方程
    n = 3
    ReDim x(n) As Double
    '初值数组
    x(1) = 1
    x(2) = 1
    x(3) = 1
    '最大迭代次数
    nmaxit = 100
    '增量及控制参数
    t = 0.1
    h = 0.1
    '求解
    If nlnewtonA(n, x, nmaxit, 0.0000001, h, t) Then
        s = ""
        For i = 1 To n
            s = s & "x(" & i & "）=" & x(i) & Chr(13)
        Next i
        MsgBox "求解成功！" & Chr(13) & Chr(13) & s
        Else
        MsgBox "求解失败"
        End If
    End Sub
    Sub func(x() As Double, y() As Double)
        y(1) = x(1) * x(1) + x(2) * x(2) + x(3) * x(3) - 1
        y(2) = 2 * x(1) * x(1) + x(2) * x(2) - 4 * x(3)
        y(3) = 3 * x(1) * x(1) - 4 * x(2) + x(3) * x(3)
    End Sub
    Public Function legauss(n As Integer, dbla() As Double, dblb() As Double) As Boolean
    '局部变量
    Dim i As Integer, j As Integer, k As Integer
    Dim nis As Integer
    ReDim njs(n) As Integer
    Dim d As Double, t As Double
    '开始求解
    For k = 1 To n - 1
        d = 0
        '归一
        For i = k To n
            For j = k To n
            t = Abs(dbla(i, j))
            If t > d Then
                d = t
                njs(k) = j
                nis = i
            End If
        Next j
    Next i
    '无解，返回
    If Abs(d) + 1 = 1 Then      
        legauss = False
        Exit Function
    End If
    '消元
    If njs(k) <> k Then
        For i = 1 To n
            t = dbla(i, k)
            dbla(i, k) = dbla(i, njs(k))
            dbla(i, njs(k)) = t
        Next i
    End If
    If nis <> k Then
        For j = k To n
            t = dbla(k, j)
            dbla(k, j) = dbla(nis, j)
            dbla(nis, j) = t
        Next j
        t = dblb(k)
        dblb(k) = dblb(nis)
        dblb(nis) = t
    End If
    d = dbla(k, k)
    For j = k + 1 To n
        dbla(k, j) = dbla(k, j) / d
    Next j
    dblb(k) = dblb(k) / d
    For i = k + 1 To n
        For j = k + 1 To n
            dbla(i, j) = dbla(i, j) - dbla(i, k) * dbla(k, j)
        Next j
        dblb(i) = dblb(i) - dbla(i, k) * dblb(k)
     Next i
Next k
d = dbla(n, n)
'无解，返回
If Abs(d) + 1 = 1 Then     '这里感谢2楼的提示
    legauss = False
    Exit Function
End If
'回代
dblb(n) = dblb(n) / d
For i = n - 1 To 1 Step -1
    t = 0
    For j = i + 1 To n
        t = t + dbla(i, j) * dblb(j)
    Next j
    dblb(i) = dblb(i) - t
Next i
'调整解的次序
njs(n) = n
For k = n To 1 Step -1
    If njs(k) <> k Then
    t = dblb(k)
    dblb(k) = dblb(njs(k))
    dblb(njs(k)) = t
    End If
Next k
'求解成功
legauss = True
End Function
Function nlnewtonA(n As Integer, x() As Double, nmaxit As Integer, eps As Double, h As Double, t As Double) As Boolean
      Dim i As Integer, j As Integer, l As Integer
      Dim am As Double, z As Double, beta As Double, d As Double
      ReDim y(n) As Double, a(n, n) As Double, b(n) As Double
      l = nmaxit                                 '最大迭代次数
      am = 1 + eps                   '精度控制
      While (am >= eps)                  '迭代求解
      Call func(x, b)                         '函数值
      am = 0
      For i = 1 To n
        z = Abs(b(i))
        If (z > am) Then am = z
        Next i
        If (am >= eps) Then
        l = l - 1
        '达到最大迭代次数，精度未到达要求，求解失败，返回
        If (l = 0) Then
        nlnewtonA = False
        Exit Function
        End If
        For j = 1 To n
        z = x(j)
        x(j) = x(j) + h
        Call func(x, y)
           For i = 1 To n
        a(i, j) = y(i)
            Next i
        x(j) = z
        Next j
        '高斯消元失败，求解失败，返回
        If Not legauss(n, a, b) Then
            nlnewtonA = False
            Exit Function
        End If
        beta = 1
        For i = 1 To n
            beta = beta - b(i)
        Next i
        '方程求解失败，返回
        If (Abs(beta) + 1 = 1) Then
            nlnewtonA = False
            Exit Function
        End If
        d = h / beta
        For i = 1 To n
            x(i) = x(i) - d * b(i)
        Next i
        h = t * h
        End If
    Wend
    '方程求解成功， 返回
    nlnewtonA = True
    End Function


[ 本帖最后由 xzlxzlxzl 于 2014-5-9 09:42 编辑 ]

数学方程太复杂 我也没看懂 这完全是从书上调用的两个函数 不过还是非常感谢您的回复

谢谢您的回帖  主要vb也不太会 从书上调用的函数 谢谢哈