主题:[讨论]新手求助
juan2012
[专家分:0] 发布于 2013-02-16 16:55:00
用VB编一个求上述方程,其中Xmax1为变量,其它为常数十万火急,求各位大大们
最后更新于:2013-02-16 17:25:00
回复列表 (共4个回复)
沙发
老大徒伤悲 [专家分:29120] 发布于 2013-02-16 17:21:00
上述?
上面只有一个"发表时间:2013-2-16 16:55:00 [回复] ";
要是再往上就是"主题:[讨论]新手求助"了;
继续往上呢,就是"回 帖 快速回帖 发 新 帖 刷新版面"了.不知道你究竟说的那个?
板凳
老大徒伤悲 [专家分:29120] 发布于 2013-02-23 11:04:00
奇怪,不能回复?
3 楼
老大徒伤悲 [专家分:29120] 发布于 2013-02-23 11:04:00
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 楼
老大徒伤悲 [专家分:29120] 发布于 2013-02-23 11:05:00
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
我来回复