Zen archery problem
vicktor schausberger writes:
Zen Archery
In his book Wonders of Numbers (Oxford: Oxford University Press, 2001), pp. 275-276, Clifford Pickover posed a "Zen Archery" problem. In its simplest form, there is a target with 24 numbers on it. The archer must shoot 5 arrows at the target and hit numbers adding up to 200. The 24 numbers on the target are
97,101,139,41,37,31,29,89,23,19,8,13,
131,19,73,97,19,139,79,67,61,17,113,127
Pickover posed a similar problem at Archery by the Numbers. This is really a combinatorial problem -- given the 24 numbers taken 5 at a time, which unique combinations add up to 200?
There is some quick and dirty Java code on the Web, associated with Pickover's book, which solves the Zen archery problem for the 24 numbers given. However, it is not exactly a model of good programming, and it even assumes some foreknowledge of the answer in the code, i.e. the fact that all combinations adding up to 200 include the number 8.
Answer:
The text above seems to be copied from this website: http://www.merriampark.com/comb.htm
Let´s create a user defined function that checks every combination and filters values where the sum is equal to 200.
I don´t understand why 19 occurs twice in the 24 numbers on the target. Because of this, the udf returns duplicate rows, therefore some combinations are not unique.
User defined function
Function SumComb(sum As Range, rng As Variant, num As Integer)
Dim Arr(), i, Ans As Single
Dim svVal() As Variant
Dim tmp As Variant
ReDim Arr(num - 1)
ReDim svVal(num - 1, 0)
rng = rng.Value
For i = 0 To num - 1
Arr(i) = i + 1
Next i
Comb = Application.WorksheetFunction.Combin(UBound(rng, 1), num)
For j = 1 To Comb
tmp = 0
For i = 0 To num - 1
tmp = tmp + rng(Arr(i), 1)
Next i
If tmp = sum Then
For i = 0 To num - 1
svVal(i, UBound(svVal, 2)) = rng(Arr(i), 1)
Next i
ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) + 1)
End If
Arr(num - 1) = Arr(num - 1) + 1
k = num
For i = num - 1 To 0 Step -1
If Arr(i) = UBound(rng, 1) - num + i + 2 Then
k = i
Arr(i - 1) = Arr(i - 1) + 1
Else
If k <> 0 Then
k = i
Else
k = num
End If
Exit For
End If
Next i
If k <> num Then
For i = k To num - 2
Arr(i + 1) = Arr(i) + 1
Next i
End If
Next j
ReDim Preserve svVal(UBound(svVal, 1), UBound(svVal, 2) - 1)
SumComb = Application.Transpose(svVal)
End Function
Where to copy udf?
Press Alt+F11
Explaining user defined function
How to enter array formula
Download excel 2007 *.xlsm file










October 29th, 2011 at 12:41 am
Sweeet, keep working