TIC-TAC-TOE

These functions are on the files BASIC, GAME, TICTA1, and TICTA2.


These functions are on file BASIC:


(DEFPROP BASICFNS
 (BASICFNS ORLIS ANDLIS MAPCAR2 MAPCHOOSE MAPAPP PRUP LISTSUBT LISTSUBTA CONTAINED DELETE PICKOUT PICKOUTA)
VALUE)

(DEFPROP ORLIS
 (LAMBDA (PRED U) (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)

(DEFPROP ANDLIS
 (LAMBDA (PRED U) (OR (NULL U) (AND (PRED (CAR U)) (ANDLIS PRED (CDR U)))))
EXPR)

(DEFPROP MAPCAR2
 (LAMBDA (FN U V) (COND ((NULL U) NIL) (T (CONS (FN (CAR U) (CAR V)) (MAPCAR2 FN (CDR U) (CDR V))))))
EXPR)

(DEFPROP MAPCHOOSE
 (LAMBDA(PRED FN U)
  (COND	((NULL U) NIL)
	((PRED (CAR U)) (CONS (FN (CAR U)) (MAPCHOOSE PRED FN (CDR U))))
	(T (MAPCHOOSE PRED FN (CDR U)))))
EXPR)

(DEFPROP MAPAPP
 (LAMBDA (FN U) (COND ((NULL U) NIL) (T (APPEND (FN (CAR U)) (MAPAPP FN (CDR U))))))
EXPR)

(DEFPROP PRUP
 (LAMBDA(U V)
  (COND	((NULL U) (COND ((NULL V) NIL) (T (ERROR (QUOTE (V LONGER - PRUP))))))
	((NULL V) (ERROR (QUOTE (U LONGER - PRUP))))
	(T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
EXPR)

(DEFPROP LISTSUBT
 (LAMBDA (U V) (LISTSUBTA U (DIFFERENCE (LENGTH U) (LENGTH V)) NIL))
EXPR)

(DEFPROP LISTSUBTA
 (LAMBDA (U N Z) (COND ((EQUAL N 0) Z) (T (LISTSUBTA (CDR U) (SUB1 N) (CONS (CAR U) Z)))))
EXPR)

(DEFPROP CONTAINED
 (LAMBDA (U V) (OR (NULL U) (AND (MEMBER (CAR U) V) (CONTAINED (CDR U) V))))
EXPR)

(DEFPROP DELETE
 (LAMBDA (X U) (COND ((NULL U) NIL) ((EQUAL X (CAR U)) (CDR U)) (T (CONS (CAR U) (DELETE X (CDR U))))))
EXPR)

(DEFPROP PICKOUT
 (LAMBDA (PRED U) (PICKOUTA PRED U NIL NIL))
EXPR)

(DEFPROP PICKOUTA
 (LAMBDA(PRED U X Y)
  (COND	((NULL U) (CONS X Y))
	((PRED (CAR U)) (PICKOUTA PRED (CDR U) (CONS (CAR U) X) Y))
	(T (PICKOUTA PRED (CDR U) X (CONS (CAR U) Y)))))
EXPR)

********************

These functions are on file GAME:

(DEFPROP GAMEFNS
 (GAMEFNS VALMAX VALMAXLIS VALMIN VALMINLIS RECTIFY COMMONTAIL COMMONHEAD)
VALUE)

(DEFPROP VALMAX
 (LAMBDA(P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA)
	 (CONS (MAX (CAR ALPHA) (MIN (CAR BETA) (IMVAL (RECTIFY P) ALPHA BETA))) P))
	(T (VALMAXLIS (SUCCESSORS (RECTIFY P) ALPHA BETA) ALPHA BETA))))
EXPR)

(DEFPROP VALMAXLIS
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) ALPHA)
	(T
	 ((LAMBDA(X)
	   (COND ((NOT (LESSP (CAR X) (CAR BETA))) BETA)
		 (T (VALMAXLIS (CDR U) (COND ((NOT (LESSP (CAR ALPHA) (CAR X))) ALPHA) (T X)) BETA))))
	  (VALMIN (CAR U) ALPHA BETA)))))
EXPR)

(DEFPROP VALMIN
 (LAMBDA(P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA)
	 (CONS (MAX (CAR ALPHA) (MIN (CAR BETA) (IMVAL (RECTIFY P) ALPHA BETA))) P))
	(T (VALMINLIS (SUCCESSORS (RECTIFY P) ALPHA BETA) ALPHA BETA))))
EXPR)

