数学建模社区-数学中国

标题: [讨论]高斯消去法---这是用VB编的 [打印本页]
作者: god    时间: 2005-1-19 17:03
标题: [讨论]高斯消去法---这是用VB编的
Private Sub gauss_Click() '高斯消去法2 }: _6 |% l4 m. [1 v- X
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single0 u' ?/ O! S! c; F) I' S/ m- b
i = 1: j = 1
9 a* A. O) P! D$ f, C4 w' Z* |n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
) `. R9 v4 d; ^ReDim Preserve a(1 To n, 1 To n + 1), f3 m. M0 N( k' T1 Q! p& \* Y. s
ReDim Preserve l(1 To n, 1 To n + 1)+ p$ t+ F, ]! S$ S, L" J
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single8 s9 C8 {+ w: Y; ?: R! c9 B
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
. z  |1 I9 e4 @) s; v" _% n3 [: DFor i = 1 To n
) E( g$ X( O7 i* v1 ?For j = 1 To n
$ S$ ?" T2 W( [9 l9 F& \) Ha2(i, j) = a(i, j)5 V2 w* N/ a7 _
Next: L9 M; S* p: E1 u
Next '将a()的值全部赋给a2()
9 F# m: P4 t( ]5 R" f. w" Cm = 0
' M) j4 w; z* F, S% UD = 1% C+ o: U+ h: h$ ~2 t' F
ReDim x(1 To n)
# B! R0 r' A) f: H" l6 @6 ?Print "--------------------------------"% l8 |# I) S- d8 D; G: A
Print "您输入的增广矩阵如下："
; P' \/ s3 k7 o( ?2 JFor i = 1 To n
0 k- M$ [) E  f# es = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
- Z+ [6 w* i. l* H/ XFor j = 1 To n1 F2 D3 A0 z7 {% I6 k
a(i, j) = Val(Left(s, InStr(s, " ")))
1 f1 ^( \+ g' Ss = Trim(Right(s, (Len(s) - InStr(s, " "))))
# \- t1 u( f2 R% [' ?Print a(i, j);0 j3 [6 ~1 a+ F9 w% y
Next) N) X& J3 g/ J
a(i, n + 1) = Val(s)  y8 n% ~- r7 J  B. E4 J" C- ?
Print a(i, n + 1);/ ]. f  [* [( K8 g" B  Z
Print( I; Z) \+ i3 |& a4 s$ J. ?
Next$ H+ P& F; g7 J3 G# ]

' q# h2 }* d1 k' eFor k = 1 To n - 1 '开始消元
7 o+ \8 g, x: e1 fIf a(k, k) = 0 Then5 V+ u2 e8 t8 e, `! t
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"' Z! |6 o" S0 u5 ^
Exit Sub  S8 E6 l+ d( F. r
Else
1 H0 P, P& l' z7 L4 [. s2 ?For i = k + 1 To n
' Y2 X, d1 r9 K0 F. Nl(i, k) = a(i, k) / a(k, k)
& u# g$ y9 E8 Z& R% D2 uFor j = k + 1 To n + 1
% ~& |. j) [6 z% v1 X9 Za(i, j) = a(i, j) - l(i, k) * a(k, j)
( S7 v7 x. I! H4 FNext5 A( N3 k6 I( |
Next
% d, C6 R8 l0 B0 lD = D * a(k, k)) F/ t( D+ d+ o4 B& {, z- N: ~9 [9 P
End If0 q2 ~# V2 H% t
Next k '消元结束
1 b! X* g2 h$ iIf a(n, n) = 0 Then1 |4 ]6 w% ?! @4 v2 b. M
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"" [! q) x, \" j1 u7 E6 s- d
Exit Sub
6 `! W$ {9 R" l! oElse
8 t% O- \; H! v# Y/ a& q2 f6 ^# R* fD = D * a(n, n)
2 F/ T) n# F8 j7 bEnd If
' j& R6 J1 u; F2 j5 APrint "--------------------------------"
' [- Y4 C1 E8 }4 R& UPrint "系数行列式的值是："; D) B: \8 E  V' r  P6 B/ ^- D- m
x(n) = a(n, n + 1) / a(n, n)- _0 ^0 p& g6 x6 F2 K
For k = n - 1 To 1 Step -1 '开始回代8 _, \( i$ U, c+ y
For j = k + 1 To n6 d/ Q5 N: ]- _9 h# m2 U4 D
m = m + a(k, j) * x(j)( Q& U3 Z6 Y" M
Next j, [7 H7 w, G* q$ N' n) e0 X
x(k) = (a(k, n + 1) - m) / a(k, k)' h" f7 ?% v8 q
m = 0
+ x7 o( Z9 w: y- Q9 |Next k '结束回代
1 h; }# A. W: b* V$ w, q9 e! _# `% r& u& W
Print "--------------------------------"/ K# c4 O8 u  [& h
Print "方程组的解如下："
  i9 U/ @! j" y/ K/ Q+ L2 D( O% ]! T, t& j9 `
For k = 1 To n* j5 M- R8 @+ I/ s, b& X
Print
, D4 X; s' W% l6 A9 E* ]  pPrint "X(" & k & ") = " & x(k)9 T3 J9 \) W& n+ I- |3 Q
Next k
. |# X4 O7 E9 `2 b: e% RPrint "--------------------------------"
3 J# W! M" N0 I. o: r- E5 CPrint "其中各行Ax-b="
- P7 q1 i) b2 a( |  A0 m( g( gPrint
2 [6 L9 N8 |& y  T1 z3 f9 VFor i = 1 To n3 b% \$ @5 ]& I8 d
t = 0
2 x, ~" B9 A  R: \& ~0 k/ dFor j = 1 To n# [/ C  f8 u0 M5 u+ S
t = t + a2(i, j) * x(j)
4 J, z3 ]+ ]$ U& {# mNext j
7 B: ]" ~, ^9 k) y0 F8 gt = t - a2(i, n + 1)5 c- n( Q- p# L
Print Spc(5); "第" & i & "行："; t4 k6 ^: k9 K# z, C' Z4 u9 }
Print
' |& p% i8 V8 o8 ANext i1 f) T) M4 S  i- S7 }8 a% R4 o& D- Z
% K: R, N$ i1 V
End SubPrivate Sub gauss_Click() '高斯消去法
# |0 u9 f( b% NDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
) F4 i6 Z- \6 u9 u, o9 xi = 1: j = 1
/ Y$ D/ k1 e. |+ p+ n3 gn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))6 B: B5 @* R8 R( r) _
ReDim Preserve a(1 To n, 1 To n + 1)
& e8 E" L0 V6 [9 uReDim Preserve l(1 To n, 1 To n + 1)6 d  a' F, Y; T
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
2 h! a: @2 Y# B) }  ^  q. S! cReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()1 E3 i. L* v" k! O2 c2 ~
For i = 1 To n
8 U  g1 Z* a  F4 b% T( K& oFor j = 1 To n
4 B6 X5 m% K- J9 d- X  wa2(i, j) = a(i, j)( i5 _$ u" c  C
Next" y  N& `7 @+ c
Next '将a()的值全部赋给a2()
" I& }4 h1 f0 G# ]# H, pm = 05 l" U1 |: |( q# w
D = 1
4 N$ H) W, p+ X* ^4 G' X5 yReDim x(1 To n)
$ N( F1 S# c5 _4 q2 z& O0 tPrint "--------------------------------"
$ T" s- m# k) _% `8 I2 JPrint "您输入的增广矩阵如下：", N4 `9 ~% L. \* R3 e
For i = 1 To n+ o( N' L4 W- |* W. N9 M% b
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
$ B% R: t9 P& ^9 e0 e, D) M- QFor j = 1 To n
9 f& S5 Q( u6 b( H$ S* s3 J' Ia(i, j) = Val(Left(s, InStr(s, " ")))  w/ c1 [$ D8 A1 E- l  ~
s = Trim(Right(s, (Len(s) - InStr(s, " ")))), S$ C3 q$ \: u6 f
Print a(i, j);
  X9 h0 q5 R; R2 QNext
4 G: \1 I2 u) m, U9 m% f7 aa(i, n + 1) = Val(s): e9 s+ _/ X" E/ o( r0 ~
Print a(i, n + 1);' T+ C6 G, l5 a0 q; n
Print+ p8 f/ Y" X# R: o5 |( ~- r& R
Next6 {" R6 z9 J8 K! \3 C

% g$ ^5 H+ n! ^1 y5 b+ XFor k = 1 To n - 1 '开始消元: N& h. T8 n& Q+ A3 q8 a& r: K
If a(k, k) = 0 Then
; w; t9 I: j% h- IMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
, t2 g. c% J! V+ t0 _7 IExit Sub
3 t7 K$ \6 D) E- bElse
. J% M9 s& n( c0 E. B* |: G' WFor i = k + 1 To n- @& Y. M5 ?) G# W  |; ?& Z
l(i, k) = a(i, k) / a(k, k)
$ E3 p* G5 }& B2 q; |. RFor j = k + 1 To n + 1& ]  y7 F( [8 U% p) T
a(i, j) = a(i, j) - l(i, k) * a(k, j)! c8 ^  `$ P$ X3 Q* o# ]- u
Next* }6 F+ o9 o1 j% K
Next  _" I/ B- K0 a8 K
D = D * a(k, k)
; E8 N% o4 t. y4 \. CEnd If
, A# `* c9 n. X+ bNext k '消元结束
1 p& p7 n7 O' n! R- z  q& b8 |If a(n, n) = 0 Then) S+ [! y1 K. K; p
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"- I; Q% X7 \% i; H: ^1 F
Exit Sub
1 ]% Y" U4 N0 P( Z& h' a" `6 h, hElse; a/ O6 A' {2 ?9 t7 Y
D = D * a(n, n)' D0 i' B, H( q
End If
/ P# l1 M4 F: M3 |/ [Print "--------------------------------"
8 J. m. x+ `! m4 Z7 bPrint "系数行列式的值是："; D3 Q* ?2 a% P5 Y( m% e
x(n) = a(n, n + 1) / a(n, n)2 q. F  f* Z# h  |
For k = n - 1 To 1 Step -1 '开始回代
! l# i  h4 _1 |3 MFor j = k + 1 To n
: i: T+ F8 F5 l3 {; rm = m + a(k, j) * x(j)
! Z! ]: X# \% j  R! ^3 r- J6 kNext j
, b2 E, g% O8 j- |x(k) = (a(k, n + 1) - m) / a(k, k)# d5 y$ z; M7 N) `, Z/ g
m = 0
: c, r% S  l; U- G/ Z7 J# YNext k '结束回代
. |5 Q7 I! D2 }% Y
; A% ~  g% ~3 A/ B, SPrint "--------------------------------"
/ _( i( n0 X; q5 B/ u. G' LPrint "方程组的解如下："
, R  G$ z0 Q6 g6 l# J1 i1 M& p3 C
9 f) F8 \2 B) s8 }9 Z. {8 iFor k = 1 To n+ A: @; G3 y/ K" J( J
Print
1 n( n0 U4 l6 U, H# e0 |Print "X(" & k & ") = " & x(k)
0 C" R$ o# p* O: CNext k
# y& A: P# U% _Print "--------------------------------"
0 Z4 `& u1 N5 d2 tPrint "其中各行Ax-b=", N) Q: c! E8 k! M  g- X( c
Print3 s4 e! J& d9 u1 C9 E. s
For i = 1 To n0 C! T3 {7 c# D9 O( e
t = 0
2 P& ?2 l0 |# P9 ]  U" UFor j = 1 To n
, m# g; k: J5 x5 i5 g/ k" ~t = t + a2(i, j) * x(j)9 L2 F1 ^3 T1 d( h4 k0 ~
Next j/ _: B/ D3 X( c0 ~$ U7 ^* {
t = t - a2(i, n + 1)
2 c7 Z- G% a; rPrint Spc(5); "第" & i & "行："; t. [. p7 _8 V1 H4 A7 e6 v
Print1 y6 _* `7 Z$ I) e/ N' T- O
Next i4 i: w$ l) d5 y8 H( s
" K1 ]+ v7 y+ {
End 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