65 lines
2 KiB
Common Lisp
65 lines
2 KiB
Common Lisp
(setf *random-state* (make-random-state t))
|
|
|
|
(defparameter *heads* #\H)
|
|
(defparameter *tails* #\T)
|
|
|
|
(defun main ()
|
|
(format t "Penney's Game~%~%")
|
|
(format t "Flipping to see who goes first ...")
|
|
|
|
(setq p2 nil)
|
|
(if (string= (flip) *heads*)
|
|
(progn (format t " I do.~%")
|
|
(setq p2 (choose-random-sequence))
|
|
(format t "I choose: ~A~%" p2))
|
|
(format t "You do.~%"))
|
|
|
|
(setq p1 nil)
|
|
(loop while (null p1) doing
|
|
(format t "Enter your three-flip sequence: ")
|
|
(setq p1 (string (read)))
|
|
(cond ((/= (length p1) 3)
|
|
(format t "Sequence must consist of three flips.~%")
|
|
(setq p1 nil))
|
|
((string= p1 p2)
|
|
(format t "Sequence must be different from mine.~%")
|
|
(setq p1 nil))
|
|
((notevery #'valid? (coerce p1 'list))
|
|
(format t "Sequence must be contain only ~A's and ~A's.~%" *heads* *tails*)
|
|
(setq p1 nil))))
|
|
(format t "You picked: ~A~%" p1)
|
|
|
|
(if (null p2)
|
|
(progn
|
|
(setq p2 (choose-optimal-sequence p1))
|
|
(format t "I choose: ~A~%" p2)))
|
|
|
|
(format t "Here we go. ~A, you win; ~A, I win.~%" p1 p2)
|
|
(format t "Flips:")
|
|
(let ((winner nil)
|
|
(flips '()))
|
|
(loop while (null winner) doing
|
|
(setq flips (cons (flip) flips))
|
|
(format t " ~A" (car flips))
|
|
(if (>= (length flips) 3)
|
|
(let ((trail (coerce (reverse (subseq flips 0 3)) 'string)))
|
|
(cond ((string= trail p1) (setq winner "You"))
|
|
((string= trail p2) (setq winner "I"))))))
|
|
(format t "~&~A win!" winner)))
|
|
|
|
(defparameter *sides* (list *heads* *tails*))
|
|
(defun flip () (nth (random 2 *random-state*) *sides*))
|
|
|
|
(defun valid? (flip) (not (null (member flip *sides*))))
|
|
|
|
(defun opposite (flip) (if (string= flip *heads*) *tails* *heads*))
|
|
|
|
(defun choose-random-sequence () (coerce (list (flip) (flip) (flip)) 'string))
|
|
|
|
(defun choose-optimal-sequence (against)
|
|
(let* ((opposed (coerce against 'list))
|
|
(middle (cadr opposed))
|
|
(my-list (list (opposite middle) (car opposed) middle)))
|
|
(coerce my-list 'string)))
|
|
|
|
(main)
|