Having messed this up yesterday, I will offer a method of reasonable complexity, O(k*n) for deleting every kth from a list on size n. The k factor does not really kick in at smallish sizes, so that's a nice advantage.
The main part of the code is straightforward. Delete every kth element, keep track of where to restart, condense the list, rinse, repeat. The endgame is tricky. Once we get into the realm where #remaining elements < k, we need to take care of the indexing. Maybe there is a more clever way.
funcJ[{j_, ll_List}, k_Integer] :=
Module[{q, r, delposns}, {q, r} =
QuotientRemainder[Length[ll] - j, k];
delposns = j + k*Transpose[{Range@q}];
{-r, Delete[ll, delposns]}]
solveJosephus[len_, k_, keep_ : 1] := Module[
{ll = Range[len], posn, lllen},
{posn, ll} =
NestWhile[funcJ[#, k] &, {0, ll}, (Length[#[[2]]] >= keep + k) &];
lllen = Length[ll];
While[lllen > keep,
posn = posn + k;
If[posn > Length[ll],
posn = posn - Length[ll];
ll = ll /. 0 -> Nothing;
posn = Mod[posn, Length[ll], 1];
];
ll[[posn]] = 0;
lllen--];
ll /. 0 -> Nothing
]
I show some examples that compare to the Rosetta Stone Mathematica code.
In[435]:=
solveJosephusRosetta[len_, k_, keep_] :=
Nest[Most[RotateLeft[#, k]] &, Range[len], len - keep]
In[479]:=
Table[Timing[solveJosephusRosetta[2^j, 3, 1]], {j, 15, 17}]
Out[479]= {{0.593449, {6136}}, {2.3729, {58355}}, {9.5988, {82145}}}
In[489]:= Table[Timing[solveJosephus[2^j, 3, 1]], {j, 15, 17}]
Out[489]= {{0.002549, {6136}}, {0.004045, {58355}}, {0.008657, \
{82145}}}
One sees the quadratic complexity in that Rosetta code.
If we increase the step size k we begin to see the effect that has on the O(k*n) method.
In[548]:= Table[Timing[solveJosephusRosetta[2^j, 103, 6]], {j, 15, 17}]
Out[548]= {{0.587146, {31404, 2231, 7602, 15710, 15912,
16352}}, {2.42677, {291, 7505, 18244, 34452, 34851,
35734}}, {9.69498, {6724, 21141, 42610, 75014, 75807, 77576}}}
In[546]:= Table[Timing[solveJosephus[2^j, 103, 6]], {j, 15, 17}]
Out[546]= {{0.021644, {2231, 7602, 15710, 15912, 16352,
31404}}, {0.016242, {291, 7505, 18244, 34452, 34851,
35734}}, {0.022995, {6724, 21141, 42610, 75014, 75807, 77576}}}
