回 帖 发 新 帖 刷新版面

主题:[讨论]新手求助

用VB编一个求上述方程,其中Xmax1为变量,其它为常数十万火急,求各位大大们

回复列表 (共4个回复)

沙发

上述?
上面只有一个"发表时间:2013-2-16 16:55:00 [回复] ";
要是再往上就是"主题:[讨论]新手求助"了;
继续往上呢,就是"回 帖 快速回帖 发 新 帖 刷新版面"了.不知道你究竟说的那个?

板凳

奇怪,不能回复?

3 楼

Dim n As Single, n1 As Single, x0 As Single, c As Single
Dim X0max As Single, Xmin As Single, e As Single

Private Sub Command1_Click()
    Dim x As Single
    n = Val(Text1)
    If n = 0 Then
        MsgBox "你没有输入η,或者η的输入无意义。", vbExclamation, "一个超越方程的牛顿迭代法"
        Text1.SetFocus
        Exit Sub
    End If
    x0 = Val(Text2)
    If x0 > X0max Then
        MsgBox "你输入的X0超出了可能范围,会导致方程无意义。", vbExclamation, "一个超越方程的牛顿迭代法"
        Text2.SetFocus
        Exit Sub
    End If
    e = Val(Text3)
    If e <= 0 Then
        MsgBox "你输入控制精度无意义。", vbExclamation, "一个超越方程的牛顿迭代法"
        Text3.SetFocus
        Exit Sub
    End If
    n1 = 1 + n
    Xmin = 1 / n1                                           '最小有定义域的x值
    c = Log(1 - n1 * n * x0) - n1 * x0                      '方程右边的常数
    x = Xmin + e                                            '初始点选在Xmin+e
    i = 0
    Do
        i = i + 1
        y = 函数(x)                                         '利用X和X+e函数值连线近似X点的切线
        ye = 函数(x + e)
        DeltaX = (ye + ye - y) / (ye - y) * e               '用点斜式计算计算切线与X轴交点
        x = x - DeltaX
    Loop Until Abs(DeltaX) < e                              '交点与上次计算点误差小于e,该点为解,否则在该点重复迭代
    Label4 = "方程的解大约为:" & x & vbCrLf & "    这是经过" & i & "次迭代得到的" & vbCrLf & "    最终误差小于" & DeltaX
End Sub

4 楼

Private Function 函数(x As Single) As Single
    Dim x1 As Single, x2 As Single
    x1 = n1 * x
    函数 = Log(1 + x1) - x1 - c
End Function

Private Sub Form_Load()
    Me.AutoRedraw = True
    Me.Caption = "一个超越方程的牛顿迭代法"
    Picture1.Move 60, 30, 340, 27
    Picture1.Appearance = 0
    Picture1.BorderStyle = 0
    Picture1.Picture = LoadPicture(App.Path & "\fangchengshi.jpg")
    Command1.Caption = "确定"
    Label3.ForeColor = vbRed
End Sub

Private Sub Picture1_Click()
    Picture1.Print "ok"
End Sub

Private Sub Text1_Change()
    Label3 = ""
    Label4 = ""
End Sub

Private Sub Text1_LostFocus()
    On Err GoTo 出错
    n = Val(Text1)
    X0max = 1 / n / (n + 1)
    Label3 = "在η为" & n & "时," & vbCrLf & "X0最大值为:" & Format(X0max, "0.#")
    Exit Sub
出错:
    Label3 = "你输入的η不合法!"
End Sub

Private Sub Text2_Change()
    Label4 = ""
End Sub

我来回复

您尚未登录,请登录后再回复。点此登录或注册