QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法
, s! \: l% b3 G8 hDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
5 t! V# \6 E6 k# X. j: ti = 1: j = 18 P% S$ Q; @. [$ p' G
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
' z0 R7 |# v$ gReDim Preserve a(1 To n, 1 To n + 1)/ y: q- x) J# Z' ?( @
ReDim Preserve l(1 To n, 1 To n + 1)8 J! k" X: p1 W; _, M" o
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
7 \! }9 e2 v. k7 ]ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()7 ~6 e9 i4 v* ^' J( N( }7 X8 w$ E- ~- k
For i = 1 To n: |2 O- |% h  t
For j = 1 To n
, p/ V, h, k0 f% p+ `/ v0 h; m8 Oa2(i, j) = a(i, j)9 I( r) e4 r8 b
Next
" g- C2 i" g' {+ d+ D8 r9 u* oNext '将a()的值全部赋给a2()% K0 x0 Y) [+ u
m = 0) k: h5 _7 d0 `8 Y
D = 1
9 W5 H( |9 P9 bReDim x(1 To n)/ I2 `/ x. o' G" M, j/ ^
Print "--------------------------------"# s9 K% {) {6 z2 r2 [) n
Print "您输入的增广矩阵如下:"
& X; n# W; c, ?. ?4 v- |+ H/ dFor i = 1 To n" X, J' K3 H$ X+ o' J6 U1 p% j3 ?
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))+ p6 |0 b9 ^, ?& w' U
For j = 1 To n
6 y5 f; A7 F) O# e" Ma(i, j) = Val(Left(s, InStr(s, " ")))
; a% @/ g4 M* {1 x% Hs = Trim(Right(s, (Len(s) - InStr(s, " "))))
: k7 t) v/ W1 M- }8 B7 X2 VPrint a(i, j);" v7 E4 k0 I7 u& ]2 W% _* Y4 H$ a
Next
2 o/ ~+ g% y. P6 Ta(i, n + 1) = Val(s)9 ?  x/ T9 o2 f( V
Print a(i, n + 1);
9 O' R0 }+ K, wPrint
' ^3 h- k8 u( y5 oNext
7 O7 y( ]. {, U9 ^) e- {8 \  e
9 F+ T& y6 Y0 \  _' }For k = 1 To n - 1 '开始消元
* r3 I7 ~) r6 `7 N, y! V7 X9 Z: HIf a(k, k) = 0 Then: d9 E. [9 |- C7 \
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
! g* N) W1 j8 \$ {3 xExit Sub
& N$ m+ o1 D0 q; Q$ CElse
* j. Z& m: I/ }( s: aFor i = k + 1 To n
$ v2 M. ~, {% ll(i, k) = a(i, k) / a(k, k)& \& W+ @$ l, W0 P1 o+ `; R
For j = k + 1 To n + 1% t5 d6 i) Q. \% `. O
a(i, j) = a(i, j) - l(i, k) * a(k, j)
$ S3 ?$ M& H* |8 YNext
, G. V5 v9 ?/ X0 g; C6 |% i  A! FNext
) K  f; R- \/ ^0 mD = D * a(k, k)
- o; g$ {3 \# `% B% @' `. D' JEnd If( \0 ]$ v. m& t8 n
Next k '消元结束
: o2 c: x8 ?' S$ S# ^: S6 b% IIf a(n, n) = 0 Then
* R2 U& a5 p' O2 a' J9 kMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
# {8 f/ D1 C/ J) u8 {Exit Sub( J0 l2 m  J# ^
Else" k2 J/ }7 o1 E, O+ G
D = D * a(n, n)
8 X/ P3 ~$ I$ G% J! @) H7 Y9 ^End If
3 X# j/ n! a% R* B4 E9 K/ oPrint "--------------------------------"
- Z5 w6 a  Y: J' uPrint "系数行列式的值是:"; D5 w9 u9 Y/ z% _' e/ }
x(n) = a(n, n + 1) / a(n, n)
3 R7 e: [  b9 Y' m! [For k = n - 1 To 1 Step -1 '开始回代
0 x0 F! a0 p1 v5 Q7 U4 HFor j = k + 1 To n
$ t) K" C' |2 \1 im = m + a(k, j) * x(j)  b% I  n' Z  c- j4 k  B
Next j
' a! p+ v+ U. M3 y( u8 lx(k) = (a(k, n + 1) - m) / a(k, k)
) l: B5 G4 ], Hm = 0: n0 s& b9 v5 N) o' e
Next k '结束回代
0 H! m, E3 q$ l2 ^7 |  N
; q% Q! H8 g: J7 H/ _; HPrint "--------------------------------"
  }7 i3 a" N) T# @Print "方程组的解如下:": \; b- x: B. ?5 V+ @

