QQ登录

只需要一步,快速开始

 注册地址  找回密码
查看: 18145|回复: 3
打印 上一主题 下一主题

[讨论]高斯消去法---这是用VB编的

[复制链接]
字体大小: 正常 放大
god        

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法3 |  [* j4 Y9 y1 U. T3 ]( w& R
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
2 @# l, h0 m$ ki = 1: j = 1
  w% S0 w4 ?! }$ Y  \0 e$ R7 j" Hn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
% {) i9 T# ~, z2 o% s4 w: dReDim Preserve a(1 To n, 1 To n + 1)' }2 _* q, f6 |2 F8 B" `4 W
ReDim Preserve l(1 To n, 1 To n + 1)
; u$ T# t; w5 t* s9 UDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single+ p& v. J! ~5 _% [1 N& L( Q  v
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a(); d. N$ U' [  c2 }$ P
For i = 1 To n
- T3 i3 J) n' j; W" ZFor j = 1 To n
9 y2 M( o& i% k/ s$ M" Y3 j! \a2(i, j) = a(i, j)8 t( w) y+ P/ d3 a- V+ B. t
Next2 `* b" o2 h9 X% M+ A
Next '将a()的值全部赋给a2()
& ~& U' R. Q! m( A; lm = 0
/ t: {& ^( g) C; h2 K! LD = 1& ~$ c: V+ q! F' @& W  j
ReDim x(1 To n)
5 M9 k( M+ [1 rPrint "--------------------------------"
" [% I$ t7 L, h  a4 J( N* R  y) vPrint "您输入的增广矩阵如下:"
! T1 U$ P. k; K- F4 r0 kFor i = 1 To n& E5 O- L7 @! d, ^, }
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
8 b" h4 c1 b1 u! Z: q& MFor j = 1 To n" Z+ Q. P; L1 |, Z  Z
a(i, j) = Val(Left(s, InStr(s, " ")))
9 E1 Q2 ?3 R+ Z  ?0 t2 Us = Trim(Right(s, (Len(s) - InStr(s, " "))))0 M  I' r& G& D% ~. {7 ]% x6 A, \
Print a(i, j);6 W. D4 S4 I2 d- m
Next
& U- _' W0 U2 ~- s2 g3 K1 j9 H% J8 _a(i, n + 1) = Val(s)
( Y! Q: E$ x5 o: oPrint a(i, n + 1);  A0 _6 p8 X, b( o
Print
/ O: l/ y6 I, `$ G% FNext
* E5 i! O0 s/ r" ^: N
8 \4 p- \# i2 I" G: \- }4 bFor k = 1 To n - 1 '开始消元
# Z% V; G  P9 V7 j3 tIf a(k, k) = 0 Then
! t3 V; A, A4 q6 n$ }( I; pMsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
) G3 I: b9 Q  f' rExit Sub+ e- U1 L8 `! K/ g
Else
$ _8 p$ n9 [3 wFor i = k + 1 To n8 _) B2 R7 O: a
l(i, k) = a(i, k) / a(k, k)
( A0 m' i( n: }3 R5 UFor j = k + 1 To n + 1  R# K2 h8 l: K) R8 n
a(i, j) = a(i, j) - l(i, k) * a(k, j)
) x! W8 r2 Q# L+ z2 ~Next
8 o( y% r8 r5 z$ }; [: NNext
& a9 m1 r% N7 y$ kD = D * a(k, k)
3 Q6 f; R5 E# k& f: u1 zEnd If
1 ]. Q0 o. H) A6 rNext k '消元结束
  O5 t2 ?: Z$ b' {If a(n, n) = 0 Then