(DEFPROP VALMINLIS
 (LAMBDA(U ALPHA BETA)
  (COND	((NULL U) BETA)
	(T
	 ((LAMBDA(X)
	   (COND ((NOT (GREATERP (CAR X) (CAR ALPHA))) ALPHA)
		 (T (VALMINLIS (CDR U) ALPHA (COND ((NOT (GREATERP (CAR BETA) (CAR X))) BETA) (T X))))))
	  (VALMAX (CAR U) ALPHA BETA)))))
EXPR)

(DEFPROP RECTIFY
 (LAMBDA(P)
  (PROG	(Z Q)
	(SETQ Q (COMMONTAIL P P1))
   L1	(COND ((EQUAL Q P1) (GO L2)))
	(REVERT)
	(GO L1)
   L2	(SETQ Z (LISTSUBT P P1))
   L3	(COND ((NULL Z) (RETURN P)))
	(UPDATE (CAR Z))
	(SETQ Z (CDR Z))
	(GO L3)))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)

(DEFPROP COMMONHEAD
 (LAMBDA(U V)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
	(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)

********************

These functions are on file TICTA1:

(DEFPROP TICTACFNS
 (TRY2 NEWGAME TER IMVAL SUCCESSORS REVERT UPDATE PTS LINES SORT
SORTA SORTB SORTC WIN ANSWER DOUBLETH THREAT)
VALUE)

(DEFPROP NEWGAME
 (LAMBDA NIL
  (PROG	NIL
	(SETQ P1 NIL)
	(SETQ XS NIL)
	(SETQ OS NIL)
	(SETQ BS (QUOTE (1 2 3 4 5 6 7 10 11)))
	(SETQ W NIL)
	(SETQ LEVEL 0)
	(SETQ COUNT 0)
	(RETURN (QUOTE (NEW GAME)))))
EXPR)

(DEFPROP TER
 (LAMBDA(P ALPHA BETA)
  (AND (NOT (NULL P))
	 (OR (EQUAL LEVEL 11)
	     (LESSP (DIFFERENCE 11 LEVEL) (CAR ALPHA))
	     (GREATERP (PLUS -11 LEVEL) (CAR BETA))
	     (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (COND (W XS) (T OS)))))
		    (CAR (NTH LINES (CAR P))))))
)
EXPR)

(DEFPROP IMVAL
 (LAMBDA(P ALPHA BETA)
  (COND	((ORLIS	(FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (COND (W XS) (T OS)))))
		(CAR (NTH LINES (CAR P))))
	 (COND (W (DIFFERENCE 12 LEVEL)) (T (PLUS -12 LEVEL))))
	(T 0)))
EXPR)

(DEFPROP SUCCESSORS
 (LAMBDA (P ALPHA BETA) (SORT (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P))) BS)))
EXPR)

(DEFPROP REVERT
 (LAMBDA NIL
  (PROG	NIL
	(SETQ LEVEL (SUB1 LEVEL))
	(SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
	(COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
	(SETQ W (NOT W))
	(SETQ P1 (CDR P1))
	(RETURN (LIST (QUOTE XS) XS (QUOTE OS) OS (QUOTE BS) BS (QUOTE W) W (QUOTE P1) P1))))
EXPR)

(DEFPROP UPDATE
 (LAMBDA(M)
  (PROG	NIL
	(SETQ LEVEL (ADD1 LEVEL))
	(COND (W (SETQ OS (CONS M OS))) (T (SETQ XS (CONS M XS))))
	(SETQ BS (DELETE M BS))
	(SETQ P1 (CONS M P1))
	(SETQ W (NOT W))
	(SETQ COUNT (ADD1 COUNT))
	(RETURN (LIST (QUOTE XS) XS (QUOTE OS) OS (QUOTE BS) BS (QUOTE W) W (QUOTE P1) P1))))
EXPR)

(DEFPROP PTS
 (NIL (1 2 3) (4 5 6) (7 10 11) (1 4 7) (2 5 10) (3 6 11) (1 5 11) (3 5 7))
VALUE)

(DEFPROP LINES
 (NIL (1 4 7) (1 5) (1 6 10) (2 4) (2 5 7 10) (2 6) (3 4 10) (3 5) (3 6 7))
VALUE)

(DE SORT (U) (SORTA U NIL NIL))

(DE SORTA (U TH ORD) (COND ((NULL U) (APPEND TH ORD))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	((DOUBLETH (CAR U)) (SORTC (CDR U) (CAR U)))
	((THREAT (CAR U)) (SORTA (CDR U) (CONS (CAR U) TH) ORD))
	(T (SORTA (CDR U) TH (CONS (CAR U) ORD)))))

(DE SORTB (U M) (COND ((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	(T (SORTB (CDR U) M))))

(DE SORTC (U M) (COND ((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	(T (SORTC (CDR U) M))))

(DEFPROP WIN
 (LAMBDA(P)
  (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS (CAR P) (COND (W OS) (T XS))))))
	 (CAR (NTH LINES (CAR P)))))
EXPR)

(DEFPROP ANSWER
 (LAMBDA(P)
  (ORLIS (FUNCTION (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS (CAR P) (COND (W XS) (T OS))))))
	 (CAR (NTH LINES (CAR P)))))
EXPR)

