Hi, Dana:

I thought it was interesting, too. I knew my code wasn't very efficient, but I
didn't spend any time trying to optimize it. Your code looks interesting.
Thanks for posting it.

Myrna Larson


On Tue, 16 Nov 2004 00:49:15 -0500, "Dana DeLouis"
wrote:

Hi Myrna. I had a old code for this using the 'Collection' object, but I
find that your code is twice as fast on a larger set of numbers. So,
thanks!
I found this interesting, so I played around with it a little. On a large
set N, suppose one is skipping every 100th number. When the remaining
numbers to be found is say 2, the program scans all N numbers 50 times (or
50*2*N) just to get k = 100. I modified your excellent idea to include a
Mod function so that the main loop makes at most 1 pass on all N for each
increment. It looks like this decreases the number of loops by quite a bit
when working with a large set.
In certain math programs, they call this the "Josephus" problem (A
Permutation being the sequence of elimination when every nth member is
"eliminated." One wishes to be the "last man standing"). I've named it by
the same function name.

Sub TestIt()
Dim n As Long
Dim p As Long
Dim v

n = 20: p = 7
v = Josephus(n, p)
Range("A1").Resize(1, n) = v
End Sub

Function Josephus(Num As Long, Nth As Long)

Dim i As Long 'Loop pointer
Dim c As Long 'Counter 1 - n
Dim Remain As Long '# Remaining
Dim n As Long 'Modified Nth
Dim x As Variant 'Input Array
Dim y As Variant 'Output Array


ReDim x(1 To Num)
ReDim y(1 To Num)

For i = 1 To Num
x(i) = i
Next i

Remain = Num
i = 0

Do While Remain 0
n = Nth Mod Remain
If n = 0 Then n = Remain

c = 0
Do Until c = n
i = i + 1
If i Num Then i = 1
c = c + Sgn(x(i))
Loop

y(Num - Remain + 1) = x(i)
x(i) = 0
Remain = Remain - 1
Loop
Josephus = y
'// Note: Last Number or Person "Picked" is # : y(num)
End Function

Thanks for the code ideas. :)