QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法; L% E7 \0 M) H; ?* U4 G% C4 e
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single% I( {  b0 X. r
i = 1: j = 1+ Q& c. [7 z& z, e7 j
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))# \5 A' ?" f- K. i+ [& i
ReDim Preserve a(1 To n, 1 To n + 1)
" s- U+ g0 n7 g2 `0 P5 M1 |ReDim Preserve l(1 To n, 1 To n + 1)  \; ~) D3 Z- O: v. V" f& g& a
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single* o6 j+ l5 i+ C) i. e
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()# P: N% w/ V: }% m  D
For i = 1 To n
/ w2 E  I: c) h' Y9 @+ Z( [For j = 1 To n
! f( V+ m: b) W, r6 `% _a2(i, j) = a(i, j)8 u* H( V% Z2 R% N( T/ \
Next) s; o4 k- Z9 b/ p. n
Next '将a()的值全部赋给a2()3 e% g1 M% s* G6 a# k) ~
m = 00 o# H' a- A3 H! B
D = 1
1 W2 o; J9 A" SReDim x(1 To n)
# W6 d( d: H0 Q- Y% `Print "--------------------------------"5 Q0 K" C" C1 p9 }0 u
Print "您输入的增广矩阵如下:"
, J) `# S' a  @$ m' jFor i = 1 To n
* v2 H. }' v9 e+ i" _8 d6 |s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))+ v9 G+ h, z5 c9 Y' G* r
For j = 1 To n
4 A* R( m* T9 ?" ?5 [$ X( L) T7 ya(i, j) = Val(Left(s, InStr(s, " ")))
: r# b1 e& ^2 a2 hs = Trim(Right(s, (Len(s) - InStr(s, " "))))
8 g5 I9 W& |7 _; w- \Print a(i, j);7 H" }* a3 D" ~% L9 b1 b2 B
Next
; R1 u- I' K! {& u6 Ca(i, n + 1) = Val(s); i: B) U3 J3 d
Print a(i, n + 1);! g+ j; |* c5 g5 j" X
Print
$ v9 `  ]! {% r& [* k1 y+ c; HNext, Q9 T; ?% U& ?' f; o

) @! S5 c7 @! m* q6 q1 Q9 MFor k = 1 To n - 1 '开始消元) `% e! Y5 Z2 @( F2 B4 O# |
If a(k, k) = 0 Then% n6 y5 U* O0 e( {! j5 _2 R
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"$ z3 W. @& e2 V3 {$ }
Exit Sub
+ ~2 n& P, G8 w8 _Else2 o! _6 i; X! d1 F+ B; J
For i = k + 1 To n
1 a2 ?3 {" A8 A+ M4 ?) l1 sl(i, k) = a(i, k) / a(k, k)* i' Z/ c6 d( Y
For j = k + 1 To n + 1
2 |+ [% G; B1 wa(i, j) = a(i, j) - l(i, k) * a(k, j)
, c6 I$ F: H  [8 l% ~. hNext
- j+ ]  |3 F1 _' x1 ANext, N8 E. m6 B7 M9 g, C
D = D * a(k, k)
; z0 J3 }4 b$ d( l$ GEnd If% b" ]7 B0 J2 L: s9 S
Next k '消元结束, i. O" o9 m: [8 w- a6 j7 W; G
If a(n, n) = 0 Then3 g$ }4 ~; H, c& E" X5 X
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
- Y- a" q) N  `6 p7 jExit Sub0 _  A7 g+ u' N
Else7 T" T) T- h% C$ d# b+ Q
D = D * a(n, n)" ?% V* J1 X, _1 {9 U" {* a; F
End If/ t7 p' _% Q" [  U# N
Print "--------------------------------"7 Z( `7 d0 J2 z% X" E" H
Print "系数行列式的值是:"; D
7 Y+ \) M, Y, N  i0 |( zx(n) = a(n, n + 1) / a(n, n)! \7 U9 j# ]3 C3 u5 @( G
For k = n - 1 To 1 Step -1 '开始回代2 ~' A" |2 C! u% ^1 |
For j = k + 1 To n
: Q8 d1 C/ r( m5 J3 J( Fm = m + a(k, j) * x(j)
8 X4 T* w& G' lNext j1 n, X& o  @3 U3 |- W( X
x(k) = (a(k, n + 1) - m) / a(k, k)
( I$ q! {' w9 q- L; [( Em = 0  I$ e0 X  K& i) X
Next k '结束回代& z5 q- U' Y) k; \

. k1 z6 w/ i- N! a& s2 wPrint "--------------------------------": H# T$ ?& Z* i" @5 R2 Q
Print "方程组的解如下:"
) L* f6 Q0 e8 e. e; S) R) T2 u8 e+ ]
For k = 1 To n! T8 K" b$ l0 b  U
Print
  Y( `, W4 L2 ^& H) M2 _Print "X(" & k & ") = " & x(k)$ T# k& R5 I6 ]9 C1 l; ]) S( [4 Z
Next k7 r5 N% b$ I6 w+ _2 S, J( E
Print "--------------------------------"! x' D; R( t! Y! z* h! R
Print "其中各行Ax-b="
; `- l: b; E& vPrint% n" T1 m3 a' H( j& Z8 g
For i = 1 To n
6 ~( G( g4 s- ]# Mt = 00 R' z' Y" b/ t9 C
For j = 1 To n" @- ]: _3 n/ N$ P* {9 U
t = t + a2(i, j) * x(j); e; F: @& E3 [) |. O, Z
Next j
' h. B  g+ H; O" ^* P' ^3 Q2 Lt = t - a2(i, n + 1)* r0 i7 @2 J5 f/ W/ N
Print Spc(5); "第" & i & "行:"; t, I. h+ K( Y9 ?& p. \( |: y
Print
" M/ o* H) d5 x; h1 d3 ]Next i
7 X6 \/ \, T$ q( _# z/ F) Z8 `) I7 `9 S  F" h
End SubPrivate Sub gauss_Click() '高斯消去法
; R/ a+ X8 d2 r2 P! [Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single8 E0 j. e( g5 m5 @) A. m
i = 1: j = 1
! C2 k( ]. g  C5 ~n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
8 \, K* Z: b% t' QReDim Preserve a(1 To n, 1 To n + 1)
" Z3 q+ r- o7 f; aReDim Preserve l(1 To n, 1 To n + 1)
6 `6 A8 z, [$ n* B7 }" w, e, k2 A# fDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single# {! X" [) X: m/ A+ K+ [* ]8 k
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
) n, z! U% A$ i9 J: b( B. H: HFor i = 1 To n
4 C1 l0 T1 X1 C  k: Z  _6 RFor j = 1 To n& [# x* g3 R, R8 f) p% U
a2(i, j) = a(i, j)7 A2 [. u; R1 w7 T+ \: V
Next0 c0 f) V, Q  ]/ ]: j: W
Next '将a()的值全部赋给a2(), B. [0 P3 w5 t" A% y% E
m = 0
2 D1 q2 [/ W  S; ?- F6 Z% x4 w" m5 SD = 1
) W+ ~- D5 E  jReDim x(1 To n)
, ^+ M' E5 e3 {7 B5 k4 X8 KPrint "--------------------------------"
& m9 J  L$ P1 [8 ]8 I7 UPrint "您输入的增广矩阵如下:"
: p. ^- N6 _/ N/ {7 o( Y+ kFor i = 1 To n
* M. O1 l  z( B8 H. I: R" w  |s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
4 J- `8 i# Q0 Y4 {# OFor j = 1 To n6 w0 a9 E& Q  ]4 P; i3 t
a(i, j) = Val(Left(s, InStr(s, " ")))5 T2 u" y( m2 u1 i' a
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
0 G! K7 I9 R* Q% o  MPrint a(i, j);# X4 G* [  a0 J; H3 H- n( E! s6 K
Next2 l6 X- g3 E) q& t( E% Z
a(i, n + 1) = Val(s)
: m% n5 C& x( i& [# a4 u& c; iPrint a(i, n + 1);
" f& v9 O) L5 K  h* O( \Print' P& O' V6 L& Y- X/ @, C2 ]
Next
: _+ c& [- n- P% X+ U* ~% G4 m7 q: ?
For k = 1 To n - 1 '开始消元
! e  i  F5 G+ u0 I' \If a(k, k) = 0 Then, v3 o9 r9 L" T5 ?1 b7 \
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"# x3 h0 s0 @$ ?4 K/ Z1 r
Exit Sub
  I% o8 Q) Q5 v: r5 K0 bElse
5 y8 v1 p0 G! S& d  S! {For i = k + 1 To n
3 T3 j  d( b" m& jl(i, k) = a(i, k) / a(k, k)7 K) {' L3 K" T" A5 s7 ?
For j = k + 1 To n + 1
8 k: h' D: M) t$ ]a(i, j) = a(i, j) - l(i, k) * a(k, j)" b! a/ `9 Q2 ~$ s
Next
8 [* L9 V, D/ Y) {. r- k! M8 O3 `9 dNext
- i$ H/ R! ~4 `2 @2 O* I0 iD = D * a(k, k)% ]& _) N$ J5 \9 q
End If
* F4 a6 @8 n5 SNext k '消元结束# L4 Y1 C7 m" o8 `7 {% N3 y6 U
If a(n, n) = 0 Then
' S/ \2 z% B' T; ]+ ?# DMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
! Y- F: F3 Z* `9 d/ S, d( f  b( \Exit Sub# N! H; H( U& I2 A& U, w4 |
Else
! @% L* D$ \0 t% C% OD = D * a(n, n)
. p, o" c( B) C  a" Y7 w9 PEnd If& n/ {/ w  k7 Z  ^
Print "--------------------------------"
+ o1 k' Z% s5 E) Y- N3 Y; q# APrint "系数行列式的值是:"; D
5 B& l7 }+ I# b& o$ v8 w1 jx(n) = a(n, n + 1) / a(n, n)
: Z: J; g6 w( jFor k = n - 1 To 1 Step -1 '开始回代
  W0 D! b; C" J- P& }) CFor j = k + 1 To n
6 h2 h( {, H6 M% i% zm = m + a(k, j) * x(j)
( A# w4 F- x, y. K% SNext j
* n- p' Y* E: K% {( z8 wx(k) = (a(k, n + 1) - m) / a(k, k). s" [; Y% X& J. a
m = 03 x* R- k( z0 h/ V+ j4 K; h
Next k '结束回代
3 T. t/ p' \* F3 _% i/ t3 n8 B1 V/ I: g* F1 E
Print "--------------------------------"
. @: K2 S  J, t; J4 p5 WPrint "方程组的解如下:"
/ D0 ^: t* C' Y8 c
. m. ?/ K8 M; Y/ \For k = 1 To n; a5 Z/ B5 H0 r& i8 ?3 ?8 Z
Print, r9 W% l5 Q3 ~. u
Print "X(" & k & ") = " & x(k)7 x1 n" k* ?% B( X2 E
Next k
8 |/ k2 G3 Z, z: {4 C/ ?: }( QPrint "--------------------------------"
. p/ w: s3 a" T! I, X2 i, APrint "其中各行Ax-b="$ E! g  w' Z4 S+ D% S0 U% J$ ]8 h
Print
& q( d! O7 }+ B  d8 [6 AFor i = 1 To n2 H" v- {9 M# T! W% M: I% ?
t = 0
8 _2 K/ q" }$ Y  kFor j = 1 To n
! g* P3 a/ @4 H" h! k3 u) N, ~& Qt = t + a2(i, j) * x(j)
6 n5 e, ~5 Z0 n5 m/ F# L5 mNext j- m/ M2 u* b" p1 i3 V( J4 v  E7 d
t = t - a2(i, n + 1)" k  u$ n0 l# B3 B
Print Spc(5); "第" & i & "行:"; t
$ H; i' u1 B/ H1 GPrint! d" l( _  ]4 B; Q1 U1 h3 ~
Next i
, s: [6 n) ~- q0 U* M
$ X  n$ M/ |: ?& W3 M; c6 {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, 2026-4-14 22:47 , Processed in 0.436971 second(s), 68 queries .

    回顶部