QQ登录

只需要一步,快速开始

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

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

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

206

主题

2

听众

882

积分

升级  70.5%

该用户从未签到

新人进步奖

跳转到指定楼层
1#
发表于 2005-1-19 17:03 |只看该作者 |倒序浏览
|招呼Ta 关注Ta
Private Sub gauss_Click() '高斯消去法, @" Q1 |  [& N4 Z3 T4 P, f
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
/ ?# j9 v) a/ K" d  Vi = 1: j = 1
8 G: K" S# Y& }0 J; ?n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3)): M8 r" N2 ^  V4 G) f0 f
ReDim Preserve a(1 To n, 1 To n + 1)
/ q0 D7 {$ t' k: @, M7 C3 fReDim Preserve l(1 To n, 1 To n + 1)
0 m! w& G( r8 I& {" g/ n) ZDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single, ]/ z/ _; F% g3 U4 C
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
/ e; f  `7 e) ^" u6 }For i = 1 To n' H7 \' r" R5 a  O" a, s& T
For j = 1 To n
1 S" L- }+ a) F7 Na2(i, j) = a(i, j)0 @) q" ]- q! B% h/ w" B3 U, c
Next' S8 w9 E# q, H" S3 v
Next '将a()的值全部赋给a2()4 z6 t6 o+ h6 @' ?/ F
m = 0' J$ r+ u- P7 B; t2 j" q( m
D = 1
5 u% X2 l; E2 ~( l: w" G1 e5 JReDim x(1 To n)* _" U. N% t! S# r% i; ^' |
Print "--------------------------------"& T+ [) _* |% |, w
Print "您输入的增广矩阵如下:"% ], D, d- O3 f% T& g! |) k
For i = 1 To n
; |" q# m5 i  g# Z4 Xs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))5 x! s7 Z/ m* ~& q
For j = 1 To n6 {' R0 F$ a0 F+ ~
a(i, j) = Val(Left(s, InStr(s, " ")))
+ C5 l# W2 V, ~$ j! fs = Trim(Right(s, (Len(s) - InStr(s, " "))))
/ J: c+ ~! [/ p% H3 W; }Print a(i, j);2 V: Y! m! F  n, K8 z5 x
Next: T& d/ g, h8 I0 l8 j8 B
a(i, n + 1) = Val(s)
* L) v- d; Z! q9 bPrint a(i, n + 1);
* \* F# q0 `3 f. uPrint/ E5 H& ^9 m: s; p! J
Next
7 w9 ^% a: z6 i" f
6 r  |1 c  d+ Q$ |( e& ?For k = 1 To n - 1 '开始消元+ e% q4 t1 m+ ~& E& |
If a(k, k) = 0 Then
: Z) e4 z  q5 UMsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"# z7 C6 {! D& H& e* y- `
Exit Sub6 ?3 g! M) `7 i: k- M. s, h( G8 i% A1 z
Else
' r; V$ J) X* U, U% H% U% n6 }9 X( YFor i = k + 1 To n" b) y3 B4 u- }1 y7 ~
l(i, k) = a(i, k) / a(k, k)
5 X6 L3 F! _) g0 G! @For j = k + 1 To n + 1
/ j  c! K. K( M$ va(i, j) = a(i, j) - l(i, k) * a(k, j)
. Y1 P* _* H1 B- [& qNext
6 P9 {# O) q8 @# }Next' [, c; a& P. n& ]/ D5 R4 e
D = D * a(k, k)
. U6 ~! K( J! }* n; W6 Z( dEnd If
' `. t- X' c% [  E1 oNext k '消元结束
0 y6 ]+ R8 @# v- y* ^% yIf a(n, n) = 0 Then" a5 {0 w- f" q; I9 e1 Z
MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
' c( e; K+ M0 @( T0 UExit Sub
1 n8 x: r* v$ c/ \* n9 a; {Else0 a5 @+ a) t9 h8 u" g5 A
D = D * a(n, n). A  e4 g  S. t; |
End If: r, }  m2 N$ G; w1 P% v& J" M
Print "--------------------------------"+ }5 x( I! c3 X3 Q: B2 K
Print "系数行列式的值是:"; D
& U2 J& ~4 o! z6 d6 X8 m0 k+ {x(n) = a(n, n + 1) / a(n, n), {) P: R  g, G2 X
For k = n - 1 To 1 Step -1 '开始回代  x! V4 @# a" B7 u3 i
For j = k + 1 To n
2 o$ d9 f9 d, ^0 Lm = m + a(k, j) * x(j)
* p% I+ o$ M8 t& `) `$ H; SNext j
+ H6 m5 \7 H8 `x(k) = (a(k, n + 1) - m) / a(k, k)) l2 l2 o0 h9 f( v
m = 0
8 t' M2 o5 [5 wNext k '结束回代
0 l' a5 s- B5 o; e( G/ L6 P- _. d  |+ D
/ G- M" }8 \' V" z- aPrint "--------------------------------"; l3 a5 \% e# r& w
Print "方程组的解如下:"/ C" H9 Z! D' v+ q( @$ e% d

2 N! Z6 c9 x" a; G2 fFor k = 1 To n5 c7 P4 E3 r- l
Print
9 U: C6 w  f/ _. j& N8 P% q. }) ZPrint "X(" & k & ") = " & x(k)6 b8 F$ F" L) S0 g* N. ^
Next k
: B  M' y% U9 X  k7 sPrint "--------------------------------"
/ ?$ g4 F! S. KPrint "其中各行Ax-b="
8 T5 |5 H9 n4 `" EPrint
# m) b6 ]2 K3 }! @8 ^. |For i = 1 To n; ?0 y5 R) {2 n$ |( l" Y/ ]6 o; k
t = 0
0 v+ x9 N6 c6 \3 g2 p; D! ^For j = 1 To n/ N- p. G# E+ x" u$ @+ ]
t = t + a2(i, j) * x(j)6 P; G. l. }, x, C
Next j
; ]0 Q) q/ J1 z' ~t = t - a2(i, n + 1)
- e$ X. i. X" C2 P# DPrint Spc(5); "第" & i & "行:"; t
/ A, l& k, F: Z# HPrint
" Z! h3 `$ f. S6 j+ S8 T8 f. tNext i
, k1 u& x, m  h
+ |/ M" _$ e/ `/ W0 z8 U0 REnd SubPrivate Sub gauss_Click() '高斯消去法
3 v( [4 M( X& {" N; R% d, FDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single$ `3 Z: I* }/ ?
i = 1: j = 1
! D. q9 `4 x( H% I4 W5 t  s7 m* ^n = Val(InputBox("请输入矩阵的阶数(即:方程组未知数个数)N", "方程的未知数个数n", 3)): |  a0 _% F$ j" V; D
ReDim Preserve a(1 To n, 1 To n + 1)' D- K4 a4 T% Q9 P& L
ReDim Preserve l(1 To n, 1 To n + 1)2 q2 x- d: L. `9 n7 B
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
7 X5 H4 E* s3 `6 u; OReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()0 y" H; b2 y8 l
For i = 1 To n$ U7 E* d0 K! g4 E2 U/ {
For j = 1 To n- B" l$ [! T+ {9 S3 f
a2(i, j) = a(i, j)# i- T; u7 l( C
Next7 b( F2 h- H% Q0 H) J$ q3 h+ x# [6 U3 M
Next '将a()的值全部赋给a2()' \0 a/ t: g/ w& j4 R' M# s
m = 0$ W  U( I' i4 W4 e+ o5 i& J# ^( T
D = 1; |7 A: W0 y- t& X
ReDim x(1 To n)
$ r/ v0 w# L2 D- _4 R. I" H( WPrint "--------------------------------"
& z0 Q3 f' V- g; ]* l0 c9 tPrint "您输入的增广矩阵如下:"% _$ W. z$ y0 k/ O1 F% {% P! e0 `0 N
For i = 1 To n0 N6 |  g' x7 ]& j
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))0 u- @6 T) @( P" u: L* k9 C  c8 v
For j = 1 To n7 H4 }: p6 a2 d/ _
a(i, j) = Val(Left(s, InStr(s, " ")))
. p% J9 C( G0 S& |9 F+ Ws = Trim(Right(s, (Len(s) - InStr(s, " "))))
  _. W* V# D" g, l6 @- {Print a(i, j);0 v1 E8 `) T$ B; T# {; ]" @
Next
) \7 B% C& }0 w4 l2 q  y$ Z0 z0 L) Wa(i, n + 1) = Val(s)
# z- I. S, B+ P. E" s" fPrint a(i, n + 1);
9 h# u- m+ p; h, A. f* gPrint! f+ ?1 c# a; l# b: l
Next
" s5 u9 ^0 k& w$ E. a. d/ Y6 D5 L& X( Z/ F
For k = 1 To n - 1 '开始消元
' a" o( V1 i6 aIf a(k, k) = 0 Then% s9 D: i, L( K! Z/ r/ i9 o
MsgBox " Sorry!解不出!" + vbCrLf + "原因是:a(" & k & "," & k & ")=0了!", vbExclamation, "解不出呀!"3 P) L+ z% z$ P. \1 H( x) A2 Q( R" e
Exit Sub- d0 @0 I1 |4 q& {9 s7 q
Else5 \: K* e  K' K/ z
For i = k + 1 To n
+ F/ \8 O, j; I7 |, yl(i, k) = a(i, k) / a(k, k)
- U& }! }) W7 L) @8 Z3 ~" L. YFor j = k + 1 To n + 1
* N. d. J2 R! X: {9 J9 ^- A6 ra(i, j) = a(i, j) - l(i, k) * a(k, j)( k6 l4 w% p0 H+ R+ [8 J' C- y
Next
2 u" b0 p* U$ H) ]& H3 `Next" n' B! Z$ h2 F& f6 m0 R$ w/ K9 [
D = D * a(k, k)
: r: g( n" ~2 GEnd If2 B" w$ o9 r8 s! H0 i5 Y
Next k '消元结束' d7 O) D0 S. ?3 C, W) x
If a(n, n) = 0 Then
. L6 B/ i% J; X& n, ?MsgBox "Sorry!“高斯法”对此矩阵无能为力!" + vbCrLf + "原因是:a(n.n)=0了", vbExclamation, "解不出呀!"
+ m! d3 g1 D/ p2 cExit Sub
5 c: |& e, d- U7 }& t1 xElse
" {  ]) a% P, j" `D = D * a(n, n), R) a6 C& S" l' D6 U
End If
/ t( U% b3 L$ {& w3 O3 iPrint "--------------------------------"
# R% K/ O/ d% r9 ~3 c4 Y# ]+ PPrint "系数行列式的值是:"; D2 {% X! }- m3 l3 Z; ?
x(n) = a(n, n + 1) / a(n, n)
5 [; ~/ M" b9 r( I9 U$ @% Y: e7 p& TFor k = n - 1 To 1 Step -1 '开始回代. ?# f% \( [7 G/ B7 V1 K
For j = k + 1 To n- {- V+ E, a: l* x3 R9 C
m = m + a(k, j) * x(j); o5 Z5 B6 A) c& {4 g" V4 c
Next j
% S9 Y6 c+ h+ U8 E$ vx(k) = (a(k, n + 1) - m) / a(k, k)
' H7 F$ }! U& x" s% fm = 0
2 |' y4 u  \9 d, l' @  M: [Next k '结束回代
5 W. S; ~  G! G, e/ j- n. p1 Y# j" G
* Y$ {- F/ b5 [+ J; ]6 \8 Q( N5 _  SPrint "--------------------------------"! T+ u, M$ d/ {5 S) q
Print "方程组的解如下:"
' q: l% `8 l3 N, G. d* p1 i6 h( [1 \3 B
For k = 1 To n
7 `2 O0 m3 g2 ?( k: g/ sPrint
% T2 i2 I- X7 A+ v$ YPrint "X(" & k & ") = " & x(k)
! u! y- [2 {( N" _) YNext k
3 O* D% V6 W6 u# o. hPrint "--------------------------------"! ^- Z+ l) H" F! ?& `4 a
Print "其中各行Ax-b="* P7 T" b; X- I8 {/ {
Print
1 x3 I$ {. {! g6 B+ p- G$ GFor i = 1 To n
( X; G0 \) n+ T  v1 c, nt = 01 L$ _# ?! m, s) n. [
For j = 1 To n
+ N9 G9 B! q. Bt = t + a2(i, j) * x(j)$ W" [1 Y  }' \' F6 c5 s5 I. z
Next j! P9 }. W( I9 G3 B/ e7 X* a
t = t - a2(i, n + 1)9 V; O# Z- }0 ?% Y
Print Spc(5); "第" & i & "行:"; t+ P  {; T7 [& z2 |
Print' l, T7 N* p  N0 \$ B' h
Next i1 Y& F$ i& P# X  c0 M2 q5 T8 |* T  u
5 u8 k9 z; J# T. V
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 17:59 , Processed in 0.476482 second(s), 68 queries .

    回顶部