Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #34869

Re: Josephus Circle problem

Show all headers | View raw

Paul Rubin wrote:

> This is an oldie that was in Knuth vol 2 though I don't have the
> reference handy.  Also at:
> 
> http://thedailywtf.com/Articles/Programming-Praxis-Josephus-Circle.aspx
> http://mathworld.wolfram.com/JosephusProblem.html
> 
> From the first url:  "In order to decide who would die in which order,
> the soldiers stood in a circle and, starting with the top of the circle
> and continuing clockwise, counted to three. The third man got the ax and
> the counting resumed at one. The process continued until there was no
> one left. Josephus, who didn't quite agree with the whole "we should all
> kill ourselves" idea, figured out the perfect way to avoid death: be the
> last man standing."
> 
> Problem: There are 40 soldiers to start with, number 1,2,3,... .
> Calculate the order in which they are killed.
> 
> A solution:
> ================================================================
> 
> 40 constant ring-size
> 3 constant jump-size
> jump-size 1- constant jump-size-1
> 
> create ring  ring-size cells allot
> does> ( i -- addr ) swap cells + ;
> 
> variable remaining                      \ number of men still alive
> variable p                              \ place to start counting from
> : decr-remaining ( -- ) remaining @ 1- remaining ! ;
> 
> : init-ring ( -- ) ring-size 0 do i 1+ i ring ! loop ;
> : init-vars ( -- ) ring-size remaining !   0 p ! ;
> : init ( -- ) init-ring init-vars ;
> : next-p ( -- ) p @ jump-size-1 + remaining @ mod p ! ;
> 
> : cells-to-move ( -- n ) remaining @ p @ - 1- ;
> : remove ( -- ) p @ 1+ ring  p @ ring  cells-to-move cells  move ;
> 
> : show ( n -- ) ring @ . ;
> : iteration ( -- ) next-p p @ dup show remove decr-remaining ;
> : run ( -- ) cr init begin remaining @ while iteration repeat cr ;
> 
> run
> ================================================================



OCaml:

let men = Array.init 40 (fun _ -> false) ;;
let ptr = ref (-1) ;;
let man () = !ptr mod 40 ;;
let is_dead () = men.( man() ) ;;
let next_man () =
  incr ptr;
  while is_dead() do  incr ptr  done ;;
let advance_pointer () =
  for i = 1 to 3 do  next_man()  done ;
  men.(man()) <- true ;;
for i = 1 to 40 do
  advance_pointer () ;
  Printf.printf "%d " (succ (man()))
done ;;

3 6 9 12 15 18 21 24 27 30 33 36 39 2 7 11 16 20 25 29 34 38
4 10 17 23 31 37 5 14 26 35 8 22 40 19 1 32 13 28 - : unit = ()

Back to comp.lang.forth | Previous | Next — Next in thread | Find similar | Unroll thread

Thread

Re: Josephus Circle problem "WJ" <w_a_x_man@yahoo.com> - 2014-12-11 13:35 +0000
  Re: Josephus Circle problem "WJ" <w_a_x_man@yahoo.com> - 2014-12-11 18:22 +0000

csiph-web