Board logo

標題: 請教處理16個正整數的不定方程問題 [打印本頁]
作者: kain    時間: 2013-1-30 14:11     標題: 請教處理16個正整數的不定方程問題

請教各位大大:
若有16個變量 a,b,c,...,p
每個變量都是1到16的正整數，且各自彼此都不同，
這些變量具有以下這些方程關係:
a+b+c+d+e+f+g=49+s
2*b+c+2*d+e+2*f+g=87-s
其中, s=0,1,...,21

h+i+j=d+e+f
k+l+m=b+g+f
n+o+p=b+c+d

我參考網路一些資料，以s=0,s=1...,s=21分開處理
用迴圈的方式(For Next)先找出了a到g的7個變量，
但是後來仿照加入其餘9個變量(h,i,j,...,p)卻一直當掉，
有網友說因為用迴圈，最後會是16^15，所以無法處理，但目前也想不到其他方式，
所以想請教各位是不是有其他方式可以處理呢?
以下是跑前7個變量的語法(s=0)

Function Unequal(ParamArray Nums() As Variant) As Integer
Dim intI1 As Integer, intI2 As Integer, l As Integer, u As Integer
l = LBound(Nums())
u = UBound(Nums())
If u - l < 1 Then
Unequal = 3
Exit Function
End If
For intI1 = l To u - 1
For intI2 = intI1 + 1 To u
If Nums(intI1) = Nums(intI2) Then
Unequal = 0
Exit Function
End If
Next
Next
Unequal = 1
End Function

Sub hexagonhive ()
For a = 1 To 16
For b = 1 To 16
For c = 1 To 16
For d = 1 To 16
For e = 1 To 16
For f = 1 To 16
g = 49 - a - b - c - d - e – f
Dim ue As Integer, str As String
ue = Unequal(a, b, c, d, e, f, g)
If ue = 1 And g > 0 And g < 17 And 2 * b + c + 2 * d + e + 2 * f + g = 87 Then
t = t + 1
Cells(t, 1) = a: Cells(t, 2) = b: Cells(t, 3) = c: Cells(t, 4) = d: Cells(t, 5) = e: Cells(t, 6) = f: Cells(t, 7) = g:
End If
Next f, e, d, c, b, a
End Sub
作者: stillfish00    時間: 2013-1-30 15:36

回復 1# kain
你把dim從迴圈中提出來看看
作者: stillfish00    時間: 2013-1-30 16:36

我把變數重新宣告而已
是能跑出來的 (耗時38秒)
跑出252種組合
  1. Sub hexagonhive()
  2. Dim ue As Integer, str As String
  3. Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, g As Integer
  4. Dim t As Long
  5. t = 0
  6. Debug.Print Time

  8. For a = 1 To 16
  9. For b = 1 To 16
  10. For c = 1 To 16
  11. For d = 1 To 16
  12. For e = 1 To 16
  13. For f = 1 To 16
  14.     g = 49 - a - b - c - d - e - f
  15.     ue = Unequal(a, b, c, d, e, f, g)
  16.    
  17.     If ue = 1 And g > 0 And g < 17 And 2 * b + c + 2 * d + e + 2 * f + g = 87 Then
  18.         t = t + 1
  19.         Cells(t, 1) = a: Cells(t, 2) = b: Cells(t, 3) = c: Cells(t, 4) = d: Cells(t, 5) = e: Cells(t, 6) = f: Cells(t, 7) = g:
  20.     End If
  21. Next f, e, d, c, b, a
  22. Debug.Print Time
  23. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)