% a: [7 Q3 I. k& v8 [MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
% K* G- y$ z8 p$ x; E5 |! O4 sExit Sub
2 ?# Y8 c( g; s1 e: ~; b. iElse( _! l; h( e& o* Y& r' {" o; m0 X
D = D * a(n, n)
% H, ~4 f4 ~( g5 T$ {6 aEnd If6 e. ~& ], I, n  x+ A: R: L
Print "--------------------------------"" b1 C8 D# ]; P& s& S
Print "系数行列式的值是:"; D  U+ h6 {3 d+ f
x(n) = a(n, n + 1) / a(n, n)
5 x: ]4 T$ n0 R) o- \For k = n - 1 To 1 Step -1 '开始回代
! E9 g5 V4 F1 H0 }: W# w& TFor j = k + 1 To n, g9 Q8 t3 u& m! _9 q4 w/ f/ j
m = m + a(k, j) * x(j)' E; l- p' \' M. O- E0 _' [
Next j/ h* {! Z1 K5 u$ C
x(k) = (a(k, n + 1) - m) / a(k, k)6 {& }+ M6 x0 a* V" {
m = 0' _, @: W, y: m2 S4 B) k) c
Next k '结束回代, A3 c  E$ a( w* K& E/ y- s) `
: c$ L  g0 I' p9 Y% f+ x
Print "--------------------------------"
* s. L  x& p" g3 b4 R* R3 x" w6 ^; kPrint "方程组的解如下:"- Q7 y9 {! p3 h! |. v
- |0 |' ~- N& P" k
For k = 1 To n% d  {/ V8 ~9 _9 _6 {: Z- x5 ^# D3 l
Print7 s7 i1 K4 r( V: W; L
Print "X(" & k & ") = " & x(k), p$ _% M* h' |4 m2 s& B
Next k
8 t* s& T, ]4 ?$ d5 h9 w5 nPrint "--------------------------------"
  P) `/ V* h8 H/ y/ L! LPrint "其中各行Ax-b=", h, w" y! P4 P) s1 f' ^9 @$ X6 F
Print% b6 g5 J/ k2 }5 \3 B
For i = 1 To n/ x( `& t% e; w  t, D
t = 0/ Z; o$ T# L7 V' t6 l( |9 ~- w
For j = 1 To n2 q% r: H  I7 M' @
t = t + a2(i, j) * x(j)
8 l: J9 }2 K3 @Next j: P; c6 E& s. r& ]; [5 m
t = t - a2(i, n + 1)& X6 y1 ~& J* ?, u4 j
Print Spc(5); "第" & i & "行:"; t  B5 C9 v7 a  j; k( h& K
Print
- n- c* F( f, F8 q) BNext i
$ A" N; f# z" u& i& @, \+ j' n# Q3 W0 f& x  ~2 S! ^, ^5 w# C% v
End SubPrivate Sub gauss_Click() '高斯消去法
5 G3 K) u7 `0 e% uDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single8 V- R7 Y, C( |- U& p7 _
i = 1: j = 1( t2 C4 J7 ^! y& D3 l
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
. x: }9 S. z8 x& i9 J2 hReDim Preserve a(1 To n, 1 To n + 1)% J- ^$ _7 u; |( Y  _1 d
ReDim Preserve l(1 To n, 1 To n + 1)
. W% o* Z4 T+ NDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single4 c6 h$ Q% \6 S
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()9 j9 n0 N1 n! y1 N# P% Z
For i = 1 To n. V5 L; E2 Z) Z1 d4 @
For j = 1 To n2 x- `8 v6 _! [# L+ b$ e
a2(i, j) = a(i, j)
# _& b0 j- H: u1 I  P$ vNext
4 i# H4 r  w4 q; h( i1 `+ MNext '将a()的值全部赋给a2()! Q. a5 m  ~% i1 j( r
m = 0
4 N$ z# b9 K: gD = 1
# p8 D& S1 Y$ z5 x. T! i* p" BReDim x(1 To n)/ z5 u3 V1 _- a7 ^* T9 K& E
Print "--------------------------------"
5 X) Q& K# Z6 e4 w* r+ O3 aPrint "您输入的增广矩阵如下:"
4 A- e' O& E6 t: X0 K& d6 H, ?. JFor i = 1 To n
, h& l* i) g  bs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
* S1 K( y9 s$ Y1 H. w: _For j = 1 To n
9 A/ V3 O) E% J- h/ xa(i, j) = Val(Left(s, InStr(s, " ")))
/ p9 X" X7 S4 b. q  ]s = Trim(Right(s, (Len(s) - InStr(s, " "))))
- H. H( X8 K4 E$ i8 w0 S) vPrint a(i, j);6 p' V4 W, z+ K: }: O$ T
Next1 V5 l. U" D0 e- [9 t
a(i, n + 1) = Val(s)
1 ]& A' @- z( M4 Z# p. |- s) `Print a(i, n + 1);3 ^: C! E7 H" H4 G8 K1 t- B* E0 Q( D
Print
; z. c/ e' j) G; aNext  Z1 d+ R( A( m! P# {

. l6 ^  s' t$ F' uFor k = 1 To n - 1 '开始消元
/ ]9 g6 J# r, F+ p& N8 {: WIf a(k, k) = 0 Then
2 r2 x  J* c3 M0 @" j6 vMsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
. R5 S1 W# S5 s+ DExit Sub: y; {/ l0 f4 Q4 k8 {9 G* K- ^: {% _
Else
6 l8 ?, J* l' L9 Z3 e$ uFor i = k + 1 To n
+ s$ s. p: f# X2 L/ I+ i# i  K5 k6 ]l(i, k) = a(i, k) / a(k, k)
3 O$ n9 C% O/ M  V- l+ l. ?For j = k + 1 To n + 1
8 B: @* p' k1 o2 y. ~, |a(i, j) = a(i, j) - l(i, k) * a(k, j)
( T9 s) ]6 ~9 j( ]# ^  f" GNext
' f) N6 ~8 D( NNext
6 r9 J5 ]( O2 k" R* H: B. m3 {D = D * a(k, k)
( I3 ]3 Y2 g2 H# JEnd If1 D! J( w$ I0 L# i# b" o
Next k '消元结束( ^9 d1 E" R- [4 e. C$ b
If a(n, n) = 0 Then
& t% H% F- D: b6 gMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
1 x( g3 r$ m( T# bExit Sub
0 G2 X) s( v- m9 a( A6 _# bElse( z4 j) ]2 B. j
D = D * a(n, n)# O- }4 z5 _# q; `
End If) F4 C4 t) i0 g& L) B4 p
Print "--------------------------------"9 v( a& ^8 I7 P0 f; k# |" }' }
Print "系数行列式的值是:"; D$ G* g7 |5 U0 m+ \1 d
x(n) = a(n, n + 1) / a(n, n)
0 t& @) N/ a' t+ MFor k = n - 1 To 1 Step -1 '开始回代
1 E% n2 N- g' ]For j = k + 1 To n
2 h4 G( Y2 ^$ o5 K# s. [m = m + a(k, j) * x(j)
4 B! u) z9 {4 D# b% N) V. NNext j
2 g# u. [, ]. N6 Q' y! Nx(k) = (a(k, n + 1) - m) / a(k, k)1 G- k' U! L2 o- O
m = 0
0 u# O' Z: R1 T" j3 LNext k '结束回代2 U, x7 n/ {# A4 V
# W/ q7 q0 V8 B0 h/ X* b
Print "--------------------------------"
3 `9 \% \2 A' D- ]& l! `Print "方程组的解如下:"
9 F: q9 C$ d1 W
8 L8 ]4 c* v: Y/ Z( q4 vFor k = 1 To n0 c) ]3 D( b/ h' c- H/ H' L
Print" z; N7 {- W  a6 L5 ~: k$ z
Print "X(" & k & ") = " & x(k)3 y! S, U5 |2 z6 b7 I/ b; u3 q0 L
Next k
; P$ x% l3 R- }, FPrint "--------------------------------"' x5 `) b- x4 E4 a
Print "其中各行Ax-b=") n. A3 t, n: }3 l
Print3 s& @% N  o$ F
For i = 1 To n
, E: v0 ]& C7 t7 ?t = 0
/ o% \" c# z) R: xFor j = 1 To n
+ G& Z7 i& O# z$ Ft = t + a2(i, j) * x(j)+ K/ W* D3 h) ]5 @+ I; ?
Next j) Z5 u9 N* {" _+ }
t = t - a2(i, n + 1)& x9 x8 k3 D2 C+ y$ Y; `! h
Print Spc(5); "第" & i & "行:"; t
( X# s+ x  l9 C, ^Print. [: ]% g# X! W! V% v' [& w
Next i# B; F, @; D0 Y" J9 a2 v( E

% u# k% B& Y3 x& u8 H7 u1 FEnd Sub
zan
转播转播0 分享淘帖0 分享分享0 收藏收藏0 支持支持0 反对反对0 微信微信
如果我没给你翅膀,你要学会用理想去飞翔!!!

0

主题

3

听众

22

积分

升级  17.89%

该用户从未签到

新人进步奖

回复

使用道具 举报

0

主题

3

听众

24

积分

升级  20%

该用户从未签到

新人进步奖

<p>您的程序我没看&nbsp; 但是我用FORTRAN 90 编过 </p><p>唯一注意的是高斯消法是有局限的 </p><p>1计算量大</p><p>2不能克服病态方程问题。</p><p>不知道您注意没有 </p><p>另我有FORTRAN 90&nbsp;的选主元高斯消去法的程序。</p>
回复

使用道具 举报

zqyzixin 实名认证       

1

主题

5

听众

1818

积分

升级  81.8%

  • TA的每日心情
    难过
    2013-10-14 10:21
  • 签到天数: 78 天

    [LV.6]常住居民II

    社区QQ达人

    群组小草的客厅

    回复

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册地址

    qq
    收缩
    • 电话咨询

    • 04714969085
    fastpost

    关于我们| 联系我们| 诚征英才| 对外合作| 产品服务| QQ

    手机版|Archiver| |繁體中文 手机客户端  

    蒙公网安备 15010502000194号

    Powered by Discuz! X2.5   © 2001-2013 数学建模网-数学中国 ( 蒙ICP备14002410号-3 蒙BBS备-0002号 )     论坛法律顾问:王兆丰

    GMT+8, 2026-9-20 01:44 , Processed in 3.211111 second(s), 68 queries .

    回顶部