admin 管理员组文章数量: 1087139
2024年1月23日发(作者：check18)
计算方法VB源代码000000
Private Sub Command1_Click()Dim n As Integer
000000
000000
000000Dim yi() As Single, xi() As Single, li() As SingleDim y0 As Single, x0 As Singlen=10
00000x0=Val(InputBox("输入要求点的x值"))y0=0.0000000
00000ReDim yi(n)ReDim xi(n)ReDim li(n)000000For i=1 To n
000000Yi(i)=Val(InputBox("输入第"&i&"个插值点的y值"))xi(i)=Val(InputBox("输入第"&i&"个插值点的x值"))00000
000000Next i
000000For i=1 To n
li(i)=1Next i000000
For i=1 To n
For j=1 To n
If i<>j Then li(i)=li(i)*(x0-xi(j))/(xi(i)-xi(j))Next jNext i000000
000000For i=1 To n
Next i000000y0=y0+li(i)*yi(i)Print "y0=";y0
000000
End Sub
000000
Rem 二分法
000000
000000Private Sub Command1_Click()Dim x1,x2,X,y1,y2,y,eer80 x1=InputBox("x1")x2=InputBox("x2")
y1=f(x1)y2=f(x2)
000000
000000
000000
000000
000000If y1*y2<0 Then
Goto 100Else
000000
000000Print("重新输入x1和x2")End Ify=f(x)000000
100 x=(x1+x2)/2
000000If Abs(y)<=0.000001 Then
Print("函数根为");x Print("y=");yElsex2=xy2=yIf y1*y<0 Then
00000
00000
000000
000000Goto 100Else
x1=xy1=y000000
000000Goto 100End If
End If
000000
End Sub
000000
Public Function f(x)Dim yf=y
REM 牛顿迭代法
x0=1x=x0
y=x^2-4*x-1
End Function
000000Private Sub Command1_Click()000000
000000Do Until Abs(x^3-x-1)<=0.
f=x^3-x-1g=3*x^2-1x0=x-f/gLoop
000000
Print("x0=");x0End Sub
000000REM 高斯消除法求解方程组
Dim i,j,m,n As Integer
Dim a(),z(),x(),wn=InputBox("n")For i=1 To n000000
Private Sub Command1_Click()
000000
00000
000000ReDim a(n+2,n+2),z(n+2,n+2),x(n+1)000000
For j=1 To n+100000 a(i,j)=InputBox("a")00000
Next jNext i000000
000000
For i=1 To n w=a(i,i) For j=1 to n+1 Next j000000 a(i,j)=a(i,j)/w
000000if i=n Then Goto 100For j=i+1 To nFor k=i+1 to n+1000000
00000 z(i,k)=a(i,k)*a(j,i) Next kNext jNext i100000000 a(j,k)=a(j,k)-z(i,k)
000000
x(n+1)=0s=0000000For k=n To 1 step-1
For j=k+1 To n Next j000000 s=s+a(k,j)*x(j)
x(k)=a(k,n+1)-s Next k
00000 Print"x";k;")=";x(k)
End Sub
000000REM Jacobi迭代源程序Dim n As Integer
000000
Private Sub Command1_Click()
Dim a(),y(),g(),b(),X1(),X2()n=Input("方程维数");ReDim a(n+1,n+1),y(n+1)Dim s,eer,t
k=0For i=1 To nX1(i)=1X2(i)=0Next i000000
000000
ReDim g(n+1),X1(n+1),X2(n+1),b(n+1,n+1)00000
000000
For i=1 To nFor j=1 To nPrint"输入A()";i,jNext jNext i000000a(i,j)=InputBox(a(i,j))
y(i)=InputBox(y(i))For i=1 To nNext i000000 g(i)=y(i)/a(i,i)For i=1 To nFor j=1 To n b(i,j)=0 Else
If i=j Then
000000
000000 b(i,j)=-a(i,j)/a(i,i) End IfNext jNext i000000
000000
00000050 eer=0000000For i=1 To n000000
eer=eer+Abs(X1(i)-X2(i))Next i
If eer<0.0001 Then
Goto 100Else
000000For i=1 To n X1(i)=X2(i)Next iEnd If
s=
000000
000000For i=1 To nFor j=1 To nNext jNext ik=k+1100
000000 s=s+b(i,j)*X1(j) X2(i)=s+g(i)
000000
Goto 50
For i=1 To n Print X2(i)Next iPrint "k=";kEnd Sub
00000
REM 高斯-塞迭尔 Gauss-SeidelPrivate Sub Command1_Click()Dim y(),t(),g(),X0(),X1(),kDim s,b(),a(),err00000
000000
Dim i As Integer,j As Integer
000000
Dim n As Integer00000
0000000n=Input("请输入n=")
For i=1 To nX0(i)=0Next iX1(i)=X0(i)000000ReDim y(n),t(n),a(n,n),X0(n),X1(n),b(n,n)000000
000000
For i=1 To nFor j=1 To nPrint"输入A()";i,jNext jNext i000000a(i,j)=InputBox(a(i,j))
y(i)=InputBox(y(i))For i=1 To nNext i000000 t(i)=y(i)/a(i,i)For i=1 To nFor j=1 To n b(i,j)=0 Else
If j=i Then
000000
000000 b(i,j)=-a(i,j)/a(i,i) End IfNext jNext ik=0Do000000
000000
000000
k=k+1s=0000000For i=1 To n
For j=1 To nNext jNext ieer=0000000
s=s+b(i,j)*X1(j)X1(i)=s+t(i)
00000
For i=1 To nNext i000000 eer=eer+Abs(x1(i)-x0(i))
For i=1 To n X0(i)=X1(i)Next i00000
000000Loop Until eer<=0.01For i=1 To n Print X1(i)Next iPrint "k=";kEnd Sub
000000
00000
000000
0 0
00 0
版权声明：本文标题：计算方法VB源代码[整理] 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://roclinux.cn/p/1705987303a496809.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论