The next one is the linear Josephus Problem.
jL[n_, rs_] := Block[{p, u}, elim = {}; p = Join[Range[n], Sort[Table[m, {m, 2, n - 1}], Greater]]; Do[Do[u1 = First[p]; u2 = First[RotateLeft[p, 1]]; If[u1 == u2, p = RotateLeft[p, 2], p = RotateLeft[p, 1]], {s,1,rs - 1}]; u = First[p]; p = Rest[p]; elim = Append[elim, u]; If[MemberQ[p, u], p = Drop[p, Position[p, u][[1]]],], {t, 1, n - 1}]; p[[1]]];