QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法
5 E1 S; G9 d. k3 K* M& T" `: sDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single% l- P! a% y! e4 @: m
i = 1: j = 1
; P* W& M* z$ [) v9 ~7 M4 cn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
" W3 h1 A- b( ~! q; BReDim Preserve a(1 To n, 1 To n + 1)" J/ @% q, ]: a# Y
ReDim Preserve l(1 To n, 1 To n + 1)
$ K) k, f2 l  V& n& `! k. qDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
; _2 M& Y, ]7 x) V+ ]$ T) ?$ l  MReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
0 p' B* I' |/ i* H* ]! p0 IFor i = 1 To n
% g" g1 l8 c9 {% `: b. Z! ?& Q% |For j = 1 To n- H, L  v6 X$ o
a2(i, j) = a(i, j)
8 w6 x6 D$ t$ I& z2 _Next
# j* X! R2 f0 X& s4 MNext '将a()的值全部赋给a2()
* U5 x) L) f/ F/ s/ t  wm = 0
# V$ d# N( [. U2 _/ [D = 18 R3 M) ~6 [7 S: B# g; c* o
ReDim x(1 To n)# D+ f2 z- T# D1 K' R3 V, r( Y
Print "--------------------------------"
( r& D# t4 M9 t  v3 }" mPrint "您输入的增广矩阵如下:"3 F6 G& h" w5 u" E5 S# Y0 C
For i = 1 To n. e" N7 T+ D+ m1 h9 w: Z7 a( u
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
) R4 ]  X! r, }; D- MFor j = 1 To n' k/ _- g* o" e; |: f, }
a(i, j) = Val(Left(s, InStr(s, " ")))0 w3 ]( ~1 K+ m" q5 k  y! c1 N
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
8 m2 V$ B# m- m3 P. VPrint a(i, j);/ i9 E4 R# I* I7 ^# j/ |$ j- y
Next# @" g5 b0 I& F* J7 h. b
a(i, n + 1) = Val(s). q3 X% T1 j) }! A1 d5 b. Z
Print a(i, n + 1);
: d4 L9 u: C9 A3 G: I0 b7 L, MPrint
" z' Z/ N, D5 J4 M0 ^Next
! j" j' K+ C2 x1 G$ _" x0 q9 }0 P5 o$ @% U3 J1 o5 N, f
For k = 1 To n - 1 '开始消元
) X# d' m4 U) J% F. {" D% XIf a(k, k) = 0 Then6 `0 y) M! Z$ ~8 u# x
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
# `" o( O' K  U6 _3 P  ~Exit Sub" e0 X: Z" L6 N
Else
$ C/ C9 D( h& y2 }! J0 h$ _" |For i = k + 1 To n
/ ]8 N1 @* Y3 l4 K* il(i, k) = a(i, k) / a(k, k)) A/ ~* C  X4 E2 U
For j = k + 1 To n + 16 G* W+ S% a3 U4 @
a(i, j) = a(i, j) - l(i, k) * a(k, j)
2 V; {* H6 A+ P8 ^# tNext4 |$ E5 h$ z6 A2 \. B+ x- W' h
Next
% r$ T' W+ D1 Y% r- w8 DD = D * a(k, k)
& g. ]( ~* f5 v- d% c  h2 _; KEnd If; B5 b8 F# e, e; |
Next k '消元结束
: p9 C, O- X' Q- t6 f# IIf a(n, n) = 0 Then
! k) O5 h& Y( x$ ?3 [MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
* l0 ~  R0 ?! _$ T' V# O7 h; s) L$ ]Exit Sub' |8 b8 l' R8 a: r
Else4 d! C+ \' k) _3 Q# x
D = D * a(n, n)
* Z9 J3 I% |' XEnd If
3 h, G; ~9 g/ g2 Y3 I9 YPrint "--------------------------------"+ a+ \1 i4 ]5 i! d
Print "系数行列式的值是:"; D
+ X" k1 h, F  u: O  tx(n) = a(n, n + 1) / a(n, n)
. @+ y, Q  I* M" G  P  L. HFor k = n - 1 To 1 Step -1 '开始回代2 V. Y$ o1 m* h& D& k
For j = k + 1 To n
2 B" d0 A9 ~+ J. ~% y; ^! [m = m + a(k, j) * x(j)
: [$ T  l$ r# i4 mNext j6 x$ x  \6 P% M3 J$ K1 X
x(k) = (a(k, n + 1) - m) / a(k, k)2 ?! f# S, {8 S+ X, a7 S6 b, W& B9 X
m = 0
- z6 T) S+ P( v% j9 [7 z2 E5 u5 v# H: BNext k '结束回代* G5 T4 T8 a# P" W
% y) [+ y# ^6 C
Print "--------------------------------"
' W1 z  x1 J( I. C: |  ~! D: @+ KPrint "方程组的解如下:"
& M9 u4 w1 t6 X4 b' B8 C  R: k" K# W* E5 r/ n- s
For k = 1 To n8 B; V' u; s! {  Z7 [
Print
& P0 M0 Z8 }9 hPrint "X(" & k & ") = " & x(k)$ q; t3 F# u0 K( W
Next k
! W: P1 c  o  O" DPrint "--------------------------------"
5 u( V; v. b4 Q& h. j  p6 [Print "其中各行Ax-b="2 B" n* d: w/ o4 {. T% P, P3 [
Print
9 ~3 x9 m6 V1 p: [) a6 sFor i = 1 To n3 f4 r4 ?8 Z" K
t = 0! r- M) L- S. j6 T0 v+ _! e
For j = 1 To n
7 m" i/ o. R4 _7 N: Y$ }t = t + a2(i, j) * x(j)
& u3 N3 K& m9 BNext j
. a. Y7 f! K3 k1 q# \1 ut = t - a2(i, n + 1)- T% D3 [5 e: d, M$ D
Print Spc(5); "第" & i & "行:"; t6 m$ @5 X! s: W  `% c. W$ t
Print
5 P% p2 r* V. x5 `Next i
  t& X9 g: I$ o& Q! l& r" _3 ~8 i. s- `( W- I; n
End SubPrivate Sub gauss_Click() '高斯消去法
- u. J1 K+ l) H0 A$ ~Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
, N3 `! c4 R( V7 @i = 1: j = 1
' f' A) [, _* L& g2 \4 v3 jn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
7 f) `/ j* I, K: VReDim Preserve a(1 To n, 1 To n + 1)
5 v. k) ]$ a8 C; Z7 `7 y$ NReDim Preserve l(1 To n, 1 To n + 1)4 N5 }; b: z/ @/ n  A
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single( ]2 m" v' R  B! W, C" ^2 f
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
" l+ t- X2 d& h3 F/ N+ ?6 rFor i = 1 To n$ y$ R; _( t& E5 x
For j = 1 To n
/ O# h5 z9 x/ _: a! {: F' na2(i, j) = a(i, j)
8 A" `- `6 }5 V" f* _& RNext- j/ y! ?( d8 n$ @; [/ Q3 _* y
Next '将a()的值全部赋给a2(): _5 i# I2 J" I  e
m = 0
/ c4 {. n: J1 x' v1 Y0 @+ TD = 10 h( ~2 C6 i# O; ?: D( L  r
ReDim x(1 To n)  T$ }! N& l, K
Print "--------------------------------"* u$ X: y  j* ~9 o3 s6 P
Print "您输入的增广矩阵如下:"* ~' ?/ e$ J: M
For i = 1 To n
0 H7 c" _  t$ W8 ms = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
/ {3 J' t" H  g/ tFor j = 1 To n
4 E* x' F6 _' }a(i, j) = Val(Left(s, InStr(s, " ")))
5 k! d6 B! O; B% a$ B1 \s = Trim(Right(s, (Len(s) - InStr(s, " "))))' a0 g# \: n% N% v6 t9 K9 r
Print a(i, j);
" a! Z7 n% U: ~+ A5 KNext
- Z, h% V  Z5 V% qa(i, n + 1) = Val(s)
5 N" Z- U. `  }Print a(i, n + 1);
1 k' T  b9 D+ |# bPrint6 a( _' k# Z# m* r
Next5 c" b* B; {3 T
# R: b* j! b6 ^2 Y! i( c
For k = 1 To n - 1 '开始消元
* r  A& z& j$ o" w( K  ]If a(k, k) = 0 Then5 ~' _1 ]) `0 r3 T5 S
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
" F+ p' [# M& Q  _% H* vExit Sub4 O) S4 [0 N" m- z
Else8 a4 k, C0 m) Y
For i = k + 1 To n
& h( Z- v& d( q0 _* r: @l(i, k) = a(i, k) / a(k, k)2 o- c+ p& u& T# J) _/ }
For j = k + 1 To n + 11 J8 m8 K* L$ f. t# b$ L: _# W
a(i, j) = a(i, j) - l(i, k) * a(k, j)( Q6 p3 z! X+ d3 L% @# A/ |$ a7 n# V
Next
- o/ j7 R) y9 D, H$ `Next0 L1 l6 u9 f: I, \' Q' v
D = D * a(k, k)7 k2 t4 K& s4 g$ O- }: s
End If# B/ c: _9 {# R& L0 L8 D7 H
Next k '消元结束: n' i  \. x/ B$ _
If a(n, n) = 0 Then
/ J  B* c  k( M/ P, F* XMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"1 D; O( u- S! P# ]# j7 h/ M
Exit Sub2 R, o# k; q" E4 e* q" I! v
Else$ L# ^2 z6 p# ^8 h! d
D = D * a(n, n)8 P0 E& ^, j( Q, Q, ]1 l
End If. I; R7 X: M6 G* g1 z, \1 X3 U
Print "--------------------------------"
2 T. l3 _& {7 J* N1 c# Y( L* IPrint "系数行列式的值是:"; D, F+ |5 ~' W4 a, C# W8 |) `
x(n) = a(n, n + 1) / a(n, n)
2 c1 Q7 [  [0 P6 c: ]8 L. pFor k = n - 1 To 1 Step -1 '开始回代! W- N0 ~- P1 K, E6 t
For j = k + 1 To n
: n4 D' v8 p" L8 k4 Jm = m + a(k, j) * x(j)1 U4 {$ G% h  O3 o" D% X
Next j/ T- L; {' Z8 Y! ]1 c! @7 J
x(k) = (a(k, n + 1) - m) / a(k, k)
/ a9 E( @' `# U1 _; l9 Mm = 0
7 I" V/ k3 V2 a# _" ^Next k '结束回代  d7 [' |1 d* ^4 f' I! p' ?; ]
/ W) l5 \! k8 J1 x- l! C
Print "--------------------------------"
4 z+ N3 x9 Y, z' T5 z# r% nPrint "方程组的解如下:"
- [( |( p$ N1 V+ x7 Z) {4 C, b9 b1 s
For k = 1 To n' S- S/ W9 d5 D+ E
Print
3 D: Y0 J7 N" K4 h- E$ Y; S5 Y. BPrint "X(" & k & ") = " & x(k)
- P1 e  F! f! n6 Y$ ?# [  cNext k
; c, N. s# s' A' d; R- A( {; wPrint "--------------------------------"4 p1 R3 f4 \: P6 I( Z1 ~
Print "其中各行Ax-b="6 w  m8 ~- ]! ^; k7 B) h/ y
Print* N1 z8 K8 j5 X" @% H! p
For i = 1 To n. d" C% l9 Z1 X
t = 0
0 Q, m0 ?) n5 ^7 a8 b. C! l% n6 ^For j = 1 To n" x$ g/ n6 g8 P, N+ L
t = t + a2(i, j) * x(j)/ F1 N1 P2 P( i* |
Next j# o6 v  J& ]% o: Q  f
t = t - a2(i, n + 1)
9 J: ?% Y6 B& O: {Print Spc(5); "第" & i & "行:"; t
! b: d3 U: I6 n1 [$ @+ G$ ?Print( k4 Z: }1 |3 Z9 L6 S/ Y
Next i; G! r- m$ }, r9 R. n% }5 t
. t: N  F0 p+ A. q: |: j7 O( q
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>
回复

使用道具 举报

4#
无效楼层,该帖已经被删除
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-4-12 22:55 , Processed in 4.430209 second(s), 74 queries .

    回顶部