标题: [讨论]高斯消去法---这是用VB编的 [打印本页] 作者: god 时间: 2005-1-19 17:03 标题: [讨论]高斯消去法---这是用VB编的 Private Sub gauss_Click() '高斯消去法3 ~& ]8 c6 G) h
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single $ q5 ^- Z- W$ q- ~6 T, M! T5 Ui = 1: j = 1( K! S% g7 {: J8 [
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))3 W+ i* C8 k' D
ReDim Preserve a(1 To n, 1 To n + 1) : k. W% i5 V9 U4 F% ]; m* G9 S# z6 kReDim Preserve l(1 To n, 1 To n + 1)) B! w* Z& t8 N X& i5 j- d6 R
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single3 H& y2 g3 k' m# i8 w
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()0 [$ d H3 i, Z9 E3 Y
For i = 1 To n2 e j% }* |6 b1 {4 n
For j = 1 To n) o6 r4 s; ~; x/ c4 N0 v# M
a2(i, j) = a(i, j)) E( C* `0 B* e; X; W/ v
Next ) h; n% h }/ A$ yNext '将a()的值全部赋给a2()9 ?: g" |# G1 q e, r/ Q
m = 02 |+ @0 o. S, q9 p! S
D = 1 6 s6 m6 O9 [& X: ~2 S" hReDim x(1 To n) ( E) s C8 ?, ^% X9 kPrint "--------------------------------" % i# {; l8 r: t( JPrint "您输入的增广矩阵如下：" ; @! ^9 [' q" u1 JFor i = 1 To n, U! n" L& S0 P: C" `& t
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))+ H4 m3 E& \4 O' | G9 T) R
For j = 1 To n & j( D( }) A8 N" E$ K1 {a(i, j) = Val(Left(s, InStr(s, " "))) # k1 O7 I# e& x+ |0 As = Trim(Right(s, (Len(s) - InStr(s, " "))))3 I% [5 X9 Z$ @3 M
Print a(i, j); " C& @7 @( F3 o1 y9 VNext 8 H8 u. I1 E* H ha(i, n + 1) = Val(s) - @7 i o/ i, ]! K& v1 d; EPrint a(i, n + 1);0 Q! D# ~% X- k( Z( r' B& w+ D
Print7 p% h; I: d) e" @' D3 t
Next/ \2 G f$ D' R9 J6 v8 d: X
; p8 }5 J6 Q+ r, z+ bFor k = 1 To n - 1 '开始消元& _" s. e$ n' q4 v) Q9 F
If a(k, k) = 0 Then& n/ |1 H4 K+ d7 r$ O6 k- j. i6 N/ t& x
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！": D2 ~% V0 y+ l! q9 L5 Z g
Exit Sub : L. ]7 T5 B8 f: q4 a5 CElse 3 v$ w( G" f# f* F0 [1 w2 G( @7 z' tFor i = k + 1 To n( s1 U2 d- M( K8 l' Q" p
l(i, k) = a(i, k) / a(k, k)& w: D D. z0 M" c" S
For j = k + 1 To n + 1 * q) h7 E1 E/ C% B: v1 wa(i, j) = a(i, j) - l(i, k) * a(k, j)9 b& L. b8 q. t3 ?8 h9 e; Y, |
Next: U5 f n% Y1 Q
Next2 t& _8 O$ p+ }+ f
D = D * a(k, k)1 y9 y+ _0 A& a
End If+ u; `1 q4 ?8 E0 K+ Y
Next k '消元结束 : \; R/ `9 o3 L/ T x. L5 cIf a(n, n) = 0 Then " j3 @: r) G5 s* G; q! q4 S0 GMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"$ P' l! L# ?/ a7 `9 g/ O
Exit Sub) c3 \& B( S* P% I1 h* E. A
Else % _6 |$ l2 Z0 Y0 O+ {D = D * a(n, n)' _& `% B( T' f5 ]' |+ D
End If& K+ I- e) L: Z
Print "--------------------------------"1 o7 X2 x) p9 g: ]; @
Print "系数行列式的值是："; D* X; K; ?$ S' A) ^" [
x(n) = a(n, n + 1) / a(n, n) " ]6 R( ~7 b$ {# y" p2 iFor k = n - 1 To 1 Step -1 '开始回代- C- E0 t9 ~. l; o
For j = k + 1 To n ' _( m+ F- C9 E+ P* u# xm = m + a(k, j) * x(j), Q) y2 g8 E K3 k% h/ p
Next j $ ]# T! ]6 P# g! D* \x(k) = (a(k, n + 1) - m) / a(k, k)- S5 ]9 e' _6 N& q3 \+ d; c. G8 k" z
m = 0 \. Q4 x6 Z7 K: ~5 V" {+ XNext k '结束回代- `# N3 V% u, b2 q& t" q4 H3 b" c
) v! o" ^% b( Y$ m/ t
Print "--------------------------------") m$ k: h0 A# K" R% \7 i1 a, p* i8 A
Print "方程组的解如下：" 0 g8 b' R2 _" |- S4 C* u, G ! p. t1 G8 `+ F7 V! O& qFor k = 1 To n+ _8 B# j( D) B) g3 k, h7 N
Print 9 C# m/ s# E. j4 e$ HPrint "X(" & k & ") = " & x(k)$ l) z v$ ~' ]& P9 Y4 ^
Next k+ J5 J8 a H( @+ Z$ ]* [) k
Print "--------------------------------" 9 W3 t, Z7 |4 c) e1 @+ M$ lPrint "其中各行Ax-b=" 9 D3 U' R" O1 Y% zPrint 2 G% R6 l/ \/ l1 M$ V7 QFor i = 1 To n - D( q1 }3 p6 b, L* g0 At = 0: ]6 s% b: r/ ~ z5 h _/ v( w
For j = 1 To n % F) ~: @5 E" i6 Vt = t + a2(i, j) * x(j) ' q' A2 R+ q- {" I* }3 nNext j # a- O' ~. ?2 ~8 ?* ?% Qt = t - a2(i, n + 1) 8 T* B- z/ ?2 _: s% T- S' ^Print Spc(5); "第" & i & "行："; t6 t) _ j$ T# v( R
Print # x8 y* s' ^/ j: f' dNext i 7 _3 [ x& t5 U! m/ g * o% P7 W9 v; W/ z* E# wEnd SubPrivate Sub gauss_Click() '高斯消去法 y1 x! B! t& G0 W/ A& F
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single ' c+ {/ p a/ p7 li = 1: j = 1 3 y. ?5 [; T& H! Jn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))& v& j/ L8 }- D: |$ u- R
ReDim Preserve a(1 To n, 1 To n + 1)7 M1 h& Y3 N Q U8 a% d2 D$ M
ReDim Preserve l(1 To n, 1 To n + 1) 7 ~5 c7 d! j% k. n: r, S# MDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single $ l/ j7 t# Y' o1 L1 C2 VReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a() 5 H2 N/ n0 T2 \8 ~& aFor i = 1 To n6 `9 j8 m$ O* g6 K. p- X+ V
For j = 1 To n S% f% w" h, X9 F" M; p
a2(i, j) = a(i, j)- F$ ?& R( [5 l' ^/ ]( k' n
Next 0 p" L2 U$ V/ M2 m' XNext '将a()的值全部赋给a2() - V' b; P/ S+ g$ O/ ^m = 0" a) R8 M* Y. s, Z' p
D = 16 s6 C1 [1 H; K; F1 z7 @7 Q
ReDim x(1 To n) - [/ |: c9 z/ O' v7 n9 PPrint "--------------------------------" - S2 \$ X; R$ O! T7 L1 rPrint "您输入的增广矩阵如下："( Y5 E% x. o7 S( m! g' E& v. i
For i = 1 To n / d+ s, _" c6 g5 ws = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入")) " a7 x7 |) w% Y$ o: VFor j = 1 To n ' {5 d1 Q( `7 wa(i, j) = Val(Left(s, InStr(s, " "))) w) S; N* [8 P0 zs = Trim(Right(s, (Len(s) - InStr(s, " ")))) * q: x: Z( h1 a9 l2 |Print a(i, j); * G$ p d6 o. n% a; i, j" QNext% S; y: V! y1 y5 v7 {" ?0 ]
a(i, n + 1) = Val(s)6 `8 J5 v, g& H4 S4 B% k n
Print a(i, n + 1); ) y. w; D" q# m9 jPrint 6 d/ Y4 e8 I5 b8 ^. k: QNext; k2 f7 n$ W: Q! o* r- p
% d8 U; Q4 M+ }: G0 {' F5 E
For k = 1 To n - 1 '开始消元 , s% \) m5 U4 o' I# ]) I* }9 IIf a(k, k) = 0 Then 8 f! g4 E3 N; DMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！", n# `5 Y$ D- Z) _2 P. ~
Exit Sub* U1 @8 \' f# r( M2 l6 G
Else1 ~% E$ i+ j! D- m% X* `0 }
For i = k + 1 To n1 k2 t/ N* f4 S# j
l(i, k) = a(i, k) / a(k, k) 3 ?, @ G$ }; P, y8 kFor j = k + 1 To n + 1 : `& N0 B. b+ I& Qa(i, j) = a(i, j) - l(i, k) * a(k, j) . N! f+ }1 k( l9 { [0 m# g) BNext $ F. f1 B* w6 d+ U# N( v9 nNext ( \# T7 m% V5 t2 e! h* b4 o3 M. VD = D * a(k, k)& @8 d+ d0 T$ J7 `8 p' Z; g
End If1 n- ]1 p0 o$ v) G1 b% Q }( g
Next k '消元结束0 d0 V7 @5 n& g( y. Y1 I* s% X
If a(n, n) = 0 Then @% V4 W1 S5 g7 W$ P: ?MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！" ( P5 x$ O& L, zExit Sub % T6 F# Z7 e" s1 mElse0 p: f* V1 P1 Q! J: _, ]
D = D * a(n, n) - C1 X8 f: E8 S1 AEnd If % [' h4 g$ q3 n1 h0 KPrint "--------------------------------" / \6 s% ]' [ b. X6 GPrint "系数行列式的值是："; D9 W4 ?# Y) r: @+ J; P/ `+ u$ U
x(n) = a(n, n + 1) / a(n, n) 9 M8 Z1 s/ |, fFor k = n - 1 To 1 Step -1 '开始回代$ p$ m- G1 ^ ^4 j7 C- ?, v
For j = k + 1 To n 1 y) N/ r* D( h# t, fm = m + a(k, j) * x(j) + z" W& I @# k% W0 I% r2 z2 l2 HNext j9 f' [0 p& y$ J: W# W2 V1 C- h
x(k) = (a(k, n + 1) - m) / a(k, k)* v* g3 O% _" U: |7 w, u1 \! L2 ?
m = 0 5 S* f- W& d! JNext k '结束回代8 [) e; [3 {$ `2 i* u2 V$ y
1 _( V! g( k2 z9 @5 P. ]
Print "--------------------------------" % A! h S0 z( _) wPrint "方程组的解如下："$ Z o& K2 D7 L5 v- Z. W6 C! v9 _
: M: a! z2 B2 f* \$ Z8 JFor k = 1 To n& Y& Z- l! F }3 P# W
Print - e" x& o: ?, }5 y. E+ ZPrint "X(" & k & ") = " & x(k)8 g+ f; d" s% s
Next k/ B u& d0 S$ l9 Y8 X8 |) _! P V
Print "--------------------------------" . |& }0 e1 A( k W/ bPrint "其中各行Ax-b="9 e2 o9 U B) C
Print / \4 b# H3 b2 @1 h% nFor i = 1 To n : [ Z0 g! i& |t = 0( w+ c% Y8 l* _: P8 N
For j = 1 To n , b; P3 b) l2 x6 j% x ?. n" gt = t + a2(i, j) * x(j) % q" Q0 M W6 |6 cNext j $ a/ H$ Y; w) p$ J6 S6 pt = t - a2(i, n + 1) 5 v: \; m/ T8 K& c; N& G$ bPrint Spc(5); "第" & i & "行："; t& n, o4 [! A1 R4 {
Print ; s Z2 U. H% CNext i ; s+ F+ w( N4 M0 I $ {, u- d' A/ l8 oEnd Sub作者: ch123en123 时间: 2007-4-1 22:45
下载学习哦作者: lq12131010 时间: 2007-6-30 14:33
<p>您的程序我没看 但是我用FORTRAN 90 编过 </p><p>唯一注意的是高斯消法是有局限的 </p><p>1计算量大</p><p>2不能克服病态方程问题。</p><p>不知道您注意没有 </p><p>另我有FORTRAN 90 的选主元高斯消去法的程序。</p>作者: zqyzixin 时间: 2012-10-24 09:26
我也想了解了解！！！先顶一个