1 USING: kernel locals math math.ranges sequences ;
2 IN: rosetta-code.josephus-problem
4 ! http://rosettacode.org/wiki/Josephus_problem
6 ! Problem: Josephus problem is a math puzzle with a grim
7 ! description: n prisoners are standing on a circle, sequentially
8 ! numbered from 0 to n − 1. An executioner walks along the circle,
9 ! starting from prisoner 0, removing every k-th prisoner and
10 ! killing him. As the process goes on, the circle becomes smaller
11 ! and smaller, until only one prisoner remains, who is then freed.
12 ! For example, if there are n = 5 prisoners and k = 2, the order
13 ! the prisoners are killed in (let's call it the "killing
14 ! sequence") will be 1, 3, 0, and 4, and the survivor will be #2.
16 ! Task: Given any n,k > 0, find out which prisoner will be the
17 ! final survivor. In one such incident, there were 41 prisoners
18 ! and every 3rd prisoner was being killed (k = 3). Among them was
19 ! ! a clever chap name Josephus who worked out the problem, stood at
20 ! the surviving position, and lived on to tell the tale. Which
23 ! Extra: The captors may be especially kind and let m survivors
24 ! free, and Josephus might just have m − 1 friends to save.
25 ! Provide a way to calculate which prisoner is at any given
26 ! position on the killing sequence.
29 ! 1. You can always play the executioner and follow the
30 ! procedure exactly as described, walking around the circle,
31 ! counting (and cutting off) heads along the way. This would yield
32 ! the complete killing sequence and answer the above questions,
33 ! with a complexity of probably O(kn). However, individually it
34 ! takes no more than O(m) to find out which prisoner is the m-th
36 ! 2. If it's more convenient, you can number prisoners from 1 to
37 ! n instead. If you choose to do so, please state it clearly.
38 ! 3. An alternative description has the people committing
39 ! assisted suicide instead of being executed, and the last person
40 ! simply walks away. These details are not relevant, at least not
43 :: josephus-k ( n k -- m )
44 n [1,b] 0 [ [ k + ] dip mod ] reduce ;
46 :: josephus-2 ( n -- m ) ! faster for k=2
49 :: josephus ( n k -- m )
50 k 2 = [ n josephus-2 ] [ n k josephus-k ] if ;