vicktor schausberger writes:
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
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.
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?
Explaining user defined function
How to enter array formula
Download excel 2007 *.xlsm file