Joesphus Problem

Background

There are countless versions of this problem circulating in the internet. The problem is frequently stated as "100 people standing in a circle waiting to be executed in a specific sequence. The first person (person \(i\)) with the sword executes the person that is next in the circle (person \(i + 1\)) passing on the sword to the next person alive. This continues to go-on until only one person remains".

This one described above is a special case of the Josephus Problem. The more general case would be where the number of people is \(n\) and the sword is passed on from \((k-2)^{th}\) to the \(k^{th}\) person after killing the \((k-1)^{th}\) person. We will look at few general cases of the problem. We will also look at some code on the way with some visuals. The table below is is the sequence of the deaths of 100 people standing in a loop. There is also an animation at the end of the table.

Key

• Each row represents an iteration.
• 1 - Alive (and possibly healthy)
• 0 - Dead

\(k=1\)

\(k=5\)

The one left alive is \(73^{rd}\) person. An animated version of the problem is shown below.

Code:

    (*k=1*)
    Module[{sequences, alive, replacer},
     alive[1] := Style[1, Darker@Hue[0.3], 10];
     alive[0] := Style[0, Red, 10];
     replacer[obj_] := obj -> obj - 1;
     sequences =
      Module[{list = Range[100], lists, deleter = 1}, lists = {list};

       While[Length[list] > 1,
        list = Delete[list, deleter + 1];
        deleter = Mod[deleter + 1, Length@list];
        AppendTo[lists, list]];

       Export["josephus_problem_k_1.svg",
        TableForm[
         Table[alive /@ (Range[100] -
             ReplaceAll[Range[100], replacer /@ lists[[r]]]), {r, 1,
           Length@lists}], TableSpacing -> {0, 0}]]
       ]]

    (*k=5*)
    Module[{sequences, alive, replacer},
     alive[1] := Style[1, Darker@Hue[0.3], 10];
     alive[0] := Style[0, Red, 10];
     replacer[obj_] := obj -> obj - 1;
     sequences =
      Module[{list = Range[100], lists, deleter = 1}, lists = {list};

       While[Length[list] > 1,
        list = Delete[list, Mod[deleter + 1, Length@list + 1]];
        deleter = Mod[deleter + 4, Length@list];
        AppendTo[lists, list]];
       Export["josephus_problem_k_5.svg",
        TableForm[
         Table[alive /@ (Range[100] -
             ReplaceAll[Range[100], replacer /@ lists[[r]]]), {r, 1,
           Length@lists}], TableSpacing -> {0, 0}]
        ]]
     ]

    (*Code for exporting the .gif animation*)
    Module[{sequences, alive, replacer, colors, images},
        alive[1] := Green;
        alive[0] := Red;
        replacer[obj_] := obj -> obj - 1;
        sequences = Module[{list = Range[100], lists, deleter = 1},
            lists = {list};
            While[Length[list] > 1,
                list = Delete[list, deleter + 1];
                deleter = Mod[deleter + 1, Length@list];
                AppendTo[lists, list]];
           colors = Table[alive /@ (Range[100] - ReplaceAll[Range[100], replacer /@ lists[[r]]]), {r, 1, Length@lists}];
           images =
            Table[Graphics[{Table[{colors[[r, n]],
                 Disk[{35 Sin[2 \[Pi] n/100], 35 Cos[2 \[Pi] n/100]}]}, {n, 1,
                  Length@lists[[1]]}],
               Table[Style[
                 Text[n, {35 Sin[2 \[Pi] n/100], 35 Cos[2 \[Pi] n/100]}],
                 Black], {n, 1, Length@lists[[1]]}]}, ImageSize -> 700], {r, 1, 100}];
        Export["100_men_standing.gif", images, "DisplayDurations" -> Table[0.4, 99]~Join~{5}, AnimationRepetitions -> 20]
        ]
    ]
    

---

Further simulations

We can repeat that for different configurations. The first one is the animation and the rest are the individual vector images

Animation Faster

Animation Slower

---

Static Images