14
$\begingroup$

Problem Description

Recently, I have been reading the book Schaum's Outline of Mathematica (2nd Edition), where I encountered 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 to 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 the flaw that I must give 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?

| improve this question | | | | |
$\endgroup$
14
$\begingroup$
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 of killing every third person.

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

{4}

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

| improve this answer | | | | |
$\endgroup$
  • 1
    $\begingroup$ 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. $\endgroup$ – xyz Oct 7 '13 at 12:11
  • 2
    $\begingroup$ @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. $\endgroup$ – Dr. belisarius Oct 7 '13 at 12:18
  • 7
    $\begingroup$ @mathematica BTW your question is nicely formulated, with a clear problem statement and showing your efforts to solve the problem. Keep posting like that! $\endgroup$ – Dr. belisarius Oct 7 '13 at 12:20
17
$\begingroup$

Here's my solution using pattern-matching:

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

{5}

| improve this answer | | | | |
$\endgroup$
6
$\begingroup$

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}

| improve this answer | | | | |
$\endgroup$
6
$\begingroup$

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

| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ This didn't work for me until I added a function that turned the x integer into a Range ie, josephus[x_Integer] := josephus[Range[x]] $\endgroup$ – Joe Nov 2 '17 at 11:59
4
$\begingroup$

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
| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ J.M. Thanks for your solution. I used the Mathematica about three years ago, then I known this professional site inadvertently. $\endgroup$ – xyz Mar 1 '16 at 0:55
3
$\begingroup$

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

j[u_] := FromDigits[RotateLeft[First @ RealDigits[u, 2]], 2]
| improve this answer | | | | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.