递归方法巧解不定方程

发表于:2007-07-01来源:作者:点击数: 标签:
多元一次方程往往采用循环求解。笔者在与网友们讨论一个问题()过程中,琢磨出一种算法,采用递归进行多元一次方程的求解。并将解分为整数解和 非负整数解两种情况,请大家指教。 Private Sub Command1_Click() 演示求X1+X2+X3+X4+X5=10整数解 Text1.Text =

       多元一次方程往往采用循环求解。笔者在与网友们讨论一个问题()过程中,琢磨出一种算法,采用递归进行多元一次方程的求解。并将解分为整数解和 非负整数解两种情况,请大家指教。

 

 

Private Sub Command1_Click() ´演示求X1+X2+X3+X4+X5=10整数解
Text1.Text = ""
Dim answer As String
answer = GETRESULT(5, 10, True) ´赋值
Dim temp
temp = Split(answer, vbCrLf)
For i = 0 To UBound(temp)
temp(i) = "解" & i + 1 & ":" & vbTab & temp(i) ´ add index
Next
answer = Join(temp, vbCrLf)
Text1.Text = "方程  X1+X2+X3+X4+X5=10 共有 " & UBound(temp) + 1 & " 个整数解:" & vbCrLf & answer ´show all answer in textbox

End Sub
Private Sub Command2_Click() ´演示求X1+X2+X3+X4+X5=10非负整数解
Text1.Text = ""
Dim answer As String

answer = GETRESULT(5, 10, False) ´赋值
Dim temp
temp = Split(answer, vbCrLf)
For i = 0 To UBound(temp)
temp(i) = "解" & i + 1 & ":" & vbTab & temp(i) ´add index
Next
answer = Join(temp, vbCrLf)
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
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

 

 

 


原文转自:http://www.ltesting.net