- 在线时间
- 0 小时
- 最后登录
- 2007-11-12
- 注册时间
- 2004-12-24
- 听众数
- 2
- 收听数
- 0
- 能力
- 0 分
- 体力
- 2467 点
- 威望
- 0 点
- 阅读权限
- 50
- 积分
- 882
- 相册
- 0
- 日志
- 0
- 记录
- 0
- 帖子
- 205
- 主题
- 206
- 精华
- 2
- 分享
- 0
- 好友
- 0
升级   70.5% 该用户从未签到
 |
Private Sub gauss_Click() '高斯消去法; G( F, t* b# g+ S, m$ H0 A
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single' ]6 h, r# H" |- K, R ~
i = 1: j = 18 j1 i. a% j8 B
n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))2 u3 d+ ]: Y% n: v' v% m! H- I
ReDim Preserve a(1 To n, 1 To n + 1)2 X- o3 ~9 \, K% ~/ m
ReDim Preserve l(1 To n, 1 To n + 1)& ?3 g% `2 x; [
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single6 \4 N+ |: A) O6 A: l- L$ ~
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
+ r! N8 _; X5 b/ N! `" aFor i = 1 To n, |* `, H1 ] i( i
For j = 1 To n, ?( w+ x$ j# H; u+ S# r
a2(i, j) = a(i, j)6 @# H7 y6 c9 f& M2 m7 m
Next
1 F- ?8 e1 t5 z0 t- I- kNext '将a()的值全部赋给a2() b+ G$ W3 _( [ E' @+ Y
m = 0 Y7 e% i$ W9 c& A5 ]* i+ {
D = 1
6 Y+ q& |: K7 p' r: Y0 j+ p( NReDim x(1 To n)
& y8 }/ R1 w- x* `Print "--------------------------------"
% q" s. b* d APrint "您输入的增广矩阵如下:"- X6 _$ v6 P) l( W1 ^$ b& o; Z4 `
For i = 1 To n
# R- k+ N8 P5 }5 C& Z* b7 ?' Rs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入")): R& `3 O% v8 e' n/ F1 f
For j = 1 To n. _1 J1 T# a U
a(i, j) = Val(Left(s, InStr(s, " ")))/ s, i2 ?; L4 t2 p; y- B+ f
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
# C- ]: L4 y% U( k( [Print a(i, j);; W$ }% ^9 e2 Z# D, |
Next+ S! @* I) Q' D1 q c% Q8 G
a(i, n + 1) = Val(s)
% O- }0 C% g" Z' w, }Print a(i, n + 1); O# W4 u D |) @% K O9 T; F! v5 E
Print
. {% Q8 {1 ^% L/ S8 hNext
3 y! |: n, \' @+ P" L4 S3 r1 O
2 E8 K, a/ R6 s% c% OFor k = 1 To n - 1 '开始消元
. X" Q' r. x6 s$ Z+ \" RIf a(k, k) = 0 Then
; d* u! _2 I c6 L' }. [MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"" y& p# r) `- M
Exit Sub- ` k/ Z: B# h# E1 i1 y& S
Else% v3 n8 [5 @5 U5 U8 ?
For i = k + 1 To n( a- U% ~( S' h7 o$ C
l(i, k) = a(i, k) / a(k, k)+ D/ [$ m3 ]2 q% @& v# J% n2 G" a
For j = k + 1 To n + 1
) h) p u0 R, C1 }a(i, j) = a(i, j) - l(i, k) * a(k, j)
, c5 V; P+ t5 l; e- iNext
" C8 V4 ^+ V! C% a4 F3 {Next
5 G0 n* Z6 Y0 w% \% V9 i" M. o3 T/ \D = D * a(k, k)
+ c, c% U# W% y" b m6 i. F. qEnd If8 N& u! E; i; j; H! I
Next k '消元结束
# F+ E7 j8 y7 R( B* }If a(n, n) = 0 Then
9 C* s$ b4 ^9 p1 p- B& f# CMsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
; T2 e. w. f8 m: b% J9 aExit Sub- `1 k7 d9 f/ Z
Else( ~: [) e. y+ C3 K4 z( q
D = D * a(n, n)
5 D# O7 D; B- g) G mEnd If
' \/ K9 y* @( YPrint "--------------------------------". J$ `& J( v5 {2 a: S7 J7 s3 z
Print "系数行列式的值是:"; D
3 a5 x# V- x, D% o+ E. l" Mx(n) = a(n, n + 1) / a(n, n)( N; P! v' _+ k" u) Q) A/ ]2 Y" a% d
For k = n - 1 To 1 Step -1 '开始回代
+ a( e: w/ t0 Y2 Y" F. M, uFor j = k + 1 To n4 W o5 W$ \ q& J
m = m + a(k, j) * x(j)
1 d+ o- u* W' R3 C) L* C8 M! ~: J1 iNext j
( V0 h2 V/ D! S! |. cx(k) = (a(k, n + 1) - m) / a(k, k)! J0 B8 w; I* A4 Q+ p$ c& A. |
m = 0" z) y( Z8 O6 y& ~
Next k '结束回代
- m+ D" a4 r9 \0 @% S, m8 p& M: L, ~1 h
Print "--------------------------------"8 e0 C& _0 D# G& x
Print "方程组的解如下:"0 m$ l& H7 X- Y1 D: R" x5 o& ?) j
% C1 C; u4 y* E$ g7 t0 L0 b- wFor k = 1 To n* h" T# q: E9 t
Print
% N/ A: S+ h: cPrint "X(" & k & ") = " & x(k)
$ R# e ]+ u) {2 w+ y+ g3 eNext k9 I4 h/ B. K) l" `5 ]6 P( g
Print "--------------------------------"
# C( ~7 E; a, I( _3 tPrint "其中各行Ax-b="
5 W T% Z" M/ X1 K3 o' p6 _Print7 T0 t1 j# b7 x& \
For i = 1 To n9 b2 ?$ m/ r% I4 J1 G5 _9 }. |
t = 08 Z0 f! S; G9 b# t5 u6 X
For j = 1 To n h( G& x6 {) v, g) \& m! O# n2 b
t = t + a2(i, j) * x(j)
3 Z( }$ }1 N4 JNext j
$ b/ z- h: J2 z# }/ c6 Ht = t - a2(i, n + 1)
) I X6 R+ y$ L4 H9 ZPrint Spc(5); "第" & i & "行:"; t
1 f7 _# O" k6 N& c) i3 B, KPrint1 X( _2 q3 U% W) F
Next i: @/ V" z2 A8 E1 e
) b1 j. |/ d; L" c6 y) JEnd SubPrivate Sub gauss_Click() '高斯消去法
* t& \3 v3 J8 ]7 BDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single& V! m& i/ z( d4 V
i = 1: j = 1
( m2 s- p! \5 Q# _3 X2 i, S: P p5 E9 Pn = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3))
- ]6 I$ ~: q k+ `# f) uReDim Preserve a(1 To n, 1 To n + 1)- p" n }7 ~. U/ d% {
ReDim Preserve l(1 To n, 1 To n + 1)
( q2 Q7 Q7 p' d) h1 eDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
e6 H" G7 ?7 }/ _ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()% Z( J5 c' v1 `$ N6 \
For i = 1 To n& w/ Q) t* Z, @" P8 B
For j = 1 To n% b/ N* W' b! j7 }9 D; y- I; k- _
a2(i, j) = a(i, j): b& E7 |; d4 W( E+ H
Next
# n! i5 L' V& c+ jNext '将a()的值全部赋给a2()
$ ^& R' e) g+ Pm = 0- z( w4 ^* q* E4 H! j+ f3 ^/ C
D = 1
% S8 U! Q; ~3 o/ ~/ F% j- NReDim x(1 To n)
0 K8 `) ~6 g; O" a1 D1 e `Print "--------------------------------"
- _8 ^( |+ c, {* e: s8 Q1 r5 PPrint "您输入的增广矩阵如下:"
$ Z4 l+ m. a M; j" o6 }: PFor i = 1 To n- b" A7 L6 q3 d0 W
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))& E- i& }( m# j: d; P, X9 T
For j = 1 To n. K1 V0 `. Y+ V5 H2 X& Z
a(i, j) = Val(Left(s, InStr(s, " "))): J* I% T0 `! ^4 f9 V _
s = Trim(Right(s, (Len(s) - InStr(s, " "))))! V) |& T' `5 i" H5 B- f' R# m: t
Print a(i, j);) t2 J( X$ B& j: Z0 f
Next
* W( m4 K) n# Ea(i, n + 1) = Val(s)
- i1 y! V2 [; ~2 j5 o$ hPrint a(i, n + 1);
+ U9 l; R+ u7 A' }Print
( v, f1 C7 Y7 I. dNext
0 s [8 W4 ~& X. P
% X: k! L: {" v6 S1 |5 ~) Q. a9 jFor k = 1 To n - 1 '开始消元
+ i" m" U) J( m" X: FIf a(k, k) = 0 Then) h e/ g, q- G* s% L
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"
3 Q+ N! d S' H1 V+ E6 HExit Sub9 I3 N; F6 n9 [% `& m, e
Else
# V- v# n3 N0 |" G/ Z$ ~. `For i = k + 1 To n3 o% ^) @* K, I
l(i, k) = a(i, k) / a(k, k)
. E' r% I6 |* h6 C1 S7 ZFor j = k + 1 To n + 15 }- w1 U+ h" C1 \2 L: }
a(i, j) = a(i, j) - l(i, k) * a(k, j)
0 h1 d( j0 E: H+ h& ?9 n; o/ }Next4 _; R+ p( h3 W7 T
Next9 A( {- W& b2 w. k: y; e
D = D * a(k, k)! h- q0 s4 N. V9 \; a# A
End If
* C" G; K0 C" |Next k '消元结束
7 y) ~* T2 g9 @* h& Y! aIf a(n, n) = 0 Then
9 t: T6 V% m: j6 ]MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
! E5 L8 K) j1 K' A3 IExit Sub
# h6 y, U* E6 k" R8 Y. `. uElse
4 b3 t" W4 ~4 ?4 X1 l4 X2 OD = D * a(n, n)0 d w" a! T9 a+ {
End If
% I7 d' W9 S6 K8 c) i( NPrint "--------------------------------") B# E- ~; I+ E4 A# K0 F( m4 ?
Print "系数行列式的值是:"; D
; ?1 e7 c/ E9 o8 ?' Q5 d2 n! B8 [x(n) = a(n, n + 1) / a(n, n)7 p/ A- ~( ^& Q1 y+ j1 G7 o7 C7 X1 \
For k = n - 1 To 1 Step -1 '开始回代
3 v& F0 ?3 c# {$ gFor j = k + 1 To n
7 Q) y2 R- o* Y% K! `4 e& M: Gm = m + a(k, j) * x(j)
- W$ I1 G5 H- `9 J, s! CNext j
/ r* I1 ]' R f7 z, ex(k) = (a(k, n + 1) - m) / a(k, k)
9 `2 |" r9 s7 a; u3 ~m = 0
9 [2 z4 [: \4 @% r/ B0 I- nNext k '结束回代- ~# ^6 v5 L: P: ^/ z
- v% Q8 T `' W7 f% x$ L5 @Print "--------------------------------"$ K3 ^4 u" o7 t
Print "方程组的解如下:"
: ?$ |4 M8 z, c& b% F+ ^
4 s4 N s$ D# t$ e' `For k = 1 To n
9 ]2 a8 |/ k. \/ C, d5 E2 OPrint6 a% i- _' U f9 Z! M1 L1 `' A8 j
Print "X(" & k & ") = " & x(k)8 F4 \5 S2 `3 M! _/ c
Next k9 h. S$ F7 n2 {! f' C
Print "--------------------------------"
+ y9 {6 @# W+ y; \+ ]$ kPrint "其中各行Ax-b="- R" V5 y4 k- q8 B1 I( n! o3 T
Print: n$ G( \) C M6 h' }
For i = 1 To n
- K6 ]+ p4 b& nt = 0
7 r8 {7 w: l7 h1 B! i7 m; ZFor j = 1 To n; S) |( H- a3 U! j" L- Z+ O
t = t + a2(i, j) * x(j), L1 W4 ? O" z2 l# W. \
Next j6 F8 P: W* j) Z+ ~% I
t = t - a2(i, n + 1)& m& ~7 {# D9 p
Print Spc(5); "第" & i & "行:"; t
* _& h0 g9 W2 m7 XPrint
! r% _- |: H2 N& h0 eNext i$ O6 ?/ Q9 x0 w7 @5 @! i
% \* ^6 J8 ^6 R1 U) s8 ]8 G' [
End Sub |
zan
|