QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 17991|回复: 3
打印 上一主题 下一主题

[讨论]高斯消去法---这是用VB编的

[复制链接]
字体大小: 正常 放大
god        

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法
. M, D5 [! E* m; {7 A9 w  F5 PDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single3 a1 k- V3 S- x
i = 1: j = 1
; z; n) O4 n2 V0 h' Vn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
/ v; b3 M- F  ]# Q* Q* J+ nReDim Preserve a(1 To n, 1 To n + 1). y  i- Y9 m% S9 z' ]1 X+ _
ReDim Preserve l(1 To n, 1 To n + 1)
* P5 I" ?- P/ t$ N# C* `. B* ^Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
- Q. f; B: q, K% p0 oReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
5 a6 U( G4 Z2 Y* `% \/ B8 MFor i = 1 To n2 R! U) Z7 P6 P/ o, {8 {3 q) W1 p
For j = 1 To n6 \2 |3 g: f7 w! Z- A- q' J- u
a2(i, j) = a(i, j)
6 Y: S5 M- s/ @3 qNext/ C- D  x$ E: Q2 E  n
Next '将a()的值全部赋给a2()
. f" U) w1 M% [. Em = 07 Z* N5 l, Y- g& m' f" c4 l+ l
D = 1" R/ ~- C$ C* M$ M) s1 m$ Q4 @
ReDim x(1 To n)6 U7 D$ a/ n4 a' K. E* y9 F
Print "--------------------------------"2 R' j' `6 J( F& u& E2 ]
Print "您输入的增广矩阵如下:"/ i' ]% a4 ?- V# d" U9 G! Y
For i = 1 To n
$ y! f5 T; c1 V; h# X1 Rs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))1 N8 M. \5 T! @# e$ d) G3 U
For j = 1 To n
6 i: ^* _$ R& Z6 ma(i, j) = Val(Left(s, InStr(s, " ")))
4 V  o3 C& B, }' m" |. Qs = Trim(Right(s, (Len(s) - InStr(s, " "))))
& R) }4 p' S0 @& u2 m2 dPrint a(i, j);( O! ?) G. S( F, S
Next! F# H! ~( Q6 ^" g
a(i, n + 1) = Val(s)
3 e: b8 z, ?% ?6 F8 aPrint a(i, n + 1);$ O# o" M. g% J- g3 @( \- H( H
Print' W- }$ G/ V2 Y
Next
8 [3 A; q1 `1 J& V) r* R5 Q: F. t( j, K. e0 O
For k = 1 To n - 1 '开始消元
: t  n9 K2 ]* MIf a(k, k) = 0 Then
/ m* Y* }9 t; K$ x1 uMsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
4 G1 c: v; f( d) [Exit Sub
8 u9 G0 Y$ ~5 q( gElse% f% K5 M8 s- O  t8 `' t
For i = k + 1 To n
+ ?/ l" U* f  }l(i, k) = a(i, k) / a(k, k)6 p2 ^! ?* h( r8 Q( E0 A9 g# ]
For j = k + 1 To n + 10 A0 P; S7 R' u- J2 r
a(i, j) = a(i, j) - l(i, k) * a(k, j)
+ H) ~) I1 b0 x. JNext
) s* h- b/ h* NNext
5 X/ ~6 V$ ]; C5 v% D6 c* O& WD = D * a(k, k)) l9 H+ I/ O, o$ d3 T
End If% f  U) E# O) M: e
Next k '消元结束, E: Y: T1 M* B, z5 w" q% |3 T/ Y" a
If a(n, n) = 0 Then
0 Y0 I7 w& u# J3 S3 zMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"- c" L- v8 {+ L; {/ f* [4 h
Exit Sub
9 F2 D) \1 }! SElse/ z) |3 U$ B5 O0 r% ^& j" a
D = D * a(n, n)
' j7 N# f0 @/ c+ d# O1 r% nEnd If
/ l* D" O' D. \; r/ F6 W" `Print "--------------------------------"! }0 p( B+ o0 _" _6 F" h( o8 z' L" _0 F
Print "系数行列式的值是:"; D
4 |0 Y" `/ P9 l" mx(n) = a(n, n + 1) / a(n, n)5 {1 v' c+ ?/ y4 |
For k = n - 1 To 1 Step -1 '开始回代
+ y/ s& G% r- b) AFor j = k + 1 To n
0 l. `$ k5 z2 r- f# I8 c- um = m + a(k, j) * x(j)2 Q2 m' F) W0 k8 v  r
Next j) f) `6 Z8 L/ n% h7 g
x(k) = (a(k, n + 1) - m) / a(k, k)
7 C( h6 F7 q8 q7 Wm = 0" R) _, e* z' P# {" s6 M+ x
Next k '结束回代
) X, W8 p* [4 A" ?' O8 U/ H
5 v# e( s! V0 f7 z/ KPrint "--------------------------------"* s# B7 i! v- c! o8 n- \
Print "方程组的解如下:"
3 A7 P% I0 a) u7 ~
2 Z1 |8 |) k1 o9 J& g6 [' V  i/ NFor k = 1 To n, C- u, e5 \0 @. q' S/ M
Print" A/ D) ^7 e5 F" v2 G+ f
Print "X(" & k & ") = " & x(k)7 I" o! `' r1 \0 m9 p/ c
Next k) C5 U  F+ p* K; M# ~9 ?
Print "--------------------------------"0 E! g  N2 k/ i$ K; h" U$ B+ Y1 h. g
Print "其中各行Ax-b="
) h3 Q+ A. y) x# Z3 X) d! o( f+ aPrint
3 K! W* d8 M' ^- v0 L4 `/ e7 `For i = 1 To n* Z! ^" X6 f& Z# v# C
t = 08 r& Z7 |/ a" n) i& t/ [
For j = 1 To n4 ]0 a1 M) T! H
t = t + a2(i, j) * x(j)  ?9 H+ s7 [% ~. l9 M* T! i
Next j% L! _9 ]0 L  r: g
t = t - a2(i, n + 1)8 W$ z8 f' A" f# l( M0 A
Print Spc(5); "第" & i & "行:"; t* U8 ]% s. m% [1 o: J
Print# \% A5 m: G/ ?0 t1 p! B
Next i6 H; d$ N/ W# B! a1 D

/ Q& U- B/ Q7 ~9 v7 w3 eEnd SubPrivate Sub gauss_Click() '高斯消去法
$ c( M6 S9 Z) `4 T+ z( D. Z- S' QDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
/ c0 w! q( J3 F9 q0 Vi = 1: j = 1
0 f+ t# u3 ^5 W$ _/ o: Y* x; E- T" on = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
( ^* o; W5 p5 L2 f; ~: p& p9 [2 x7 wReDim Preserve a(1 To n, 1 To n + 1)2 M" v5 z" K: H" ]7 a8 z. j
ReDim Preserve l(1 To n, 1 To n + 1)! n8 R# R6 q$ o* f
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
) }. D* [/ D: j2 r2 WReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
% K# Q9 n: X) t. |9 t) t" N3 lFor i = 1 To n
3 S  t, B* H! g, C2 y- VFor j = 1 To n; D: P4 e( H8 P% v( M0 J5 c
a2(i, j) = a(i, j). q4 c5 B+ h7 Y1 ~6 `5 S
Next
$ b6 n0 p$ O  i; v2 l  K9 cNext '将a()的值全部赋给a2()# M- h9 O8 h! d% F# h) n% o
m = 07 {4 i8 H0 y2 ]: [% E
D = 1
9 D; W4 ]! O* ^. T! O! P* QReDim x(1 To n)
' O- c) X( G0 V+ kPrint "--------------------------------"
0 q. [+ w$ c- n3 u, g6 k: d6 {Print "您输入的增广矩阵如下:"8 ~. Q  g+ t0 }, U: \9 }
For i = 1 To n7 y) E3 C4 Q, v% B. @$ p
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
3 B% f# T& [' T+ U& ?( N- RFor j = 1 To n" Q6 K7 o9 s" {7 D0 D
a(i, j) = Val(Left(s, InStr(s, " ")))
. s0 t8 I' ?" W0 y! as = Trim(Right(s, (Len(s) - InStr(s, " "))))% B' C8 [6 ^$ K" N
Print a(i, j);# t( r. ?" U' Q; ~! r9 e, ~
Next. N8 p. {5 O7 G1 i9 h; F+ z) A6 J
a(i, n + 1) = Val(s)' |9 X; T* S4 m4 ^- q5 W
Print a(i, n + 1);5 ?# K+ x$ v2 N4 Q
Print( a  J( S2 `2 k2 z
Next
6 X! N  \8 b/ y$ c! r" p  N! t0 S  @
For k = 1 To n - 1 '开始消元
1 r1 u: r) [* {+ QIf a(k, k) = 0 Then2 O  S4 U: ~+ x$ h9 x7 _
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
, [6 L& P% B  |# yExit Sub6 ^9 T# A) A3 x2 h& D) D
Else
( E9 u9 s' J8 i$ b3 h2 vFor i = k + 1 To n( \6 x: b& c5 `) ]# M$ ~
l(i, k) = a(i, k) / a(k, k)9 r  o3 R6 j$ ]0 c1 g/ r9 F
For j = k + 1 To n + 1
3 _% }8 F. J5 ~( r! i. va(i, j) = a(i, j) - l(i, k) * a(k, j)' D3 g" }+ ]' f/ p# I: P& Y
Next. j3 Z- I6 T( J7 _, i; w/ b
Next
# L' z& Q2 T( l- N' d8 ^D = D * a(k, k)5 `5 S& [9 p) G' c; ]" A  j
End If4 ]0 T3 j# z' k2 c
Next k '消元结束
7 {/ B6 O! f* \! y# ]. s7 }If a(n, n) = 0 Then
3 _. V  C$ o9 z; [: D, G3 ?2 SMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
8 y, E7 T4 [% O) rExit Sub( ], ~' }8 D: R' A0 x4 @+ h, j; U
Else1 j7 q  U& @+ u$ N* J5 t
D = D * a(n, n)
, I# L; S4 g& `: D: wEnd If
( q3 t0 T9 O7 C, ]% n  wPrint "--------------------------------"
9 r2 |5 O- {6 ^1 iPrint "系数行列式的值是:"; D
% j. R$ R0 `' d% q' Ox(n) = a(n, n + 1) / a(n, n)
9 A5 {+ d; q4 \For k = n - 1 To 1 Step -1 '开始回代4 \) o6 Z% {3 k7 V+ G6 M
For j = k + 1 To n
: [' @( M( `8 f& |8 ^m = m + a(k, j) * x(j)2 x6 ^8 ]0 J+ y0 m  ^- O; V2 b
Next j+ q3 \- _* a4 a- e5 W' P" |
x(k) = (a(k, n + 1) - m) / a(k, k)* ^& B3 w4 N1 z# S' Z( x
m = 01 [8 K: d5 x( D2 L3 \
Next k '结束回代% Y# i% e* t3 |. n2 m

5 G4 K( u, w! s! ^. o! Z$ @Print "--------------------------------"3 F6 ^7 e: F# H$ y+ i0 O% Z3 a/ J
Print "方程组的解如下:"7 a1 h' u! p, W! q* ]: @
1 z2 P7 c2 }& x' O& v: q$ d; |
For k = 1 To n8 l# Y  `' d+ a& R. ?" T
Print
; a- K% k# c5 l! Z5 d' z. bPrint "X(" & k & ") = " & x(k)
* B/ j+ Y  B9 U$ Q  p. K" zNext k5 q/ x& R. u$ k9 Y
Print "--------------------------------"3 F8 G: P2 p* t" y& y2 }  `( q
Print "其中各行Ax-b="& q- q4 X% H) I8 Z/ L+ E
Print
8 x0 {4 H! {$ r# ]6 q- IFor i = 1 To n' }& {1 U& c4 @0 [' s  \# d
t = 0
# B1 W  N$ |# \5 m+ tFor j = 1 To n
# f, x) ^, N+ z- M. {t = t + a2(i, j) * x(j)
5 O  I6 Y3 T) d% @  }( FNext j
0 x' Q' y6 j9 Ft = t - a2(i, n + 1)
$ q' R8 Q% Q* h. O1 V/ Y3 V( Y# ePrint Spc(5); "第" & i & "行:"; t
- H# g  ^1 X/ K! n8 e/ sPrint! e4 f7 S1 S+ w# a$ ^1 P2 G
Next i; ~- n9 H9 H' h3 x7 m+ O% [

5 w  D" K  w* L  O! s* t+ {* iEnd Sub
zan
转播转播0 分享淘帖0 分享分享0 收藏收藏0 支持支持0 反对反对0 微信微信
如果我没给你翅膀,你要学会用理想去飞翔!!!

0

主题

3

听众

22

积分

升级  17.89%

该用户从未签到

新人进步奖

回复

使用道具 举报

0

主题

3

听众

24

积分

升级  20%

该用户从未签到

新人进步奖

<p>您的程序我没看&nbsp; 但是我用FORTRAN 90 编过 </p><p>唯一注意的是高斯消法是有局限的 </p><p>1计算量大</p><p>2不能克服病态方程问题。</p><p>不知道您注意没有 </p><p>另我有FORTRAN 90&nbsp;的选主元高斯消去法的程序。</p>
回复

使用道具 举报

zqyzixin 实名认证       

1

主题

5

听众

1818

积分

升级  81.8%

  • TA的每日心情
    难过
    2013-10-14 10:21
  • 签到天数: 78 天

    [LV.6]常住居民II

    社区QQ达人

    群组小草的客厅

    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册地址

    qq
    收缩
    • 电话咨询

    • 04714969085
    fastpost

    关于我们| 联系我们| 诚征英才| 对外合作| 产品服务| QQ

    手机版|Archiver| |繁體中文 手机客户端  

    蒙公网安备 15010502000194号

    Powered by Discuz! X2.5   © 2001-2013 数学建模网-数学中国 ( 蒙ICP备14002410号-3 蒙BBS备-0002号 )     论坛法律顾问:王兆丰

    GMT+8, 2026-7-18 10:01 , Processed in 0.468010 second(s), 68 queries .

    回顶部