[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/RMwrace2    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Feb 19:
(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)))))

(define (josephus1 n m)
  (let loop ((k m) (alive (range 0 n)) (dead '()))
    (cond ((null? (cdr alive)) (reverse (cons (car alive) dead)))
          ((= k 1) (loop m (cdr alive) (cons (car alive) dead)))
          (else (loop (- k 1) (append (cdr alive) (list (car alive))) dead)))))

(display (josephus1 41 3)) (newline)

(define (josephus2 n m)
  (let loop ((k m) (front (range 0 n)) (back '()) (dead '()))
    (cond ((and (null? front) (null? back)) (reverse dead))
          ((null? front) (loop k (reverse back) '() dead))
          ((= k 1) (loop m (cdr front) back (cons (car front) dead)))
          (else (loop (- k 1) (cdr front) (cons (car front) back) dead)))))

(display (josephus2 41 3)) (newline)

(define (last-pair xs)
  (if (null? (cdr xs))
      xs
      (last-pair (cdr xs))))

(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)))
          (else (loop (- k 1) (cdr alive) dead)))))

(display (josephus3 41 3)) (newline)


Output:
1
2
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)
(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)
(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)


Create a new paste based on this one


Comments: