How to correct my code for solving the Josephus problem?

Problem Decription

Recently, I have been reading the book Schaum's Outline of Mathematica (2nd Edition), where I encounted the problem:

Flavius Josephus was a Jewish historian of the first century. He wrote about a group of ten Jews in a cave who, rather than surrender to the Romans, chose to commit suicide, one by one. They formed a circle and every other one was killed. Who was the lone survivor?

The author's solution:

list = Range[10];
While[Length[list] > 1, list = Rest[RotateLeft[list]]];
list


{5}

However, I know it is not efficient to use the procedural methods such as Do, While, etc. Rather, I want use a functional method like NestWhile, Nest, or FixedPoint to solve the problem.

My solutions:

Method 1:

list = Range @ 10;
NestList[Rest@RotateLeft[#] &, list, 9]

 {{1, 2, 3, 4, 5, 6, 7, 8, 9, 10},
{3, 4, 5, 6, 7, 8, 9, 10, 1},
{5, 6, 7, 8, 9, 10, 1, 3},
{7, 8, 9, 10, 1, 3, 5},
{9, 10, 1, 3, 5, 7},
{1, 3, 5, 7, 9},
{5, 7, 9, 1},
{9, 1, 5},
{5, 9},
{5}}


Furthermore,this method has a flaw that I must give the the number of iterations. In fact, sometimes that is unknown.

Method 2:

list = Range @10;
FixedPoint[If[Length@# != 1 &, Rest @ RotateLeft[#] &], list]


Unfortunately, method 2 doesn't work.

Method 3:

 list = Range @ 10;
NestWhileList[Rest @ RotateLeft[#] &, list, Length@list != 1]

{{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}}


So my question is: what is a good way to do it?

-

NestWhile[Rest@RotateLeft@# &, Range@10, Length@# > 1 &]


{5}

FixedPoint[If[Length@# > 1, Rest@RotateLeft[#], #] &, Range@10]


Edit

Historical note: As far as I can remember, Josephus roulette (a plain treason to his companions) consisted in killing every third person.

FixedPoint[If[Length@# != 1, Rest@RotateLeft[#, 2], #] &, Range@10]


{4}

Note: The direction is important. RotateRight[] will select another victim.

-
Dear belisarius,thanks for your help sincerely.Since I am a chinese student,it is the first time for me to know this hostorical story. – Shutao TANG Oct 7 '13 at 12:11
@mathematica Josephus was a traitor to his own people. He wrote pamphlets that now (2K years after the fact) can be considered "history", but at that time it was plain propaganda. – Dr. belisarius Oct 7 '13 at 12:18
@mathematica BTW your question is nicely formulated, with a clear problem statement and showing your efforts to solve the problem. Keep posting like that! – Dr. belisarius Oct 7 '13 at 12:20

Here's my solution using pattern-matching:

Range[10] //. {x_, y_, z___} :> {z, x}


{5}

-

You can use Nest and define a function so you don't have to know the number of iterations:

josephus[n_] := Nest[Rest@RotateLeft[#] &, Range@n, n - 1]


So

josephus[10]


{5}

josephus[200]


{145}

-

A way without using any of Nest, NestWhile and FixedPoint.

josephus[x_ /; Length[x] > 1] := josephus[Rest[RotateLeft[x]]]
josephus[x_] := First@x

josephus[10]


5

josephus[200]


145

-

For this particular scenario (every second person), the last person is the single cyclic shift to the left of binary representation of starting number:

j[u_] := FromDigits[RotateLeft[First@RealDigits[u, 2]], 2]

-

The following solution, which gives the number of the survivor when every $q$-th person in a group of $n$ persons is killed, is adapted from Concrete Mathematics:

josephus[n_Integer?Positive, q_Integer?Positive] /; q <= n :=
q n - NestWhile[Ceiling[q #/(q - 1)] &, 1, # <= n (q - 1) &, 1] + 1


Test:

josephus[10, 2] (* OP's case *)
5

josephus[41, 3] (* Josephus's original problem *)
31


For the case $q=2$, MathWorld gives a nice closed form:

With[{n = 10}, 2 n - 2^IntegerLength[n, 2] + 1]
5

-
J.M. Thanks for your solution. I used the Mathematica about three years ago, then I known this professional site inadvertently. – Shutao TANG Mar 1 at 0:55