; 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)
(else
(+ (* (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))
(newline)))
(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"))
(newline))
((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))))