Josephus in Scheme

Question

Where does this implementation of the Josephus problem fall short? For those who are unfamiliar with the Josephus Problem, the goal is to delete every 3rd entry from a circularly linked list until only one remains. In this example I am deleting every "mth" value.

(define (joseph lst)  
(let ((m (+ 1 (random (length lst)))))
(define (joseph-h i xlst mlst)
 (cond ((<= (length xlst) 1) xlst)
       ((null? (cdr mlst)) 
        (joseph-h i xlst xlst))
       ((= i m) 
        (joseph-h 1 (delete (car mlst) xlst) (cdr mlst)))
       (else 
        (joseph-h (+ i 1) xlst (cdr mlst)))))
 (joseph-h 0 lst lst)))

 (joseph (list 1 2 3 4 5 6 7))


 (define (delete v lst)
   (cond ((= v (car lst)) 
          (cdr lst))
         (else
          (cons (car lst) (delete v (cdr lst)))))) 

I always end up with the last number of the list as the answer. I know that this is not right.

Answer 1

You're taking the algorithm too literally, by creating a list and deleting elements ("killing" people) from it. A simpler solution would be to use arithmetic operations to model the problem, here's a possible implementation, adapted from my own previous answer:

(define (joseph n k)
  (let loop ([i   1]
             [acc 0])
    (if (> i n)
        (add1 acc)
        (loop (add1 i)
              (modulo (+ acc k) i)))))

For example, to see which position survives in the list '(1 2 3 4 5 6 7) after killing every third person, do this:

(joseph 7 3)
=> 4

Wikipedia provides an interesting discussion regarding the possible solutions for this problem, my solution adapts the simple python function shown, after converting it to tail recursion.

Answer 2

I give three solutions at my blog. The most literal version deletes from a list of n items in steps of m, representing the list as a cyclic list:

(define (cycle xs)
  (set-cdr! (last-pair xs) xs) xs)

(define (josephus3 n m)
  (let loop ((k (- m 1)) (alive (cycle (range 0 n))) (dead '()))
    (cond ((= (car alive) (cadr alive))
            (reverse (cons (car alive) dead)))
          ((= k 1)
            (let ((dead (cons (cadr alive) dead)))
              (set-cdr! alive (cddr alive))
              (loop (- m 1) (cdr alive) dead)))

This does the deletions by actually removing the killed elements from the alive list and placing them on the dead list. The range function is from my Standard Prelude; it returns the integers from 0 to n-1:

(define (range first past . step)
  (let* ((xs '()) (f first) (p past)
         (s (cond ((pair? step) (car step))
                  ((< f p) 1) (else -1)))
         (le? (if (< 0 s) <= >=)))
    (do ((x f (+ x s))) ((le? p x) (reverse xs))
      (set! xs (cons x xs)))))

The original Josephus problem killed 41 men in steps of 3, leaving the 31st man as the survivor, counting from 1:

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

You might also enjoy the other two versions at my blog.