[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Jan 7:
; nim

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (logxor a b)
  (cond ((zero? a) b)
        ((zero? b) a)
         (+ (* (logxor (floor (/ a 2)) (floor (/ b 2))) 2)
            (if (even? a)
                (if (even? b) 0 1)
                (if (even? b) 1 0))))))

(define (nim-sum pos)
  (if (null? pos) 0
    (logxor (car pos) (nim-sum (cdr pos)))))

(define (choose-move pos)
  (let ((x (nim-sum pos)))
    (if (zero? x)
        (let loop ((pos pos) (k 1))
          (if (positive? (car pos)) (cons k 1)
            (loop (cdr pos) (+ k 1))))
        (let loop ((pos pos) (k 1))
          (if (< (logxor (car pos) x) (car pos))
              (cons k (- (car pos) (logxor (car pos) x)))
              (loop (cdr pos) (+ k 1)))))))

(define (apply-move pos move)
  (let* ((k (- (car move) 1))
         (fs (take k pos))
         (bs (drop k pos)))
    (append fs (cons (- (car bs) (cdr move)) (cdr bs)))))

(define (display-pos pos)
  (do ((pos pos (cdr pos)) (k 1 (+ k 1)))
      ((null? pos))
    (display k)
    (display ": ")
    (display (car pos))

(define (display-move move)
  (display "I remove ") (display (cdr move))
  (if (= (cdr move) 1)
      (display " stone from pile ")
      (display " stones from pile "))
  (display (car move)) (newline))

(define (prompt message) (display message) (read))

(define (ask-move pos)
  (display-pos pos)
  (let* ((pile (prompt "Pile? ")) (stones (prompt "Stones? ")))
    (cons pile stones)))

(define (play pos who)
  (cond ((zero? (apply + pos))
          (display (if (eq? who 'human) "I win" "You win"))
        ((eq? who 'human)
          (play (apply-move pos (ask-move pos)) 'computer))
        (else (let ((move (choose-move pos)))
                (display-move move)
                (play (apply-move pos move) 'human)))))

(define (nim . xs)
  (let* ((msg "Enter 1 to move first or 2 to move second: "))
    (play xs (if (= (prompt msg) 1) 'human 'computer))))

No errors or program output.

Create a new paste based on this one