(DEFPROP THREAT
 (LAMBDA(P)
  (ORLIS (FUNCTION
	  (LAMBDA(SQ)
	   (ORLIS (FUNCTION
		   (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS SQ (CONS (CAR P) (COND (W OS) (T XS)))))))
		  (CAR (NTH LINES SQ)))))
	 (DELETE (CAR P) BS)))
EXPR)

(DE DOUBLETH (P) 
  (TWOLIS (FUNCTION
	  (LAMBDA(SQ)
	   (ORLIS (FUNCTION
		   (LAMBDA (X) (CONTAINED (CAR (NTH PTS X)) (CONS SQ (CONS (CAR P) (COND (W OS) (T XS)))))))
		  (CAR (NTH LINES SQ)))))
	 (DELETE (CAR P) BS)))

(DE TWOLIS (PRED U) (AND (NOT (NULL U)) (OR (AND (PRED (CAR U)) (ORLIS PRED
(CDR U))) (TWOLIS PRED (CDR U)))))

*******************

These functions are on file TICTA2:

(DEFPROP TICTACFNS
 (TRY2 COMMENCE
       NEWGAME
       TER
       IMVAL
       SUCCESSORS
       REVERT
       UPDATE
       PTS
       LINES
       SORT
       SORTA
       SORTB
       SORTC
       WIN
       ANSWER
       DOUBLETH
	TWOLIS
       THREAT)
VALUE)

(DEFPROP COMMENCE
 (LAMBDA NIL
  (PROG	NIL
	(ARRAY LINES T 12)
	(ARRAY XCOUNT 44 11)
	(ARRAY OCOUNT 44 11)
	(STORE (LINES 1) (QUOTE (1 4 7)))
	(STORE (LINES 2) (QUOTE (1 5)))
	(STORE (LINES 3) (QUOTE (1 6 10)))
	(STORE (LINES 4) (QUOTE (2 4)))
	(STORE (LINES 5) (QUOTE (2 5 7 10)))
	(STORE (LINES 6) (QUOTE (2 6)))
	(STORE (LINES 7) (QUOTE (3 4 10)))
	(STORE (LINES 10) (QUOTE (3 5)))
	(STORE (LINES 11) (QUOTE (3 6 7)))))
EXPR)

(DEFPROP NEWGAME
 (LAMBDA NIL
  (PROG	(N)
	(SETQ N 0)
   L	(SETQ N (ADD1 N))
	(STORE (XCOUNT N) 0)
	(STORE (OCOUNT N) 0)
	(COND ((LESSP N 10) (GO L)))
	(SETQ P1 NIL)
	(SETQ XS NIL)
	(SETQ OS NIL)
	(SETQ BS (QUOTE (1 2 3 4 5 6 7 10 11)))
	(SETQ W NIL)
	(SETQ LEVEL 0)
	(SETQ COUNT 0)
	(RETURN (QUOTE (NEW GAME)))))
EXPR)

(DEFPROP TER
 (LAMBDA(P ALPHA BETA)
  (AND (NOT (NULL P))
       (OR (EQUAL LEVEL 11)
	   (LESSP (DIFFERENCE 11 LEVEL) (CAR ALPHA))
	   (GREATERP (PLUS -11 LEVEL) (CAR BETA))
	   (PROG (N)
		 (SETQ N 0)
	    L2	 (SETQ N (ADD1 N))
		 (COND ((EQUAL 3 (COND (W (XCOUNT N)) (T (OCOUNT N)))) (RETURN T)))
		 (COND ((LESSP N 10) (GO L2)))
		 (RETURN NIL)))))
EXPR)

(DEFPROP IMVAL
 (LAMBDA(P ALPHA BETA)
  (COND	(W
	 (PROG (N)
	       (SETQ N 0)
	  L3   (SETQ N (ADD1 N))
	       (COND ((EQUAL 3 (XCOUNT N)) (RETURN (DIFFERENCE 12 LEVEL))))
	       (COND ((LESSP N 10) (GO L3)) (T (RETURN 0)))))
	(T
	 (PROG (N)
	       (SETQ N 0)
	  L4   (SETQ N (ADD1 N))
	       (COND ((EQUAL 3 (OCOUNT N)) (RETURN (PLUS -12 LEVEL))))
	       (COND ((LESSP N 10) (GO L4)) (T (RETURN 0)))))))
EXPR)

