数学建模社区-数学中国

标题: [讨论]高斯消去法---这是用VB编的 [打印本页]
作者: god    时间: 2005-1-19 17:03
标题: [讨论]高斯消去法---这是用VB编的
Private Sub gauss_Click() '高斯消去法
$ [1 o% L4 I# Y. D9 O; r& N( E" IDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
/ W: P; v" j- s7 K6 V; Wi = 1: j = 18 Z0 x! C2 E7 {2 g  H
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))0 \. d0 {) n, C- E, `0 S" o
ReDim Preserve a(1 To n, 1 To n + 1)
; R# m: \1 }$ v# ^# v& AReDim Preserve l(1 To n, 1 To n + 1)
* G: l0 ^. K8 h# qDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single3 u" c2 p9 S- [8 Y0 }7 W
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
$ Q+ E  q! ~6 x  p* }* S& k  P7 \For i = 1 To n
9 W2 e% _9 I/ d7 O+ [For j = 1 To n# g+ Q5 l, g; H6 V- d2 |0 h
a2(i, j) = a(i, j)5 S  V- ~( s" F* H/ e
Next
7 e& B6 C# v$ z0 O7 |Next '将a()的值全部赋给a2()7 l4 D6 {7 Q1 J* C9 g- N! V
m = 0' A6 p* J( q  U
D = 1/ M8 I' q: o7 G: A2 y$ t
ReDim x(1 To n)
7 Y) w, M( |5 l( oPrint "--------------------------------"2 ]* L6 N" z4 r2 O; j
Print "您输入的增广矩阵如下："
: k$ e- y) b  G4 V6 ]4 J) x/ HFor i = 1 To n  `1 P8 v7 W) x4 k, F' n! p& U
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
3 r( U- w+ f) XFor j = 1 To n8 M" V0 t" x; u- R6 u' K/ L. v' _
a(i, j) = Val(Left(s, InStr(s, " ")))
9 U* w" k; g/ r( Q) ks = Trim(Right(s, (Len(s) - InStr(s, " "))))
% m$ X7 s" V( \  P$ _2 H+ uPrint a(i, j);  ~+ |- ^% ]% P1 r% ]4 Z2 ~* E- L" I+ J
Next2 z  o. P$ A: S; l( D, _5 l
a(i, n + 1) = Val(s)
* h/ k/ Q( Z8 }# dPrint a(i, n + 1);; d  g( @4 N; I! U5 x4 _8 e& |' j' g
Print$ F+ S9 [& d( Q+ n1 G
Next7 T- j/ g1 {$ ^* |! u
( c5 w% I4 w+ z6 I4 j8 v: g" a9 F
For k = 1 To n - 1 '开始消元+ p& _) x+ i7 x0 v- Z/ r
If a(k, k) = 0 Then! F: h3 @/ j" p
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"( k# _8 V: o; z; U6 Y" b; U% @3 N
Exit Sub6 E2 X( l8 R& p$ r0 o5 w
Else! n9 p* w/ a# C0 Q+ y" O* Y8 ?
For i = k + 1 To n
% ?( u, D: q* P% }l(i, k) = a(i, k) / a(k, k)
: S& J/ M, j0 i/ e. lFor j = k + 1 To n + 1
3 P: z1 T7 ^; E# h7 P, k; G1 Da(i, j) = a(i, j) - l(i, k) * a(k, j)2 q5 N. a7 W% d/ M: a7 y
Next
7 ?3 t- R% _6 J  f- PNext  u. [) O, ~# B7 ?" [
D = D * a(k, k)
, X2 `7 }, }' h( Z% u- KEnd If6 z$ }2 d( ?+ U, Z& j- p
Next k '消元结束( K' f( A, ]+ S% s- A- v6 ^; {
If a(n, n) = 0 Then" `; I  S' B2 W
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
+ p4 ?" x' M# u4 TExit Sub
) [8 {- C7 s/ R6 B1 |( s7 ]+ lElse
  C' |  o+ [: j( d, AD = D * a(n, n)
2 b( p& y# U" l9 b* r% j- _# M4 @( ?End If
. q0 k$ c( t8 L3 |% J, p$ dPrint "--------------------------------"
# P0 e& {# W# P: [7 O' o& {Print "系数行列式的值是："; D
; s! g" x4 T8 g/ t$ [; J5 t2 Qx(n) = a(n, n + 1) / a(n, n)" C( F% X' G( v& z( i% G- _. K
For k = n - 1 To 1 Step -1 '开始回代
# d! v. r, f2 k- _- z5 HFor j = k + 1 To n
; f. z2 D! Y1 Jm = m + a(k, j) * x(j)
' o9 A, w( Y- h9 c" ]* g6 gNext j( ^5 D7 i& }  v7 y% y
x(k) = (a(k, n + 1) - m) / a(k, k), X9 t/ r6 O0 M! N) m6 J6 K: s
m = 0
! [- c1 Y; p. o3 }% ENext k '结束回代$ f# u4 t* ~( V1 E  E

6 I4 w  z+ e7 L7 p" PPrint "--------------------------------"3 w* F8 ^4 ?5 d
Print "方程组的解如下："
' D# w& o4 k  }" y% k
  Z' o" |4 C! C# AFor k = 1 To n
. r3 @2 x- R% F) p8 \3 a9 cPrint
" n# G( C! ]! @* M0 wPrint "X(" & k & ") = " & x(k)
# Q/ d/ s7 E; q( s; ]& PNext k
, `. F: |# H& T8 m4 D+ T1 ~" UPrint "--------------------------------"& f: J2 g4 r8 c$ y
Print "其中各行Ax-b="
8 Q" D) ]; y9 {5 c$ ]$ K2 KPrint& g0 g- O' R" n) L! t9 Y3 |( C7 ?7 C
For i = 1 To n
3 b0 s# w% D& {1 B+ mt = 0
1 ~1 ?7 h% C: EFor j = 1 To n
' @9 e( P. S+ e" Xt = t + a2(i, j) * x(j)* W0 i3 u( M0 X9 b, m' q
Next j
2 f  n, i. _- r$ |3 ht = t - a2(i, n + 1)0 W! l: S5 _# b
Print Spc(5); "第" & i & "行："; t( Q- e5 H* m9 _3 Z" N; I
Print# L: h4 ~. }6 s+ ]3 k& U
Next i) t6 [9 a4 p6 Y8 o
; y& V/ @* ?; {" X9 z( A. C- t
End SubPrivate Sub gauss_Click() '高斯消去法
8 r$ L4 Q  B: X; M( f! @Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
8 G* Q/ h+ Q6 M; w3 v3 Ai = 1: j = 1# J# s- ^( D9 Z/ D6 X  ?5 D
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
. @( O- @+ S) c& ]0 e0 JReDim Preserve a(1 To n, 1 To n + 1)
5 \4 }  g2 M% Y0 u* B5 lReDim Preserve l(1 To n, 1 To n + 1)1 ?% P1 n5 F6 Z4 E& S
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
" r! E  b/ u! S2 LReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
; q6 W9 R' x/ QFor i = 1 To n5 k0 B# e0 l! s: x  N0 _
For j = 1 To n# l4 C1 F- {. B% d. p! J
a2(i, j) = a(i, j)
* C5 M8 B4 X- u0 A" |* U% G# wNext
8 B9 o4 Y% Y  G1 o/ YNext '将a()的值全部赋给a2()! d6 x6 b9 a4 ?
m = 0( k) I/ K5 q7 b# A/ I
D = 1' G$ |7 d3 g. Q" w+ f7 w
ReDim x(1 To n)5 `3 d! [4 |& F% y# N, I8 g9 w
Print "--------------------------------"" _. L- P4 n/ e7 M
Print "您输入的增广矩阵如下："
, g3 F: Y, Z+ f+ b. oFor i = 1 To n6 v: C+ g% q4 m0 ^3 I: g. s, l
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
, j' i9 z3 z' yFor j = 1 To n
5 p& M: y0 V/ o- N1 Ta(i, j) = Val(Left(s, InStr(s, " "))): Z; N, ?9 p1 I- V" i/ n
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
5 Y% V; ], `! _( PPrint a(i, j);  C% c4 A5 e* M
Next
& V3 _2 ^% O" F3 J0 Xa(i, n + 1) = Val(s)
3 s- U  O( R1 J# hPrint a(i, n + 1);1 ?! J  @/ t& Z& @) V& [
Print
' J6 ]5 c) ]% A+ f+ g$ E! x5 [Next
. U5 Y1 s; O' Y4 H# S, n8 |/ u) z0 c, g1 S5 n
For k = 1 To n - 1 '开始消元0 w' i- [0 s1 i. F5 S+ F* v" k
If a(k, k) = 0 Then) V( e' V5 U! Q( C
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
9 `3 B$ T0 s2 q  O2 }" k+ E1 lExit Sub
5 M/ ?% R6 k3 g' a: T9 WElse
+ t9 k- r; Z  O) Q0 `For i = k + 1 To n
2 O. A. N9 U. W! ?, e& `l(i, k) = a(i, k) / a(k, k), S) f' S, `* m8 l
For j = k + 1 To n + 13 J# t, D# V5 g% V% o
a(i, j) = a(i, j) - l(i, k) * a(k, j)
* S. X$ O! ]! S; j5 I$ V! D3 SNext
/ A; W4 h4 p* s- G- o! |$ d, }Next' ^: v7 W9 D' @
D = D * a(k, k)/ T8 t1 t3 a" L- B1 Z
End If  t: H( W' z3 r1 u3 F
Next k '消元结束
; x. y  D/ [) S  MIf a(n, n) = 0 Then
& X; P. G8 a0 k; P5 _9 HMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"2 m& o( h- [% x* D" c( Z1 Q
Exit Sub
4 j, x. n) \) ~+ ^' dElse
1 c- c2 p% C9 b2 ~# ]2 OD = D * a(n, n)
. G" W. Z' w9 Z5 u( REnd If3 M0 M4 b* m. A% l4 B3 x
Print "--------------------------------"
6 L7 y% J  x3 HPrint "系数行列式的值是："; D: p+ a0 W# t( s& P- h9 h
x(n) = a(n, n + 1) / a(n, n)
8 {, Y1 s' V( f7 l- r7 GFor k = n - 1 To 1 Step -1 '开始回代/ s2 Q0 U% q$ x
For j = k + 1 To n$ r1 A$ s! D9 m3 ^! W3 F9 j
m = m + a(k, j) * x(j)6 h* l0 X% ?% ^- F% @/ I9 o( G
Next j
' x# b9 Q/ n+ p$ Ix(k) = (a(k, n + 1) - m) / a(k, k)
8 V/ T' j4 s$ v$ u; o3 Km = 0
, @5 u" X4 m3 x* D5 ^4 g8 u; [1 eNext k '结束回代( r) u" ?6 r- ~% C. O8 K8 A
$ _; B9 @, h& b$ C" p
Print "--------------------------------"
" I. n' ?/ p7 IPrint "方程组的解如下："9 ^1 r' C9 v$ \

/ K- c- _9 O5 j9 y' WFor k = 1 To n
% p& l4 q4 S- L; s$ M( sPrint
; G  F& ?6 b( }6 c1 Z! ]Print "X(" & k & ") = " & x(k)
0 d7 G" o% E5 @: E$ cNext k
/ j2 c3 p. l# o; w9 ]0 P, |Print "--------------------------------"
6 I% Z1 {9 d' @Print "其中各行Ax-b="
2 h* c% z5 T* D- uPrint% v0 r# `$ n5 r( e6 M5 W
For i = 1 To n5 U% E" c, c+ F9 u+ s; e0 o# |' Z
t = 0
" j9 F- x" U: y% lFor j = 1 To n
9 i: \8 r( W" b+ N( h0 tt = t + a2(i, j) * x(j)0 X* t* `. E" B5 m) A* D! U. ?
Next j; F- q% ~5 Q1 \) Y7 X# v
t = t - a2(i, n + 1). D$ V, j5 d; W' Y
Print Spc(5); "第" & i & "行："; t5 T) W# T! B7 P- c
Print1 b* ]8 g6 N7 u4 z1 [4 c
Next i
  d/ y6 b* N! M1 O$ O& e+ Y
% b- H. i3 I3 a0 FEnd Sub
作者: ch123en123    时间: 2007-4-1 22:45
下载学习哦
作者: lq12131010    时间: 2007-6-30 14:33
<p>您的程序我没看&nbsp; 但是我用FORTRAN 90 编过 </p><p>唯一注意的是高斯消法是有局限的 </p><p>1计算量大</p><p>2不能克服病态方程问题。</p><p>不知道您注意没有 </p><p>另我有FORTRAN 90&nbsp;的选主元高斯消去法的程序。</p>
作者: zqyzixin    时间: 2012-10-24 09:26
我也想了解了解！！！先顶一个



欢迎光临 数学建模社区-数学中国 (http://www.madio.net/) Powered by Discuz! X2.5