0 d; P4 i- q/ ~) Q- G) QFor k = 1 To n) A# P* w: `* a2 f- d4 C2 g
Print, N8 L+ q, B9 ^
Print "X(" & k & ") = " & x(k): A" i0 B* n$ @0 l4 L: s6 O( x2 P- ~
Next k
+ ^/ p2 g+ U, E# B$ z+ PPrint "--------------------------------"
1 P" O# H# C# v9 Q* w+ QPrint "其中各行Ax-b="
( x3 T7 ^. f5 g4 r0 xPrint) H% E3 |# a' M  n
For i = 1 To n
; F2 W0 b3 E5 P+ ]! Z! h5 J3 p# [t = 0+ m1 X2 p" H7 t5 F9 {' v9 F) T
For j = 1 To n& G) m1 [. N' y- q% f+ {  g5 z+ `
t = t + a2(i, j) * x(j)
" j. P2 o/ B/ {) hNext j; P7 P2 t; L2 d/ }% t' i* S  J
t = t - a2(i, n + 1)9 _6 C, `( o  D0 v) l, P: _
Print Spc(5); "第" & i & "行:"; t
- Z) y# n# \2 I. W! lPrint
) S2 ]9 H- C, JNext i
3 q7 a. M4 F; z/ y. c) H  d* G
4 e* R' K( {# T+ b4 `- \/ wEnd SubPrivate Sub gauss_Click() '高斯消去法6 X6 L, F- }/ p* y4 b3 ~- Y- ~/ o
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
% Q$ Q+ N4 I7 Y. X* J# }+ X% k" Bi = 1: j = 1& O- }0 y) }1 Q: Z3 }- ^
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3)); w% l7 G& Q. X! s" e
ReDim Preserve a(1 To n, 1 To n + 1)+ q2 S' w! E% t7 @7 _7 ?% [6 ~9 d
ReDim Preserve l(1 To n, 1 To n + 1)
1 |* w+ B& O2 sDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single  `0 S% r  u# l. m6 \( z
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
' |' b3 _/ z9 s3 yFor i = 1 To n
4 `% H4 ^0 J- @& H& V) b5 Z- U) D/ gFor j = 1 To n
8 C+ h0 h5 \) Ma2(i, j) = a(i, j)9 {; K$ f* u, R0 Z4 O
Next
2 W" H+ x/ k) e" K" z8 {9 M2 wNext '将a()的值全部赋给a2()* C* ?0 n& g- E
m = 0
" j$ z3 `% s) O/ XD = 1
& l2 m0 G% w; U8 [8 l0 E, hReDim x(1 To n)
4 v0 X1 N4 O/ i* Q; Y* GPrint "--------------------------------"
/ g3 t6 B3 _2 P; g* }5 vPrint "您输入的增广矩阵如下:"
% P. v, ], Y. QFor i = 1 To n
0 z0 _9 d' W( es = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
& L7 T0 }: U6 J' y* `For j = 1 To n
: }% h) N: p) @! O% Za(i, j) = Val(Left(s, InStr(s, " ")))% j* m& ~$ @+ S
s = Trim(Right(s, (Len(s) - InStr(s, " ")))): u* e0 Y5 c* S) ]
Print a(i, j);
; V- e! M  m- p2 W: R% {Next' N- |9 M$ P& l$ w
a(i, n + 1) = Val(s)% o( u, d  k: Y6 m+ a
Print a(i, n + 1);
/ P; t' M% p! V& ?0 |7 MPrint
! c$ \0 S5 {% M0 P3 E( UNext5 d4 W, u- T3 R+ ]5 }

/ f$ T- }! G! `0 Y# g8 \' OFor k = 1 To n - 1 '开始消元  d/ ?+ ]. Q  `! k; f; T4 v! O5 [
If a(k, k) = 0 Then
+ `* e* ~# p) ?  pMsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
0 i2 C3 \8 w+ p6 k. yExit Sub2 ^0 W# O' s3 s6 H1 @) F! a
Else1 |* g* y  ^2 Z2 u! Y9 J+ J
For i = k + 1 To n
, N. z# U- `4 V4 R3 k2 Rl(i, k) = a(i, k) / a(k, k); l: h0 [0 Q! C+ B! \& E2 d
For j = k + 1 To n + 1) Y# R2 ?9 K* {9 s5 U
a(i, j) = a(i, j) - l(i, k) * a(k, j)
# Y& t- X# \# G1 r0 b/ dNext
, j( v+ E5 d7 I" w5 fNext
4 f  P! Q5 m, ]4 w) LD = D * a(k, k)
  r3 L% b! i8 h/ K7 _End If: V8 f& D. t% P2 `
Next k '消元结束0 X  v  Y" \$ f# r& j, K+ |
If a(n, n) = 0 Then/ G, R8 e' t1 R3 o
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!": E) y- K* x9 L7 c* q& {
Exit Sub7 U1 w9 ?% [" z  u
Else
: }6 Q# R) ~) R. `/ X0 VD = D * a(n, n)7 n7 P8 o) j8 C% D
End If
0 m( r& h& l# `0 W. y5 H- }Print "--------------------------------"/ \$ Q/ }) _- g0 ?9 j- ^+ k
Print "系数行列式的值是:"; D5 A1 ]7 K6 L: c# y) G( @
x(n) = a(n, n + 1) / a(n, n)
  e  ~5 ?. D. n1 X; [6 \9 J' `For k = n - 1 To 1 Step -1 '开始回代
+ m8 J9 Y$ i7 Q! tFor j = k + 1 To n
( ?4 |0 W; f& l7 t- U& D9 gm = m + a(k, j) * x(j)7 s2 k) F& ?7 p, c* j5 d8 `
Next j5 C) n5 l& T  A4 H
x(k) = (a(k, n + 1) - m) / a(k, k)
' L+ R; N, y- ?0 O7 j3 X6 Mm = 0
6 ~5 k: r% p% o# w) d7 \Next k '结束回代1 T2 F$ p. v* c" k/ i

: o3 I. A. k/ [; y' A9 jPrint "--------------------------------"
; W0 N* d" R) x4 I# l" cPrint "方程组的解如下:"
4 L4 v! G% M6 b9 N- Y. I4 [9 b1 r/ ?- k8 R) o
For k = 1 To n6 W" o/ @+ B7 }3 \  w1 ~
Print
! S* Z0 S3 q1 O% U- R) V+ BPrint "X(" & k & ") = " & x(k)
5 y9 C8 Y. [5 K/ ?Next k
# m0 E* c. g9 O2 v" w/ c) p+ x! wPrint "--------------------------------"; B! _4 E$ S2 H
Print "其中各行Ax-b="
! Q) {3 n2 X* s9 M8 TPrint4 \9 k2 A9 R3 X7 F8 A+ i3 B& r7 @+ V
For i = 1 To n
& h6 t( ^4 m4 E5 s6 L4 V6 ~t = 0: E% M7 J1 @3 F9 o
For j = 1 To n
  i8 N' C. N/ J, Ot = t + a2(i, j) * x(j)5 _4 i& a: O  ?! h2 R; N) W+ D
Next j; {; B1 f! [' ^7 z; e* [6 U5 _
t = t - a2(i, n + 1)) |! L: J& a( C8 v5 h* q* s3 _; Y
Print Spc(5); "第" & i & "行:"; t
3 D, L9 R$ E1 h% q8 g! bPrint2 u* _8 V3 z# ~  f  `/ Y9 n
Next i
+ n: s- k* O% l8 P/ b' L" n0 n. z7 V3 k' _. U% W: \
End 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, 2025-11-27 03:32 , Processed in 0.437327 second(s), 67 queries .

    回顶部