gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
阅读:3214回复:6

VB数学实例:巧用递归法解不定方程

楼主#
更多 发布于:2004-12-23 19:34
多元一次方程往往采用循环求解。笔者在与网友们讨论一个问题过程中,琢磨出一种算法,采  用递归进行多元一次方程的求解。并将解分为整数解和 非负整数解两种情况,请大家指教。<br><br>  Private Sub Command1_Click() '演示求X1+X2+X3+X4+X5=10整数解<br>  Text1.Text = ""<br>  Dim answer As String<br>  answer = GETRESULT(5, 10, True) '赋值<br>  Dim temp<br>  temp = Split(answer, vbCrLf)<br>  For i = 0 To UBound(temp)<br>  temp(i) = "解" ; i + 1 ; ":" ; vbTab ; temp(i) ' add index<br>  Next<br>  answer = Join(temp, vbCrLf)<br>  Text1.Text = "方程 X1+X2+X3+X4+X5=10 共有 " ; UBound(temp) + 1 ; " 个整数解:" ; vbCrLf ; answer 'show all answer in textbox<br><br>  End Sub<br>  Private Sub Command2_Click() '演示求X1+X2+X3+X4+X5=10非负整数解<br>  Text1.Text = ""<br>  Dim answer As String<br><br>  answer = GETRESULT(5, 10, False) '赋值<br>  Dim temp<br>  temp = Split(answer, vbCrLf)<br>  For i = 0 To UBound(temp)<br>  temp(i) = "解" ; i + 1 ; ":" ; vbTab ; temp(i) 'add index<br>  Next<br>  answer = Join(temp, vbCrLf)
[此贴子已经被作者于2005-8-19 12:05:21编辑过]
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2004-12-23 19:34
 Text1.Text = "方程 X1+X2+X3+X4+X5=10 共有 " ; UBound(Split(answer, vbCrLf)) + 1 ; " 个非零整数解:" ; vbCrLf ; answer 'show all answer in textbox

  End Sub

  Private Sub Command3_Click() '演示无解情况
  Text1.Text = ""
  Dim answer As String

  answer = GETRESULT(5, 3, False)
  Dim temp
  temp = Split(answer, vbCrLf)
  For i = 0 To UBound(temp)
  temp(i) = "解" ; i + 1 ; ":" ; vbTab ; temp(i)
  Next
  answer = Join(temp, vbCrLf)
  Text1.Text = "方程 X1+X2+X3+X4+X5=3 共有 " ; UBound(Split(answer, vbCrLf)) + 1 ; " 个非零整数解:" ; vbCrLf ; answer

  End Sub

  '求解函数
  Function GETRESULT(ByVal n As Integer, ByVal SUM As Integer, Optional allowzero As Boolean = True) As String
  Dim temp() As String, i As Long
  If n = 2 Then '二元方程
  If allowzero = True Then
举报 回复(0) 喜欢(0)     评分
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
2楼#
发布于:2004-12-23 19:35
ReDim temp(SUM)
  For i = 0 To SUM ' allow zero
  temp(i) = "X1=" ; i ; ",X2=" ; SUM - i
  Next
  GETRESULT = Join(temp, vbCrLf)
  Erase temp
  Else
  ReDim temp(1 To SUM - 1) 'forbid zero
  For i = 1 To SUM - 1
  temp(i) = "X1=" ; i ; ",X2=" ; SUM - i
  Next
  GETRESULT = Join(temp, vbCrLf)
  Erase temp
  End If

  End If
  If n > 2 Then

  If allowzero = True Then
  ReDim temp(SUM)
  For i = SUM To 0 Step -1 ' allow zero
  temp(i) = Replace(GETRESULT(n - 1, i, True), vbCrLf, ",X" ; n ; "=" ; SUM - i ; vbCrLf) ; ",X" ; n ; "=" ; SUM - i
  Next
  GETRESULT = Join(temp, vbCrLf)
  Erase temp
  Else
  If SUM < n Then MsgBox "无解!": Exit Function '无解情况
  ReDim temp(1 To SUM - n + 1) 'not allow zero
  For i = 1 To SUM - n + 1
  temp(i) = Replace(GETRESULT(n - 1, SUM - i, False), vbCrLf, ",X" ; n ; "=" ; i ; vbCrLf) ; ",X" ; n ; "=" ; i '递归
  Next

  GETRESULT = Join(temp, vbCrLf)
  Erase temp
  End If
  End If
  End Function
举报 回复(0) 喜欢(0)     评分
wangjh
论坛版主
论坛版主
  • 注册日期2003-08-22
  • 发帖数994
  • QQ55359982
  • 铜币2579枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2004-12-24 13:16
<P>这么复杂</P>
网 站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年,最近被盗了,郁闷!!!)
举报 回复(0) 喜欢(0)     评分
ch308
路人甲
路人甲
  • 注册日期2004-11-23
  • 发帖数48
  • QQ
  • 铜币203枚
  • 威望0点
  • 贡献值0点
  • 银元0个
4楼#
发布于:2005-03-16 16:58
学习!
举报 回复(0) 喜欢(0)     评分
haizhen0915
路人甲
路人甲
  • 注册日期2004-09-16
  • 发帖数4
  • QQ
  • 铜币36枚
  • 威望0点
  • 贡献值0点
  • 银元0个
5楼#
发布于:2005-04-29 17:00
sdm
举报 回复(0) 喜欢(0)     评分
Twoyearslater
路人甲
路人甲
  • 注册日期2004-09-24
  • 发帖数10
  • QQ
  • 铜币137枚
  • 威望0点
  • 贡献值0点
  • 银元0个
6楼#
发布于:2005-07-31 10:59
<P>还以为很简单!</P>
举报 回复(0) 喜欢(0)     评分
游客

返回顶部