Lisp Крестики Нолики

(defpackage :xo (:use :cl) (:export :start-game)) (in-package :xo) (defvar *game-space* (make-array '(3 3))) (defvar *turns-history*) (defmacro other-player (who) `(if (eql ,who :X) :0 :X)) (defmacro first-possible (&rest forms) (if forms `(if ,(car forms) ,(car forms) (first-possible ,@(cdr forms))))) (defvar *printing* t) (defvar *ai* nil) ;;; Printing section ;;; (defun print-game-space () (princ " - 1 - 2 - 3 -") ;; X indexes (princ #\Newline) (princ "- -------------") (loop for i upto 2 doing (princ #\Newline) (princ (+ 1 i)) (princ " |") ;; Y indexes (loop for j upto 2 doing (format t " ~a |" (first-possible (aref *game-space* i j) " "))) (princ #\Newline) (princ "- -------------")) (princ #\Newline) nil)( (defun print-turns-history () (princ #\Newline) (princ "The turns were:") (princ #\Newline) (let ((who :X)) (loop for i upto 9 for (x y) in (reverse *turns-history*) doing (format t "~d. The ~a turn was: x - ~d, y - ~d.~%" (+ i 1) who (+ x 1) (+ y 1)) (setf who (other-player who))))) (defun win (who &optional technical) (when *printing* (print-game-space) (format t "~a is winner!" who) (if technical (progn (princ " Technical victory!") nil) (print-turns-history))) (list who technical)) (defun draw () (when *printing* (print-game-space) (princ "Draw! Nobody wins.") (print-turns-history)) nil) ;;; end Printing section ;;; ;;; AI section ;;; (defun ensure-row (how-many who row) (if (= how-many (loop for i upto 2 summing (if (eql who (elt (second row) i)) 1 (if (eql (other-player who) (elt (second row) i)) -2 0)))) (first row))) (defun row (game-space n &optional (column nil)) (let ((indexes (loop for i to 2 collecting (list (if column n i) (if column i n))))) (list indexes (loop for i in indexes collecting (aref game-space (first i) (second i)))))) (defun diagonal (game-space &optional (minus nil)) (let ((indexes (loop for i to 2 collecting (list (if minus (- 2 i) i) i)))) (list indexes (loop for index in indexes collecting (aref game-space (first index) (second index)))))) (defun search-for-all-empties (list-of-cells game-space) (remove-if-not #'(lambda (x) (null (aref game-space (first x) (second x)))) list-of-cells)) (defun the-most-frequent (minimum &rest lists) (let ((great-list (apply #'concatenate 'list lists))) (nth (first-possible (position (if (<= minimum (loop for cell in great-list maximize (count cell great-list :test #'equal))) (loop for cell in great-list maximize (count cell great-list :test #'equal)) nil) (loop for cell in great-list collecting (count cell great-list :test #'equal))) 99) great-list))) (defun whole-space (game-space) (concatenate 'list (first (row game-space 0)) (first (row game-space 1)) (first (row game-space 2)))) (defun all-space (game-space) (list (row game-space 0) (row game-space 1) (row game-space 2) (row game-space 0 t) (row game-space 1 t) (row game-space 2 t) (diagonal game-space) (diagonal game-space t))) (defun ai-find-turn (who game-space &optional aim) (cond ((eql aim :win) (setf aim 2)) ((eql aim :trapping) (setf aim 1)) (t (setf aim 0))) (search-for-all-empties (apply #'concatenate 'list (remove-if #'null (loop for row in (all-space game-space) collecting (ensure-row aim who row)))) game-space)) (defun ai-find-good-turn (who game-space) ;; this is bad (first-possible (the-most-frequent 1 (ai-find-turn who game-space :trapping) (ai-find-turn who game-space) (ai-find-turn who game-space)))) (defun ai-find-trap (who game-space &optional of-enemy) ;; this is better (if of-enemy (setf who (other-player who))) (first-possible (the-most-frequent (if of-enemy 3 2) (ai-find-turn who game-space :trapping) (if of-enemy ;; to block a trap with attack (ai-find-turn (other-player who) game-space :trapping))))) (defun ai-find-any (game-space) (search-for-all-empties (whole-space game-space) game-space)) (defun ai (who game-space level) (first-possible (if (> level 0) (car (ai-find-turn who game-space :win))) (if (> level 1) (car (ai-find-turn (other-player who) game-space :win))) (if (> level 3) (ai-find-trap who game-space)) (if (> level 4) (ai-find-trap who game-space t)) (if (> level 2) (ai-find-good-turn who game-space)) (first (ai-find-any game-space)))) ;;; end AI section ;;; ;;; X0 section ;;; ;; WARNING This function uses some functions from AI section (defun check-for-victory (who) (find-if-not #'null (loop for row in (all-space *game-space*) collecting (ensure-row 3 who row)))) (defun check-for-correctness (x y) (and (and (find x '(1 2 3)) (find y '(1 2 3))) ;; If some other symbol inserted (null (aref *game-space* (- x 1) (- y 1))))) ;; If already exists (defun check-for-draw () (= 0 (loop for i upto 2 summing (loop for j upto 2 summing (if (null (aref *game-space* i j)) 1 0))))) (defun ask-for-input (who) (cond ((eql who (first *ai*)) (ai who *game-space* (second *ai*))) ((eql :X0 (first *ai*)) (ai who *game-space* (if (eql :X who) (first (second *ai*)) (second (second *ai*))))) (t (let ((x (read)) (y (read))) (if (eql :ai x) (ai who *game-space* y) (if (check-for-correctness x y) (list (decf x) (decf y)))))))) ;; Make input numbers indexes. (defun turn (&optional (who :X)) (when *printing* (princ "It is the turn of ") (princ (if (eql :X who) "X!" "0!")) (princ #\Newline) (print-game-space)) (let ((input (ask-for-input who))) (if (null input) (win (other-player who) t) ;; Exit variant #1 -- not win. (let ((x (first input)) (y (second input))) (push (list x y) *turns-history*) (setf (aref *game-space* x y) who) (if (check-for-victory who) (win who) ;; Exit variant #2 -- win. (if (check-for-draw) (draw) ;; Exit variant #3 -- draw. (turn (other-player who)))))))) ;; Recursive call! (defun start-game (&optional (ai nil) (printing t)) (setf *printing* printing) (setf *ai* ai) (setf *turns-history* nil) ;; Turns history clearing. (loop for i upto 2 doing (loop for j upto 2 doing (setf (aref *game-space* 3 3) nil))) ;; Game space clearing. (turn)) ;;; end X0 section ;;;