(DEFPROP SUCCESSORS
 (LAMBDA (P ALPHA BETA) (SORT (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P))) BS)))
EXPR)

(DEFPROP REVERT
 (LAMBDA NIL
  (PROG	(A)
	(SETQ LEVEL (SUB1 LEVEL))
	(SETQ BS (CONS (CAR (COND (W XS) (T OS))) BS))
	(COND (W (SETQ XS (CDR XS))) (T (SETQ OS (CDR OS))))
	(SETQ A (LINES (CAR P1)))
   L5	(COND ((NULL A) (GO L6)))
	(COND (W (STORE (XCOUNT (CAR A)) (SUB1 (XCOUNT (CAR A)))))
	      (T (STORE (OCOUNT (CAR A)) (SUB1 (OCOUNT (CAR A))))))
	(SETQ A (CDR A))
	(GO L5)
   L6	(SETQ W (NOT W))
	(SETQ P1 (CDR P1))
	(RETURN)))
EXPR)

(DEFPROP UPDATE
 (LAMBDA(M)
  (PROG	(A)
	(SETQ LEVEL (ADD1 LEVEL))
	(COND (W (SETQ OS (CONS M OS))) (T (SETQ XS (CONS M XS))))
	(SETQ BS (DELETE M BS))
	(SETQ P1 (CONS M P1))
	(SETQ COUNT (ADD1 COUNT))
	(SETQ A (LINES M))
   L7	(COND ((NULL A) (GO L8)))
	(COND (W (STORE (OCOUNT (CAR A)) (ADD1 (OCOUNT (CAR A)))))
	      (T (STORE (XCOUNT (CAR A)) (ADD1 (XCOUNT (CAR A))))))
	(SETQ A (CDR A))
	(GO L7)
   L8	(SETQ W (NOT W))
	(RETURN )))
EXPR)

(DEFPROP SORT
 (LAMBDA (U) (SORTA U NIL NIL))
EXPR)

(DEFPROP SORTA
 (LAMBDA(U TH ORD)
  (COND	((NULL U) (APPEND TH ORD))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	((DOUBLETH (CAR U)) (SORTC (CDR U) (CAR U)))
	((THREAT (CAR U)) (SORTA (CDR U) (CONS (CAR U) TH) ORD))
	(T (SORTA (CDR U) TH (CONS (CAR U) ORD)))))
EXPR)

(DEFPROP SORTB
 (LAMBDA (U M) (COND ((NULL U) (LIST M)) ((WIN (CAR U)) (LIST (CAR U))) (T (SORTB (CDR U) M))))
EXPR)

(DEFPROP SORTC
 (LAMBDA(U M)
  (COND	((NULL U) (LIST M))
	((WIN (CAR U)) (LIST (CAR U)))
	((ANSWER (CAR U)) (SORTB (CDR U) (CAR U)))
	(T (SORTC (CDR U) M))))
EXPR)

(DEFPROP WIN
 (LAMBDA(P)
  (COND	(W (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (OCOUNT X)))) (LINES (CAR P))))
	(T (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (XCOUNT X)))) (LINES (CAR P))))))
EXPR)

(DEFPROP ANSWER
 (LAMBDA(P)
  (COND	(W (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (XCOUNT X)))) (LINES (CAR P))))
	(T (ORLIS (FUNCTION (LAMBDA (X) (EQUAL 2 (OCOUNT X)))) (LINES (CAR P))))))
EXPR)

(DEFPROP DOUBLETH
 (LAMBDA(P)
  (TWOLIS (FUNCTION
	   (LAMBDA(X)
	    (AND (EQUAL 1 (COND (W (OCOUNT X)) (T (XCOUNT X))))
		 (ORLIS (FUNCTION (LAMBDA (W) (MEMBER X (LINES W)))) (DELETE (CAR P) BS)))))
	  (LINES (CAR P))))
EXPR)

(DEFPROP THREAT
 (LAMBDA(P)
  (ORLIS (FUNCTION
	  (LAMBDA(X)
	   (AND	(EQUAL 1 (COND (W (OCOUNT X)) (T (XCOUNT X))))
		(ORLIS (FUNCTION (LAMBDA (W) (MEMBER X (LINES W)))) (DELETE (CAR P) BS)))))
	 (LINES (CAR P))))
EXPR)

(DE TWOLIS (PRED U) (AND (NOT (NULL U))
	(OR (AND (PRED (CAR U)) (ORLIS PRED (CDR U)))
	    (TWOLIS PRED (CDR U)))))