数学建模社区-数学中国

标题: [讨论]高斯消去法---这是用VB编的 [打印本页]
作者: god    时间: 2005-1-19 17:03
标题: [讨论]高斯消去法---这是用VB编的
Private Sub gauss_Click() '高斯消去法
# S4 w! \! S: s% R& Z, n- pDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single. r$ P; i7 P* y* c
i = 1: j = 1
% m1 p7 E  i- b& G9 Z# h$ Nn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))! X4 a; W) f/ H$ ?- n
ReDim Preserve a(1 To n, 1 To n + 1)
+ u/ R% C9 _& ?+ d, H0 QReDim Preserve l(1 To n, 1 To n + 1)1 K4 q; |3 q( S; {7 i2 i( x; R
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single( V% X' T& J8 f% d; n
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
+ K, u/ c$ F% H/ x  \For i = 1 To n
: [9 S! u. l! j. s% _9 fFor j = 1 To n3 P, E6 @: I7 r$ v
a2(i, j) = a(i, j); D( A; h, B; {4 G7 S
Next2 P* p$ S4 ~" b' c) H" L
Next '将a()的值全部赋给a2()
& w/ [/ ]4 }) y2 }1 l/ d; dm = 0) u7 N4 A( i3 \* ?3 H$ \! t' l: U3 @
D = 18 d8 w( f6 C- \, h) v
ReDim x(1 To n)
( _; B  z. h& V; cPrint "--------------------------------"& h, f! ?/ k. y# }+ N
Print "您输入的增广矩阵如下："
# \) `* F, _: S+ fFor i = 1 To n* c5 K7 q8 K1 I- h9 U) l4 e
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
! ?7 ]6 x4 B+ S% a7 ?/ _% r) bFor j = 1 To n, O* ]3 w/ E9 }3 c& _! {( d- i
a(i, j) = Val(Left(s, InStr(s, " "))), e; h0 s* E9 B9 g
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
. m3 i$ S! O. |( m8 Y6 YPrint a(i, j);. V6 D3 e7 F0 I: y; @9 V$ K
Next$ {; {6 n# F) K' y6 w2 r
a(i, n + 1) = Val(s)+ v4 u6 {0 x# b$ D
Print a(i, n + 1);
) o1 C: U& t" M, y+ B3 xPrint
. |4 n5 j2 Z0 k8 D- WNext
, @  y0 O' V" m, o1 j, _. u4 s% s) o: V- I3 K) u
For k = 1 To n - 1 '开始消元
. d2 R: L# w$ D- b7 n" H+ M/ s. Z/ }- gIf a(k, k) = 0 Then9 j5 P# J! D4 M, }! \- S: ]" [
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"1 K) N- a5 j) G1 L: j
Exit Sub
! ~2 p9 T+ N* s( m8 F- B4 ~Else
; D* N0 \* s6 @- T* L- EFor i = k + 1 To n- B0 W$ [, V+ [0 m, S: |' d
l(i, k) = a(i, k) / a(k, k); e& j. p( b- F
For j = k + 1 To n + 1
, H9 i) ?+ e; i% F1 Ja(i, j) = a(i, j) - l(i, k) * a(k, j)
" g+ r' z. S- I, i4 _8 {: X# L' S& BNext
, u+ z; y& c+ |Next
2 {4 Q- g& w/ I7 V0 _6 |( `D = D * a(k, k): v4 o. {2 e  H- Y2 j9 i
End If4 ^8 @0 [. h9 @8 B5 }
Next k '消元结束# W, U7 d2 j6 ^3 |1 B
If a(n, n) = 0 Then
( b, D8 ]: z) B! g3 aMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"2 Z' h7 ^8 H, e+ Q7 n' @
Exit Sub
, e% L  {) ]% WElse3 t8 `& X+ F9 R: _8 ^( D5 \) f
D = D * a(n, n); E; T2 K9 A* }  v
End If
4 `1 }$ v2 F8 y3 R5 o2 T/ BPrint "--------------------------------"2 A% u& U6 T! g( ~
Print "系数行列式的值是："; D/ F0 n- f8 ]9 M8 ?
x(n) = a(n, n + 1) / a(n, n)
! L# V2 C3 {9 K3 C1 Z5 Q) U# SFor k = n - 1 To 1 Step -1 '开始回代
4 z; k4 E; [% U3 m4 U+ v# [For j = k + 1 To n  q- U' ^* |1 o6 o+ Y
m = m + a(k, j) * x(j)
& Z0 h6 k5 b2 D6 hNext j+ }: O7 G4 I  H$ [) _2 T
x(k) = (a(k, n + 1) - m) / a(k, k)
4 B  {) m/ a5 X$ ]m = 0% M) J( _: }! a5 u( R
Next k '结束回代
# @" T) [( G- f+ g: z" I1 _
  _2 [/ C# K$ g9 c& D# |! Y# [Print "--------------------------------"
/ G" n1 H' E/ g4 K! F5 n& l1 O, VPrint "方程组的解如下："
' j9 O& p# z! s1 C' E! c9 x# U; m0 ]! B( d( q
For k = 1 To n
) z: z$ N, Q5 K/ C" b/ vPrint# u1 J" ]' U4 p% L9 U9 @% c
Print "X(" & k & ") = " & x(k)6 n1 N1 V4 B" b7 k: w
Next k
8 ?2 K0 q7 `8 V4 B$ c1 |; U& uPrint "--------------------------------". |, {4 }. e. [
Print "其中各行Ax-b="
  H4 A( ]& T  @( t: DPrint
3 B0 S. P+ u" [, L! b4 ]For i = 1 To n
8 P$ w0 I8 j) V4 h' q1 ]* dt = 0
+ p0 N% U8 T4 P3 dFor j = 1 To n
  p9 ]1 y1 O# m: z+ d; Kt = t + a2(i, j) * x(j)" Y: s( f7 i) i
Next j7 m* A( @: O) c- i: l9 P1 ]
t = t - a2(i, n + 1)
: r% n" p$ p$ b- U1 x" DPrint Spc(5); "第" & i & "行："; t
$ b; \3 ?* }: {; i# E% d) f/ oPrint! w* V, x1 {5 ]( ?' E- G- ]6 \' H
Next i
1 ?9 m+ G- O8 x. M9 ]5 T6 n8 U2 d; \1 x+ k4 ]
End SubPrivate Sub gauss_Click() '高斯消去法! c! {/ l9 a* ~# g6 K; e
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single6 ?0 G3 y: Y9 }6 d
i = 1: j = 15 }) r4 g; O! z2 X# I; q
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
* \. q3 y9 y- ?( w# \2 hReDim Preserve a(1 To n, 1 To n + 1), O6 }' K3 v5 {
ReDim Preserve l(1 To n, 1 To n + 1)
$ s; F1 x" I  n3 ^2 g- pDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single9 i1 T7 `8 @3 v  U: S+ m% ^8 ~
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
8 D( I8 b0 V. c5 l# dFor i = 1 To n
* }4 h% Z3 Z! m7 Z  W& OFor j = 1 To n
  P/ x# J9 o& @! e7 b  F6 I  k1 Ga2(i, j) = a(i, j)
$ [3 {. G" }. ~Next
$ M( L: r6 C7 |7 H# yNext '将a()的值全部赋给a2()
4 w' h* h0 u- \' t/ am = 0* p" A0 y% x' ^- y$ c1 r, P+ ]/ n( z, J
D = 1
' v" G8 c& I$ xReDim x(1 To n)- W( G, C9 X( e7 Q
Print "--------------------------------"8 L! z; J& D1 D' t+ `2 j0 p
Print "您输入的增广矩阵如下："
9 X0 i7 z! m" z1 X" Z0 Y: cFor i = 1 To n
2 w. Q: S# G+ }+ }s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))2 F2 a2 a3 V* C! v
For j = 1 To n
7 H+ w$ k+ M8 v. P2 na(i, j) = Val(Left(s, InStr(s, " "))): ]7 Q6 U- o0 w; E- t
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
) q4 F5 B, H9 o, p4 G( b9 B/ Q  o0 dPrint a(i, j);. `5 w) k/ S! J2 t0 \
Next9 X! W% E! k: y  |  f
a(i, n + 1) = Val(s)0 i3 d& o$ }- S& D  n( ]6 F" |
Print a(i, n + 1);
2 b1 I6 j1 a# X6 M7 ?. n! uPrint
3 |9 w8 v2 v) {Next
9 v1 K8 C( ^( H& a2 d9 b1 V3 H' r, M
For k = 1 To n - 1 '开始消元
# [$ G9 ?* W/ g6 ?8 F4 b8 LIf a(k, k) = 0 Then! y8 H0 V2 {$ E# M; j3 O* q- Y
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"9 c: o  U/ p5 W1 _! `% |+ O
Exit Sub
( ^$ m9 F/ w. U9 J' c; `4 YElse
- k- U  G; i& w7 r; ?  w7 ]For i = k + 1 To n
1 g. N5 P( s# V1 cl(i, k) = a(i, k) / a(k, k)/ Y: O3 @8 P" q8 N4 k
For j = k + 1 To n + 1
! T8 n7 @1 t/ e3 z' B) na(i, j) = a(i, j) - l(i, k) * a(k, j)
& `- W4 l  \" J, RNext3 p9 W/ E" K, G2 I" j
Next! X! b, |7 {3 G
D = D * a(k, k)
/ J7 h4 f! q; N5 `/ B7 oEnd If  G9 l) `% P& r3 r  A% x
Next k '消元结束8 l* S' J. J! w& H, @$ _9 i
If a(n, n) = 0 Then
" z& }# D5 r1 e( NMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"5 X- `" {3 z' D) ^# @) s4 A
Exit Sub% G3 U8 a& V: X2 p, v4 O4 i
Else
" p% h, j5 S3 V6 I& ]  ?; Y1 a0 g9 wD = D * a(n, n)% \9 I% G( b* l$ A8 I& k
End If) R* B4 S4 _& B- T4 z9 w$ K
Print "--------------------------------"' Y& n2 B1 G/ t3 |
Print "系数行列式的值是："; D! x6 T  }. B, G
x(n) = a(n, n + 1) / a(n, n)& F# _6 @; i+ s! f" v
For k = n - 1 To 1 Step -1 '开始回代
9 A( m  d# d7 `7 i9 cFor j = k + 1 To n
, x5 o! m9 ]) {3 j7 ?m = m + a(k, j) * x(j). S) Q0 v! L: j" J
Next j
( \9 Z* d3 g9 J4 b$ H" V7 ?! jx(k) = (a(k, n + 1) - m) / a(k, k)
7 ~9 y4 d' L" E+ P6 e- E1 D4 Ym = 00 ?, y8 i/ d5 y% L5 Q3 n
Next k '结束回代
" ]$ z$ {) w* E$ C* w7 ?4 H1 ^: E; O) `1 q0 F2 T2 P/ |1 P5 i% I
Print "--------------------------------"0 ?9 y/ s2 H7 `$ o1 c4 s; S. G
Print "方程组的解如下："
/ `6 O, D7 F: F1 H6 N& |; e3 i3 r8 |% Y: x' C
For k = 1 To n
7 H# n5 E- r. d! l6 cPrint
! w) `& H" w! k- t. X; _5 n. NPrint "X(" & k & ") = " & x(k)
& S, g0 c8 d1 K5 X3 {- xNext k
% k) V2 z; v$ T$ P% |7 p/ r/ MPrint "--------------------------------"
, z' F% z0 A% Y, r- p& S, x+ BPrint "其中各行Ax-b="
4 i4 r9 y% f4 tPrint2 A$ s! u# T" u: I# E" i
For i = 1 To n7 _* O4 m% f: J) U
t = 02 T$ V8 q8 W3 Q! |& H+ e2 o5 D
For j = 1 To n
8 I9 U0 T& r+ _# H3 P+ Ft = t + a2(i, j) * x(j)
9 R9 z  @+ ^5 ?7 e1 y  iNext j0 m1 v: L' G8 m! {" ]/ B, N; b! R
t = t - a2(i, n + 1)3 @8 w3 A2 f* o5 Y
Print Spc(5); "第" & i & "行："; t
9 f7 [- W' n+ y- R1 r2 E( V9 t  qPrint) M( Q8 V6 N/ v
Next i
0 y* z( ?5 }- Z6 Q& @- `/ }0 `/ I8 `0 e2 n4 o) S
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