QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法
3 T+ H* ^/ a3 A$ nDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single' w9 l! |7 ~% L/ e
i = 1: j = 1
& Y8 l2 D; \: Nn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
0 y) H1 Z2 o" Y0 d9 r4 cReDim Preserve a(1 To n, 1 To n + 1)1 _% J+ @9 ^  W) H
ReDim Preserve l(1 To n, 1 To n + 1)
% D* N5 f" r! ^  R" ]Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
* D" k  Q$ Y; IReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
3 f4 L. L5 f+ Y) A" w8 z* @For i = 1 To n* c% U2 F) p, V/ A  z
For j = 1 To n
( Y( ]" j  ^2 c; ^: I$ c7 o7 Pa2(i, j) = a(i, j)+ _. l9 ?  K! C9 ^! i6 D; x
Next' x2 F& n6 K) d6 G6 u  N; ?9 \% M
Next '将a()的值全部赋给a2()6 _: C9 A: L: {, M1 t
m = 0
2 `5 |0 ?4 z2 W* y1 hD = 10 G+ x) f( {3 N% J5 {3 V/ C
ReDim x(1 To n)
4 J$ g/ q' G# K% u, JPrint "--------------------------------"; H4 A3 \1 H0 J9 R
Print "您输入的增广矩阵如下:"1 V( J$ s) [$ y& h$ K. V# z
For i = 1 To n; Q- I. |6 D/ U. K4 T  e
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
2 Z" Y0 k0 u5 ~5 ^- @7 PFor j = 1 To n
; I* Z5 v3 a) i/ H+ _5 ~- X( }a(i, j) = Val(Left(s, InStr(s, " ")))9 X4 q. A2 Q: {
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
: B+ N1 d  G, s7 @' E6 @Print a(i, j);
# i% }6 x8 [0 x; x* ]0 Z3 |+ VNext  X% S  `' l* g# L: Q' I* |
a(i, n + 1) = Val(s)
* B! ?3 q7 H' j  X' i0 L0 b# `Print a(i, n + 1);
2 F5 C1 n0 y. f9 E1 x: _Print) g& g1 ?8 o5 f  h2 l
Next
8 {* Y5 r  d$ F: y5 A) a/ W% i. X. ^8 ~: [& l# e4 h
For k = 1 To n - 1 '开始消元9 y/ o& ]+ d% P2 m7 O7 f
If a(k, k) = 0 Then* ]: q3 m2 a6 a5 R9 J: s
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
" `3 j- R% p; v7 l( ]- @Exit Sub' f  B2 s% p; p$ w  K$ g: I! y/ m
Else( \6 K( K% H2 i
For i = k + 1 To n5 m; ~8 w: y1 @' ~/ t
l(i, k) = a(i, k) / a(k, k)
+ @+ G0 L, J0 V2 c4 B4 n( PFor j = k + 1 To n + 1) p# f8 |# K- \' v
a(i, j) = a(i, j) - l(i, k) * a(k, j)  y5 N' i. c6 B5 C) V
Next
$ r' Q0 q) y$ K* Q( N% VNext# ]1 V- _( ?3 d
D = D * a(k, k). y/ L! r. ]! z" ]- ^" c8 h
End If
& z) M) ?. x. p' f% V: lNext k '消元结束
3 T4 B3 z' @, y7 XIf a(n, n) = 0 Then! k( C! p, \: c' E
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!". f+ p* k1 \, m* r$ a
Exit Sub% e3 b; p8 p. M9 U4 \. w
Else. g( A2 b* M2 l) H: O( q
D = D * a(n, n)
4 |4 z7 |; n1 q/ v" jEnd If
6 V* z' J5 T( U4 mPrint "--------------------------------"
% x& y1 c( S$ r" ~; dPrint "系数行列式的值是:"; D3 |: Z, }  ?3 R8 \
x(n) = a(n, n + 1) / a(n, n)
  d* H7 c+ i0 J2 q/ \1 GFor k = n - 1 To 1 Step -1 '开始回代( L" w3 z2 Q& Q1 o" @! ?( G
For j = k + 1 To n5 c' @) Z  b1 A! D
m = m + a(k, j) * x(j)
6 ]6 g5 }3 q7 T7 Y& Z9 ^) KNext j
. m' c9 G- R8 R7 \) p. _; Fx(k) = (a(k, n + 1) - m) / a(k, k)
4 a/ w/ \" c, G, [3 qm = 0
5 p8 R" |* i. J( ]* zNext k '结束回代
7 W+ z! `5 y! d( q6 {) V4 L  `* N5 L
# m4 l9 `7 V5 }" i- IPrint "--------------------------------"
( m$ R/ S" |+ q. rPrint "方程组的解如下:"1 y; B- _' u( B' ?+ Z$ m8 I
$ U+ i) N, B$ B( V/ ^# K
For k = 1 To n! G' u+ F6 u0 a, U( I
Print* L0 ^6 G+ U. a% W5 u1 v3 Y
Print "X(" & k & ") = " & x(k)/ C; J7 r+ ~1 n; E6 l: d. ?
Next k
* W3 ]/ U+ s% y: pPrint "--------------------------------"0 A5 {1 T# U: ?/ ?$ k% d
Print "其中各行Ax-b="
/ C1 _, k7 Y- b" j$ bPrint4 s6 w+ o7 I, {
For i = 1 To n
& K+ O* l! z2 }3 _& L+ g2 P; ot = 0
9 y6 n( ]$ k9 {* t6 W9 a3 T: hFor j = 1 To n
: f  L( [. d' v6 `& s# Z* }t = t + a2(i, j) * x(j), G$ i8 Q' {0 \& s
Next j
$ [# O/ M5 a7 m( k. qt = t - a2(i, n + 1)
  V/ D; m8 A8 X3 d3 [4 q; zPrint Spc(5); "第" & i & "行:"; t
8 z+ j6 P# f& cPrint1 ]- `2 `/ T" P# _3 t7 ^
Next i
  N+ F! K& [* C: c# h6 I! {
) G' o4 {: K3 [End SubPrivate Sub gauss_Click() '高斯消去法4 y9 B3 i9 z: Z/ ?/ \$ S+ z/ Z
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
$ p) `, x7 @1 \: Y; C( X  x: Pi = 1: j = 1# Q4 @: r% Z2 C* K$ ?. `
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))6 G2 A8 i9 a" {* r- d/ e
ReDim Preserve a(1 To n, 1 To n + 1)( }! e  q& [6 [+ N& q
ReDim Preserve l(1 To n, 1 To n + 1)
' p# y2 U' |1 ~: [' k2 `) q, [Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
  F5 L2 S  y, b5 }$ i* c* UReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
" y1 d+ l$ f8 R0 tFor i = 1 To n
4 p( m, ~8 N! c/ L! GFor j = 1 To n
8 t4 H( e0 V5 N$ H% ?0 ^; m5 J% {a2(i, j) = a(i, j)
9 p" u  ]& W7 u: V# uNext
: _& _  b4 N8 ~2 ]. jNext '将a()的值全部赋给a2()  R; J: g$ R0 z
m = 0( a( Q: L1 d+ M
D = 1
2 n( V! v4 r2 f1 |2 MReDim x(1 To n)9 @5 K0 g" r  T
Print "--------------------------------"4 [$ `( G7 {& i
Print "您输入的增广矩阵如下:"+ L( v+ W- o5 M2 _4 ]+ O
For i = 1 To n* m7 B( P0 {" B8 G$ ~2 `# O+ c# O
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))% S. U! \1 {* P. z3 |- a
For j = 1 To n
! _( I: q8 z" \9 ua(i, j) = Val(Left(s, InStr(s, " ")))
6 t* X- Q0 Z# F0 _7 B" H0 ~s = Trim(Right(s, (Len(s) - InStr(s, " "))))
- u- W4 ]. i3 N1 r! t/ [2 R4 ZPrint a(i, j);
) @6 K' E8 V" C; i& U  m; FNext) W$ c" P0 c$ ^/ K* Q
a(i, n + 1) = Val(s)8 Y" d4 J3 O( {' M- ^1 ~
Print a(i, n + 1);( t6 a, _/ h0 M3 `  `; E
Print9 g- r/ h( j8 q6 m. I3 }4 |4 X& Q
Next
- m* d2 Z" K4 m1 O3 Q/ X, j' U( s- L; |& {: t& H$ P
For k = 1 To n - 1 '开始消元
6 x2 K* u, a6 j. xIf a(k, k) = 0 Then/ Q  ]9 J# C9 t! q. q
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
( B4 f! ^; H+ DExit Sub9 C, C; h6 `# s! e6 O6 J
Else$ X3 J) Z! W; G  _/ y* b
For i = k + 1 To n
. s: _  f$ @7 f0 U0 Ql(i, k) = a(i, k) / a(k, k)/ `6 d" e: q' _1 P. C/ C3 o# Q7 M
For j = k + 1 To n + 1
2 g: d7 n. ]8 p+ n+ `3 ba(i, j) = a(i, j) - l(i, k) * a(k, j)
" `; D4 f# t/ g8 j7 M" {$ v& `' ]Next2 Z; r4 X; Q$ T
Next
: }" |& y2 w* |/ D, C9 O! CD = D * a(k, k)+ D; j( b' `! J+ U
End If
* H" _2 A/ r4 Q9 Q2 E. J3 m& BNext k '消元结束
6 P3 R8 ]+ U6 f+ A+ l  Y1 QIf a(n, n) = 0 Then1 H% t; F9 T- M+ r! A7 Q! x: M
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
8 W$ q: o/ J; B9 BExit Sub
& v4 v! B/ D( a# ~  B. E* y. hElse
$ ~( b2 w- l" F7 G6 N1 sD = D * a(n, n)9 v3 r; Q% h; n
End If; a# c! `  ~3 L( }; B) c3 R
Print "--------------------------------"3 ^- _) D- a) f/ q! t
Print "系数行列式的值是:"; D" c3 x& g' J0 k, P
x(n) = a(n, n + 1) / a(n, n)( z$ k( y8 @( L% F
For k = n - 1 To 1 Step -1 '开始回代# {- c) ?3 {# H2 I- C5 g/ |/ o
For j = k + 1 To n+ |7 T7 V8 E7 I2 Y$ J) r% X
m = m + a(k, j) * x(j)
1 p5 F, X) _. ^! O1 I" K% JNext j
2 }! `7 w6 t. W6 U& hx(k) = (a(k, n + 1) - m) / a(k, k)
+ P. S# L  L# Q  Z* f! F( B! lm = 0
% p/ C! m  Q& B! }4 t! lNext k '结束回代
' J1 ?: ]+ m; O( K( M7 D# z) p+ w2 T8 d' P! k1 |/ ~; ?/ r
Print "--------------------------------"
% r* C* a( j& O- n. I& n, v$ hPrint "方程组的解如下:"! {' c' s& W3 n- N

2 w/ i0 @$ }9 p! T( x. z) CFor k = 1 To n9 E7 m0 g: ?) J+ ]0 e
Print
; u( v: T, B; Q  G* j2 g" a, O6 G  uPrint "X(" & k & ") = " & x(k)! \5 `0 {& p! P4 u9 u
Next k1 ~% h9 N; e5 a
Print "--------------------------------"
6 W7 G3 ]5 J4 w! U/ GPrint "其中各行Ax-b="% _% Z) w# x) d* w  `' ]+ l$ P4 R
Print
' s, o/ g: c2 mFor i = 1 To n
; h& Z( z9 z; k$ \% c( b, Jt = 0
! d, G; E3 c1 I) F# jFor j = 1 To n
1 s& g' V) O% \$ X" K9 x+ N5 d9 ^t = t + a2(i, j) * x(j)
' i2 H* t3 O) R- u. INext j. o! S( }+ O6 E/ B/ p
t = t - a2(i, n + 1)) B" [! E  h/ K) x5 N
Print Spc(5); "第" & i & "行:"; t, D! A* p8 U  V7 N4 [. d4 k
Print% R  Q/ g: Q& H* f# {3 Z' b
Next i4 c% q' D3 K* h7 `+ d7 N

9 e8 ~4 P3 B0 q) b2 H- l3 O' VEnd 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-19 23:51 , Processed in 2.266057 second(s), 69 queries .

    回顶部