QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法
8 V. X& y: M' _8 {Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
9 }8 [, f$ m' \: f6 y. P, z, Ji = 1: j = 1
$ [4 l6 u2 \6 S* H' M+ An = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))& y( [) d7 d: y) |  j6 r- z7 ]9 r
ReDim Preserve a(1 To n, 1 To n + 1)
, O1 |2 x4 J2 {6 |: uReDim Preserve l(1 To n, 1 To n + 1). P( F( Z0 ]! G% S% [
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
5 W# ~+ f  y# X/ ~. g4 BReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
! Q; w  f( i! q" TFor i = 1 To n
0 J6 V: S0 A% z* p+ w* \6 pFor j = 1 To n
5 g5 e- K7 M, A; c4 g5 |3 \* Ga2(i, j) = a(i, j)+ d% p  }6 V6 A  P: x
Next
  q4 w% a- \/ V6 f  G+ |  t5 VNext '将a()的值全部赋给a2()
# S$ t+ Q. S( ?* j. x  @# ?9 R9 qm = 0* n5 l* u: @8 }& M% h6 h9 T' U
D = 1! s2 E: A9 F* E! S0 E
ReDim x(1 To n)
+ o; q& i* \" WPrint "--------------------------------"
# Q' J5 M7 \8 G8 BPrint "您输入的增广矩阵如下:"
6 |: v; b" y" n6 LFor i = 1 To n0 u4 j3 n& l4 W3 m$ C* y9 p7 S
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
! q+ ]4 e- |3 Z2 e  L5 M: |- EFor j = 1 To n
3 C/ y& C( ]6 ?$ }6 i0 Oa(i, j) = Val(Left(s, InStr(s, " ")))0 d. V$ U+ Q  w
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
( P( _3 u& X5 M3 N! `0 g; I3 b. cPrint a(i, j);* |  F, y( \" p  Y1 o
Next
0 v7 S" ?; h: G0 I3 l: j3 Z  ~a(i, n + 1) = Val(s)& f* q4 D8 }9 E! [# i% X  k
Print a(i, n + 1);
. @# E0 c' }" X  m1 b, P5 f! UPrint/ D+ ^' K) A3 C) k+ d. S$ X& |
Next
  ~2 ]( X) a) @6 ]( ?3 P3 T
2 M4 [$ H9 J/ M% H. k. |For k = 1 To n - 1 '开始消元
* \2 ^8 y. g" v; M0 HIf a(k, k) = 0 Then! l& ~- ]! b, t( \2 v  Z
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
# k% }$ r% r6 p; `( h1 MExit Sub
" v- f. K9 {& Q. T/ E! o# lElse( g# g0 c3 L  g7 f: V
For i = k + 1 To n, r1 ?! r7 u* K. Q. Q
l(i, k) = a(i, k) / a(k, k)
+ o# ~% n: {6 L7 O+ `, e, K$ FFor j = k + 1 To n + 19 p$ w2 I4 f6 f
a(i, j) = a(i, j) - l(i, k) * a(k, j)
- T) r, s( H3 Q8 _" A( BNext
/ I' X4 }" M. t2 s" w7 ?) ]! L' wNext
- A6 C9 J- n2 f2 \D = D * a(k, k)$ ?6 f9 ]  w) \& \( q# t+ c1 T
End If
# J. d3 [8 k2 u  ^0 N' RNext k '消元结束, H5 A7 j1 G8 N& ^
If a(n, n) = 0 Then6 F, F5 X' z1 F& v$ S. D- h# G
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
' P9 T! u  v# p7 @1 ^& @: d! [+ V$ oExit Sub  L+ k6 @8 X6 B" }; ~9 M- e' d
Else3 \0 v+ q& j: b
D = D * a(n, n)
4 n' D8 P- y6 J) n% o, V% HEnd If
7 H  f/ b8 a$ o: z! RPrint "--------------------------------"6 T( y6 ^0 S/ v0 e4 z3 z& i- _! A6 r
Print "系数行列式的值是:"; D! q' y! m1 G. J; x" Z  i+ s$ t
x(n) = a(n, n + 1) / a(n, n)0 l  s. n4 O2 h( y1 w3 t6 C
For k = n - 1 To 1 Step -1 '开始回代+ b# q* l# z: N2 R
For j = k + 1 To n
4 n9 I+ @4 }. _/ i* B4 I4 A- ]" dm = m + a(k, j) * x(j)
3 f- m4 P) x) M. D& @/ |  Q7 [Next j
+ e$ ^+ T" ?! Q; Y* X4 x' |x(k) = (a(k, n + 1) - m) / a(k, k)1 K: ?0 f0 F3 Q
m = 0
) s! a6 e" E! m& @1 q$ tNext k '结束回代0 G) _9 m/ Q+ D( M

' j& D" y/ x0 v$ s) B* ^Print "--------------------------------"
, Z7 |  e; ~. X3 dPrint "方程组的解如下:"
5 l) F# M3 q8 y* E% t, b, Z% M. `9 O) C: |
For k = 1 To n- e" x- ?& i" b5 i8 X
Print5 m3 G# P8 _  v
Print "X(" & k & ") = " & x(k), m$ y% E- y/ A& M/ V, O3 w* D
Next k' q3 T2 A3 `8 u& e! O7 x" ~$ A
Print "--------------------------------"
) q% G2 [( p3 {3 [& DPrint "其中各行Ax-b="
5 S  I. {9 }% T9 GPrint
9 V& `! c. b- i% l% iFor i = 1 To n
) Q. T/ C, z; P  M. p+ Jt = 0
: v4 N' i8 Z8 D# M- n! Z. a" kFor j = 1 To n
- B& }! f3 g. {, ft = t + a2(i, j) * x(j)
9 r- F+ l3 t$ @* l% o% B" c% t0 zNext j
0 s6 I  `. n2 B) y* T1 }t = t - a2(i, n + 1)
3 Z$ X# \8 L  B. APrint Spc(5); "第" & i & "行:"; t
) \/ y( W/ a2 D9 m! mPrint4 R; Z: e5 C# Y  ?0 j% I
Next i6 x) w& Q' j1 p: n9 c, `

0 v3 a' H! L5 M, l& x0 ^End SubPrivate Sub gauss_Click() '高斯消去法
/ v* O3 W, d  b2 `1 S9 C' vDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single0 Q! C- Y' U) ?4 ^( r- {( U' N* M
i = 1: j = 1+ s1 t! m+ ?) ^2 J; J; {
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))+ u; t6 ?5 [! n7 l$ i  V
ReDim Preserve a(1 To n, 1 To n + 1)  ]6 M% [4 s2 H
ReDim Preserve l(1 To n, 1 To n + 1)
5 |" }0 v& n9 E( i7 a* mDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single: _9 ?( M6 R0 P; y
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()& N, m4 a" K) f- u9 y+ K
For i = 1 To n% E9 ?3 {' z" Y* _5 J$ s: t  }" }. S2 l1 D
For j = 1 To n- V' j( P: M" l4 K. F2 @
a2(i, j) = a(i, j)
- a3 l3 B  M3 N1 h) j  V- aNext9 D4 Q/ [, |6 f' v: t9 n( C
Next '将a()的值全部赋给a2()
5 Z* `  r: e) B" U# Bm = 00 [% ?2 w5 k& I- N( o
D = 1
  q! s' `9 s6 `( _5 D" v- HReDim x(1 To n)
6 F0 x4 d* p* _+ d/ H' wPrint "--------------------------------"
: u: n$ `" Z& g+ e3 YPrint "您输入的增广矩阵如下:"- y7 w' O/ w# R* _6 N0 }. ?
For i = 1 To n
9 b( N4 @$ C5 }9 M3 q* \1 a2 Y/ Bs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
! T+ I4 @, {3 n" ^# X: E- zFor j = 1 To n
$ f* ^5 M7 u& o. V/ v" f- M+ Ja(i, j) = Val(Left(s, InStr(s, " ")))% F, W) ]$ M$ m6 l! c* `
s = Trim(Right(s, (Len(s) - InStr(s, " "))))4 F, U( q* @/ H8 P
Print a(i, j);8 O& X9 y5 x6 m8 _; c9 o7 Z
Next
2 `. \3 @# L7 d6 f1 Da(i, n + 1) = Val(s)
8 }+ n* p+ b! n2 ?* GPrint a(i, n + 1);
3 `  K+ {  g$ Q* G# n4 pPrint
9 H/ @/ p5 I$ y6 h% \6 LNext4 a. x* v7 |$ M0 _2 [

. b6 A1 h) @; H% N/ ^' ZFor k = 1 To n - 1 '开始消元& C7 Y/ c$ Z% D- _  O; E9 [
If a(k, k) = 0 Then: H; _) D8 `# m
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!": v- X& n. V& B$ c# X/ G# L
Exit Sub' P6 T- ]: E: M/ a$ x8 m2 y4 P
Else/ X+ j0 o+ C6 {8 g+ Z  u
For i = k + 1 To n
2 J1 ~+ \$ i, ]. J6 h( M; K9 Il(i, k) = a(i, k) / a(k, k)
+ |/ e. {4 p8 @! Q7 eFor j = k + 1 To n + 1
" Z- L5 Q( Q$ ]8 i4 ma(i, j) = a(i, j) - l(i, k) * a(k, j)
7 ?) [- @! Y' d% H6 Z: Q5 I+ eNext2 O. K" I' g7 ?: M7 L% I% z* ~# w
Next$ z8 ^1 Z! @# ?# @
D = D * a(k, k)
5 q! f0 k, a+ lEnd If
, Q5 ]1 ~( S' W# u7 `- ANext k '消元结束2 }2 c6 i+ y4 C. s  ~. U$ y
If a(n, n) = 0 Then& x: U8 h8 s' y7 R- D/ ]  t
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
- X9 v9 _& B$ ^- ^+ s$ nExit Sub
- ?! F2 H4 Q& y' t( q) }- l0 WElse: _. e1 J" |6 ~  B# A1 ~
D = D * a(n, n)
' y( E. c- F  Z+ C+ L$ G8 gEnd If+ {# }" ^: v3 j' k4 X! t) z4 L
Print "--------------------------------"+ O1 a# V+ K" s- M2 X8 w. c% J
Print "系数行列式的值是:"; D
9 n7 X- M  y- Kx(n) = a(n, n + 1) / a(n, n)
' R0 R2 h4 M" H/ x% I& jFor k = n - 1 To 1 Step -1 '开始回代
1 c; l+ M1 u/ R% i( [" kFor j = k + 1 To n
& L4 r( \0 `" D; Um = m + a(k, j) * x(j)# }% T% |) v: G' u
Next j
) ]4 r; F; ?. f7 f+ Px(k) = (a(k, n + 1) - m) / a(k, k)2 w; W6 s5 l/ g5 _6 `
m = 0
/ D6 A- {5 ^6 z: v& q8 TNext k '结束回代% I$ R9 I4 n3 g: I$ s; f6 @  d: x

1 f( o/ s: U' {& Q0 X  B  tPrint "--------------------------------"2 T6 {' K# e: ^  N6 s
Print "方程组的解如下:"0 o3 H0 Q' A: w  u) O3 M
/ n5 k& j# \/ p1 ?
For k = 1 To n2 o1 i- Y( d! n# o, x. s
Print
$ o8 _" N" U1 M" y$ zPrint "X(" & k & ") = " & x(k)
6 A; S8 y( `5 q- ^2 n% oNext k
* w$ w1 t/ N1 }8 b" p/ f% tPrint "--------------------------------"
9 ^, z0 l; D) W" L: kPrint "其中各行Ax-b="
2 ~7 A/ d* k  {; W, L5 U# bPrint
7 }; Q: W9 _1 J) J4 M5 X9 W. lFor i = 1 To n- f+ a) r' z* B: ~+ Q+ j
t = 0  e$ r6 b3 {. B1 m. r9 O( T: {8 A
For j = 1 To n+ H* O% g. E; {, D4 c1 u: D' W$ l
t = t + a2(i, j) * x(j): T  Z: M. T( @, M- Y9 G
Next j
8 @) ^& b7 ~  i+ S6 it = t - a2(i, n + 1)4 y3 ?! K+ |( T7 `- p. w
Print Spc(5); "第" & i & "行:"; t+ S! {- E! p; \, g
Print
0 \# e* l( Z' nNext i" r6 p# E- r3 |5 B0 Q+ m# v

& J" q+ E! e! D; [3 b; O% X% zEnd 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-1-3 14:56 , Processed in 0.711636 second(s), 67 queries .

    回顶部