数学建模社区-数学中国

标题: [讨论]高斯消去法---这是用VB编的 [打印本页]
作者: god    时间: 2005-1-19 17:03
标题: [讨论]高斯消去法---这是用VB编的
Private Sub gauss_Click() '高斯消去法
! j. f/ U. L$ \7 @$ f9 @Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
0 `, E) u, ~( u5 }i = 1: j = 1& b4 v# V& u) H6 e4 B/ M
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3)). ]. {# i1 ~, M$ w# Q
ReDim Preserve a(1 To n, 1 To n + 1)% C2 L! ~; \- L  I3 b7 j8 h$ i4 X. e
ReDim Preserve l(1 To n, 1 To n + 1)2 U" {, n- |7 A8 x' T
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single/ K8 B! u5 j) b
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
/ @* j! a2 L1 m: q. KFor i = 1 To n' j  d. K/ F5 _* _
For j = 1 To n
7 k7 |/ H+ r# y1 w- @' R# ]a2(i, j) = a(i, j)+ |  T2 D0 r) p9 W$ e) w- h6 e
Next
5 P) ]& P" B4 |" |2 U0 r0 `Next '将a()的值全部赋给a2()
! A2 e# ^7 N8 Q7 hm = 0
. i/ N$ B9 Q& B' O4 XD = 1
! e" {- u% q& h. R/ m3 U& m' SReDim x(1 To n)
8 J/ w6 M% J: {3 P8 j1 a" B( `Print "--------------------------------"
. K( W; w7 \$ _9 |8 }  bPrint "您输入的增广矩阵如下："
8 y. B4 d) m$ J4 ~# K* v+ x) gFor i = 1 To n
) ?: T/ Y1 h! g8 s# V0 u% f  ws = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
+ ~; I% N! \0 w, U. ?& z; P" XFor j = 1 To n8 K% S1 ], b* W: m) w) \4 L: ^7 Q" Q$ ?
a(i, j) = Val(Left(s, InStr(s, " ")))( N8 \, N) `( S) Z4 P9 Z, g( f! q
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
$ c0 Q( C; s% ^. ?4 j; wPrint a(i, j);
, O) S$ R3 @' B2 d4 ^Next
, x4 W' ~2 s' K6 J; `8 m5 f& Sa(i, n + 1) = Val(s)4 ?. p; L2 I3 A- o* @4 ^
Print a(i, n + 1);
, l* Y, g: l6 dPrint3 y+ ~& x; Y- r9 [3 }
Next
7 h9 Z7 }  b* P3 ?7 A4 g
: `& N, g" R/ ?4 Q* x; J' ^$ |For k = 1 To n - 1 '开始消元
: P( ?4 E% `  _" E) }2 bIf a(k, k) = 0 Then
) o) J/ s/ K2 rMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"( W) `" G& C# {) E2 Y. Q) h
Exit Sub
7 U/ Z. i# D5 J$ E* c, cElse2 p! `/ s1 C6 N/ t  C  C
For i = k + 1 To n6 \* t9 u# v) m! B8 Z8 g& G
l(i, k) = a(i, k) / a(k, k)0 N' y" U: Z/ d2 U% U
For j = k + 1 To n + 1, b' V/ u9 @0 i' p) f/ r& }  |, {
a(i, j) = a(i, j) - l(i, k) * a(k, j)
8 J' {- c0 ^( K5 S! V* V1 M* nNext8 u% ^2 v8 x  M6 ^9 d. f, t
Next
6 ?9 g9 d8 u; g1 _6 JD = D * a(k, k)
: j9 U) Q  z2 [! kEnd If0 T( @6 f) p, S2 ~1 x+ ~# ^
Next k '消元结束) y) T: h- s' L: H8 K6 s
If a(n, n) = 0 Then! k4 _1 J: V4 N% [% N. W
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
% W% G9 G! Z* M  Q+ A3 x8 `2 GExit Sub
5 L4 d5 o9 R1 b# O1 w% dElse
6 E" K/ J  x7 s5 D6 [* uD = D * a(n, n)* L: K8 v& b) S4 d% r
End If( \' J) w3 Y1 k* Y& |
Print "--------------------------------"
& O. x" E' `! P# s8 l6 |" kPrint "系数行列式的值是："; D, C5 w5 A3 J; f- C" F" g  J
x(n) = a(n, n + 1) / a(n, n)# H" P; o6 U6 [+ h
For k = n - 1 To 1 Step -1 '开始回代0 ~7 K$ O! N0 L9 g
For j = k + 1 To n
7 [3 P# z7 Z; f9 N5 Cm = m + a(k, j) * x(j)) J  t  g: V# y0 I$ O
Next j/ L, c. h0 i( y) G
x(k) = (a(k, n + 1) - m) / a(k, k)
. o$ a) x/ ]9 [m = 09 P* ~# R8 U/ P' _* t" D  v' n/ q8 `
Next k '结束回代
; p% |, `- L& w$ Q& l: |, p; v0 p6 j
1 x! p5 u. ]. {; [. XPrint "--------------------------------"+ |; k& z1 L% d  {
Print "方程组的解如下："; A# |4 Y6 z1 Q7 j
7 u+ G- A* }5 r0 c, u8 ~
For k = 1 To n5 X  L+ m1 q9 @$ M& @
Print' `* E; s* h8 w6 [# U0 ~
Print "X(" & k & ") = " & x(k)+ F: q9 n4 H1 `! x7 U) B0 S
Next k8 B3 c: F- e! X# O  r. U) C1 c. j
Print "--------------------------------"- e4 {: `/ S5 e
Print "其中各行Ax-b=". {7 y/ H* s, o- C1 f. C
Print
) d0 L+ T7 s1 u) XFor i = 1 To n
) a, I8 [( l9 o9 |! ?% M; ct = 0
; A/ I! d+ e" D3 T. iFor j = 1 To n
" C. e  V) k" ?t = t + a2(i, j) * x(j)
5 [+ D8 ~; q- K6 A8 H# _Next j
8 `5 @5 @3 Y: q0 E" ]t = t - a2(i, n + 1)) k6 ?' N& w& [9 q4 w0 w. K; p  J
Print Spc(5); "第" & i & "行："; t
; b! P" ]3 I& x9 m: K' R0 iPrint$ I( I2 @& T, }, J
Next i
7 M- b+ S' K  P
# f6 {' W4 U* `End SubPrivate Sub gauss_Click() '高斯消去法0 w3 p7 R' z. |) m
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single% R1 k. ]+ C3 y. o) q3 F8 f
i = 1: j = 1
! q3 G6 s, R" `1 w' o) S' hn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))8 s+ ~! t% u/ y9 ?
ReDim Preserve a(1 To n, 1 To n + 1)
; W) n/ f" [' v8 aReDim Preserve l(1 To n, 1 To n + 1). Y% }, v7 h+ G) E7 J2 }& e
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single2 S8 y/ S% }- h! V; c" S+ E9 w
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
& q; L9 n, G' }+ i8 ^For i = 1 To n# f; s" `+ L. F# {& |! X
For j = 1 To n
4 W' [' N) A& Ua2(i, j) = a(i, j)
+ l9 ?# k, l# w) M, p+ P5 \" |Next/ E! ?/ J2 q4 m+ e& e* @4 U! t" [
Next '将a()的值全部赋给a2()
+ r% f* j5 l7 C" B4 L4 Em = 0# {2 E, C/ S* j4 _( c4 M$ x! x* \4 F: A
D = 1
0 z4 N( {  C) v" M7 E$ qReDim x(1 To n)4 w0 n2 l/ p8 t: P+ @" [4 m6 Y
Print "--------------------------------"$ `$ R/ l# a$ U2 p/ ~7 a1 y
Print "您输入的增广矩阵如下："
. A8 }1 L  l/ r) \  qFor i = 1 To n( ~/ h& l1 h8 A2 R9 p& p6 p
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))  p% O! c; [! v- e) u0 G$ k5 }
For j = 1 To n2 F( l! ]/ y% R& _9 b$ ~
a(i, j) = Val(Left(s, InStr(s, " ")))
9 q7 t0 Y7 }6 L0 L6 r5 Q3 ks = Trim(Right(s, (Len(s) - InStr(s, " "))))
- b7 L9 O0 A( l. D  E' z7 @0 s+ yPrint a(i, j);
' c+ L! u; F+ M1 w1 pNext# Y& I4 d% h2 B! J
a(i, n + 1) = Val(s)
& q2 e* ]6 G. q9 G  oPrint a(i, n + 1);; ~9 @, Z8 I, ^# F* I/ g5 [8 \
Print
1 Q6 d6 _1 }) v: y; v& LNext
8 A  i7 p1 q3 v
. f# E. E0 G' E( ~2 MFor k = 1 To n - 1 '开始消元
' a  x. M( K9 s0 b3 O, E0 B, VIf a(k, k) = 0 Then
& A: Y( a4 K9 v% L. l8 |MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"+ `  S2 G& P2 z* a' V; _  k; D/ r
Exit Sub. [. }9 L( D& s0 ^
Else. d1 p, r' N4 t9 x, X7 x
For i = k + 1 To n
) U- T& O2 L3 q! ~# ]% ]l(i, k) = a(i, k) / a(k, k)
' `* E" f% F$ L( n2 j+ eFor j = k + 1 To n + 1/ z" k6 @* o2 h: t/ D  Q/ U/ M
a(i, j) = a(i, j) - l(i, k) * a(k, j)
, X# R7 C& J  M2 ?Next
+ D1 h$ \$ c% @Next! G: X9 u! E: y( y5 v
D = D * a(k, k)
' _! @& `/ }: ^6 s  @End If
0 @) b2 a2 N. s9 y5 G3 ZNext k '消元结束- \$ e3 I0 Y5 e; J" m6 I6 D
If a(n, n) = 0 Then2 J" Y- V0 Q+ s9 N9 E1 S
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
6 `* a9 Z% ]  U3 A- C: k  mExit Sub
! |% U; R; D9 \: @4 h# Q1 p, TElse
% ?6 U# z" m( @% A$ j" s: e2 R$ q6 aD = D * a(n, n)" [6 }% D3 d; [" \
End If+ e3 V& M3 y+ l/ R( H
Print "--------------------------------"6 Y8 F3 z  K5 X. V- z
Print "系数行列式的值是："; D
* r4 y4 m6 {% n9 N! `x(n) = a(n, n + 1) / a(n, n)3 J& ^* N' {2 u0 z
For k = n - 1 To 1 Step -1 '开始回代! r( i9 _2 f6 h3 C# {4 N
For j = k + 1 To n
$ y, Q4 z# s% Rm = m + a(k, j) * x(j)  Y/ l/ M  P" c; ~& i9 A) G* |
Next j
* Y) s6 _5 a$ a6 m9 q# P! p7 hx(k) = (a(k, n + 1) - m) / a(k, k)
5 H. P) f( c$ C9 Q# zm = 0
+ q' b5 X+ X) K- tNext k '结束回代; a1 L8 P% w! _; }; z
6 z# c: P6 n! Q/ ^' v2 t
Print "--------------------------------"
3 d0 a8 M  J) r- n+ B# o8 f/ nPrint "方程组的解如下："; q; W$ W5 c6 g. X5 X+ F* k8 W

