Josephus Problem

Author

Eric W. Weisstein
September 1, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Combinatorics/JosephusProblem.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/JosephusProblem.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<DiscreteMath`Combinatorica`

Code

JosephusFigure[n_,m_]:=Module[
{
j=InversePermutation[Josephus[n,m]],
l=Reverse[NestList[Most,InversePermutation[Josephus[4,2]],4]],
d=.2,s=.5
},
Graphics[
MapIndexed[{{Red,Function[x,
{Line[{{x-d,-#2[[1]]s+d},{x+d,-#2[[1]]s-d}}],
Line[{{x-d,-#2[[1]]s-d},{x+d,-#2[[1]]s+d}}]}
]/@#},Function[x,Text[x,{x,-#2[[1]]s}]]/@Range[n]}&,l,{1}],
AspectRatio->Automatic]
]

Example

Show[Graphics[JosephusFigure[4,2]],PlotRange->All]

Josephus[4,2]

InversePermutation[Josephus[4,2]]

Sequences

Last Survivor

Table[InversePermutation[Josephus[n,m]]//Last,{n,10},{m,n}]//TableForm

Table[1+2n-(2^(1+Floor[Log[2,n]])),{n,10}]

InversePermutation/@(Josephus[#,2]&/@Range[10])

Last/@%

Second-to-Last Survivor

Table[InversePermutation[Josephus[n,m]][[-2]],{n,2,10},{m,n}]//TableForm

Third-to-Last Survivor

Table[InversePermutation[Josephus[n,m]][[-3]],{n,3,10},{m,n}]//TableForm

41 Men

With[{r=1,R=1.2,n=41,m=3},
j=InversePermutation[Josephus[n,m]];
Show[Graphics[{
MapIndexed[{
Text[#,r Through[{Cos,Sin}[2π #/n]],TextStyle->{FontSize->12}],
Text[#2[[1]],R Through[{Cos,Sin}[2π #/n]],TextStyle->{FontColor->GrayLevel[.5],FontSize->10}]}&,j],
{Red,{Circle[r #,.08],Text["last",.85#,TextStyle->{FontFamily->"Times",FontSlant->"Italic"}]}&[Through[{Cos,Sin}[2π j[[-1]]/n]]]},
{Blue,{Circle[r #,.08],Text["second-to-last",.85#,{-1,0},TextStyle->{FontFamily->"Times",FontSlant->"Italic"}]}&[Through[{Cos,Sin}[2π j[[-2]]/n]]]}
},PlotLabel->TraditionalForm[label[n,m]]
],AspectRatio->Automatic]
]

30 Men with Every 9th Thrown

With[{r=1,R=1.2,n=30,m=9},
j=InversePermutation[Josephus[n,m]];
Show[Graphics[{
MapIndexed[{
Text[#,r Through[{Cos,Sin}[2π #/n]],TextStyle->{FontSize->12}],
Text[#2[[1]],R Through[{Cos,Sin}[2π #/n]],TextStyle->{FontColor->GrayLevel[.5],FontSize->10}]}&,j],
{Blue,Circle[r Through[{Cos,Sin}[2π #/n]],.08]&/@Take[j,-n/2]}
},PlotLabel->TraditionalForm[label[n,m]]
],AspectRatio->Automatic]
]

Take[j,-15]

Sort[%]

Transpose[MapIndexed[Table[{"A","B"}[[#2[[1]]]],{#1}]&,Transpose[Partition[StringCases["From numbers' aid and art, never will fame depart",RegularExpression["[aeiou]"]]/.Thread[Characters["aeiou"]->Range[5]],2,2,{1,1},{}]],{2}]]//Flatten//StringJoin

First/@StringPosition[%,"A"]

30 Men with Every 10th Thrown

MakeBoxes[label[n_,m_],TraditionalForm]:=RowBox[{RowBox[{"n","==",MakeBoxes[n,TraditionalForm]}],",",RowBox[{"m","==",MakeBoxes[m,TraditionalForm]}]}]

With[{r=1,R=1.2,n=30,m=10},
j=InversePermutation[Josephus[n,m]];
Show[Graphics[{
MapIndexed[{
Text[#,r Through[{Cos,Sin}[2π #/n]],TextStyle->{FontSize->12}],
Text[#2[[1]],R Through[{Cos,Sin}[2π #/n]],TextStyle->{FontColor->GrayLevel[.5],FontSize->10}]}&,j],
{Blue,Circle[r Through[{Cos,Sin}[2π #/n]],.08]&/@Take[j,-n/2]}
},PlotLabel->TraditionalForm[label[n,m]]
],AspectRatio->Automatic]
]

Take[j,-15]

Sort[%]

Transpose[MapIndexed[Table[{"A","B"}[[#2[[1]]]],{#1}]&,Transpose[Partition[StringCases["Rex paphi cum gente bona dat signa serena",RegularExpression["[aeiou]"]]/.Thread[Characters["aeiou"]->Range[5]],2,2,{1,1},{}]],{2}]]//Flatten//StringJoin

First/@StringPosition[%,"A"]

OLD STUFF

Last Man

lastman1=Table[JosephusFindMan[i,j],{i,1,20},{j,1,i}];

FormatSequence[lastman1//Flatten,1,1,
	Keyw->"tabl",
	Cross->"A000002, A000003.",
	Name->"Triangle of last man to survive in the Josephus problem of $n$ men in a circle with every $k$th killed, with $k<=n$.",
	Detail->"Ball, W.W.R. and Coxeter, H.S.M.  Mathematical Recreations and Essays, 13th ed.  New York: Dover, pp. 32-36, 1987.",
	Detail2->"Kraitchik, M.  \"Josephus' Problem.\"  Sec. 3.13 in Mathematical Recreations.  New York: W.W. Norton, pp. 93-94, 1942.",
	html["JosephusProblem"]
]

Table[FindMan[i,j],{i,1,15},{j,1,i}]//TableForm

Table[LastMan[i,2],{i,100}]

Second-to-Last Man

lastman2=Table[JosephusFindMan[i,j,2],{i,2,15},{j,1,i}];

FormatSequence[lastman2//Flatten,2,2,
	Keyw->"tabl",
	Cross->"A000001, A000003.",
	Name->"Triangle of second-to-last man to survive in the Josephus problem of $n$ men in a circle with every $k$th killed, with $k<=n$.",
	Detail->"Ball, W.W.R. and Coxeter, H.S.M.  Mathematical Recreations and Essays, 13th ed.  New York: Dover, pp. 32-36, 1987.",
	Detail2->"Kraitchik, M.  \"Josephus' Problem.\"  Sec. 3.13 in Mathematical Recreations.  New York: W.W. Norton, pp. 93-94, 1942.",
	html["JosephusProblem"]
]

Take[lastman2,10]//TableForm

Third-to-Last Man

lastman3=Table[JosephusFindMan[i,j,3],{i,3,15},{j,1,i}];

FormatSequence[lastman3//Flatten,3,3,
	Keyw->"tabl",
	Cross->"A000001, A000002.",
	Name->"Triangle of third-to-last man to survive in the Josephus problem of $n$ men in a circle with every $k$th killed, with $k<=n$.",
	Detail->"Ball, W.W.R. and Coxeter, H.S.M.  Mathematical Recreations and Essays, 13th ed.  New York: Dover, pp. 32-36, 1987.",
	Detail2->"Kraitchik, M.  \"Josephus' Problem.\"  Sec. 3.13 in Mathematical Recreations.  New York: W.W. Norton, pp. 93-94, 1942.",
	html["JosephusProblem"]
]

Table[FindMan[i,j,3],{i,3,10},{j,1,i}]//TableForm

Decimation

JosephusPlot[n_,m_]:=Module[{i,j=Josephus[n,m]},
{
Table[Text[i,{Cos[#],Sin[#]}&[2.Pi i/n]],{i,n}],
Table[Text[j[[i]],1.2{Cos[#],Sin[#]}&[2.Pi i/n],TextStyle->{FontSize->8}],{i,n}]
}
]

(41,3)

Show[Graphics[JosephusPlot[41,3],AspectRatio->Automatic,PlotRange->All]]

Josephus[41,3]

InversePermutation[%]

{JosephusFindMan[41,3,2],JosephusFindMan[41,3,1]}

(30,9)

Show[Graphics[JosephusPlot[30,9],AspectRatio->Automatic,PlotRange->All]]

Josephus[30,9]

InversePermutation[Josephus[30,9]]

Sort[Take[%,-15]]

(30,10)

Show[Graphics[JosephusPlot[30,10],AspectRatio->Automatic,PlotRange->All]]

Josephus[30,10]

InversePermutation[Josephus[30,10]]

Sort[Take[%,-15]]