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

Groups > comp.lang.forth > #34874

Re: Josephus Circle problem

Show all headers | View raw

WJ wrote:

> 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 = ()

Another way:

let men = Array.init 40 (fun _ -> false) ;;
let ptr = ref (-1) ;;
let man () = !ptr mod 40 ;;
let is_dead () = men.( man() ) ;;
let some_alive () = not (Array.fold_left (fun a b -> a&&b) true men) ;;
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 ;;
while some_alive () do
  advance_pointer () ;
  Printf.printf "%d " (succ (man()))
done ;;

Back to comp.lang.forth | Previous | Next — Previous 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