( W) E8 J, F+ @+ [' D5 J3 r9 dFor k = 1 To n/ r  B3 E3 X; i& }+ ~  `: Y2 f9 n% O/ p
Print
2 f* L8 Q6 D  z5 I- k% q' `Print "X(" & k & ") = " & x(k)/ X9 F/ i' `3 b: A% D. F% x3 e# u+ U/ j
Next k) J$ S0 v% t5 Y+ l
Print "--------------------------------"
' I% u. A! p" q3 p% o! ?( x3 NPrint "其中各行Ax-b="3 ^2 q! Q' p) x% t
Print
/ U3 M# D7 P1 C( U6 F! G7 ~2 ?For i = 1 To n$ G1 ?' c/ P2 w9 M
t = 0
1 Y7 J0 m3 z% GFor j = 1 To n$ r) _$ M  o! Y! I/ E3 A+ K
t = t + a2(i, j) * x(j)# s& {! z. ?" y" G  q
Next j6 N7 E( l- v6 q3 z7 a
t = t - a2(i, n + 1)7 q2 I0 D8 S( @9 M
Print Spc(5); "第" & i & "行："; t
; F/ `' X: x" x. `; Z/ @Print/ i3 e( {8 C6 v, [  w
Next i
) I" t* d; H4 H% m# ^6 c
" y. U4 o( ]! t7 o7 l, TEnd 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