You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
120 lines
3.6 KiB
Scheme
120 lines
3.6 KiB
Scheme
27 years ago
|
;; --------------------------------------------------------------------------
|
||
|
|
;; tic-func.ss
|
||
|
|
;; This program plays through all possibilities of a tic-tac-toe
|
||
|
|
;; game, given the first move of a player. It only prints how many
|
||
|
|
;; states are being processed and how many states are terminal at
|
||
|
|
;; each stage of the game. But it is constructed so that it can
|
||
|
|
;; print how to get to a winning terminal state.
|
||
|
|
|
||
|
|
;; It relies on list-library.ss.
|
||
|
|
|
||
|
|
;; representations of fields, states, and collections of states
|
||
|
|
(define null '())
|
||
|
|
(define-structure (entry x y who))
|
||
|
|
(define entry-field
|
||
|
|
(lambda (an-entry)
|
||
|
|
(list (entry-x an-entry) (entry-y an-entry))))
|
||
|
|
;(define-type state (listof (structure:entry num num (union 'x 'o)))
|
||
|
|
;(define-type states (listof state))
|
||
|
|
|
||
|
|
(define PLAYER 'x)
|
||
|
|
(define OPPONENT 'o)
|
||
|
|
|
||
|
|
(define tic-tac-toe
|
||
|
|
(lambda (x y)
|
||
|
|
(tic (list (list (make-entry x y PLAYER))))))
|
||
|
|
|
||
|
|
(define make-move
|
||
|
|
(lambda (other-move p/o tag)
|
||
|
|
(lambda (states)
|
||
|
|
(printf "~s: processing ~s states of length ~s ~n"
|
||
|
|
tag (length states) (length (car states)))
|
||
|
|
(let ((t (print&remove-terminals states)))
|
||
|
|
(printf "terminal states removed: ~s~n"
|
||
|
|
(- (length states) (length t)))
|
||
|
|
(if (null? t)
|
||
|
|
(void)
|
||
|
|
(other-move (apply append (map p/o t))))))))
|
||
|
|
|
||
|
|
(define tic (make-move (lambda (x) (tac x)) (lambda (x) (opponent x)) 'tic))
|
||
|
|
|
||
|
|
(define tac (make-move (lambda (x) (tic x)) (lambda (x) (player x)) 'tac))
|
||
|
|
|
||
|
|
(define make-players
|
||
|
|
(local ((define rest-of-fields
|
||
|
|
(lambda (used-fields)
|
||
|
|
(set-minus ALL-FIELDS used-fields))))
|
||
|
|
(lambda (player/opponent)
|
||
|
|
(lambda (astate)
|
||
|
|
(map (lambda (counter-move)
|
||
|
|
(let ((counter-x (car counter-move))
|
||
|
|
(counter-y (cadr counter-move)))
|
||
|
|
(cons (make-entry counter-x counter-y player/opponent)
|
||
|
|
astate)))
|
||
|
|
(rest-of-fields (map entry-field astate)))))))
|
||
|
|
|
||
|
|
(define player (make-players PLAYER))
|
||
|
|
|
||
|
|
(define opponent (make-players OPPONENT))
|
||
|
|
|
||
|
|
(define terminal?
|
||
|
|
(local ((define filter-p/o
|
||
|
|
(lambda (p/o astate)
|
||
|
|
(map entry-field
|
||
|
|
(filter (lambda (x) (eq? (entry-who x) p/o)) astate)))))
|
||
|
|
(lambda (astate)
|
||
|
|
(and (>= (length astate) 5)
|
||
|
|
(let ((PLAYERf (filter-p/o PLAYER astate))
|
||
|
|
(OPPONENTf (filter-p/o OPPONENT astate)))
|
||
|
|
(or
|
||
|
|
(= (length astate) 9)
|
||
|
|
(ormap (lambda (ts) (subset? ts PLAYERf)) TERMINAL-STATES)
|
||
|
|
(ormap (lambda (ts) (subset? ts OPPONENTf)) TERMINAL-STATES)))))))
|
||
|
|
|
||
|
|
(define print&remove-terminals
|
||
|
|
(local (
|
||
|
|
|
||
|
|
(define print-state1
|
||
|
|
(lambda (x)
|
||
|
|
(display x)
|
||
|
|
(newline)))
|
||
|
|
|
||
|
|
(define print-state2
|
||
|
|
(lambda (astate)
|
||
|
|
(cond
|
||
|
|
((null? astate) (printf "------------~n"))
|
||
|
|
(else (print-state (cdr astate))
|
||
|
|
(let ((x (car astate)))
|
||
|
|
(printf " ~s @ (~s,~s) ~n"
|
||
|
|
(entry-who x) (entry-x x) (entry-y x)))))))
|
||
|
|
|
||
|
|
(define print-state
|
||
|
|
(lambda (x)
|
||
|
|
;(display ".")
|
||
|
|
(void))))
|
||
|
|
|
||
|
|
(collect null (lambda (_ astate rest)
|
||
|
|
(if (terminal? astate)
|
||
|
|
(begin (print-state astate) rest)
|
||
|
|
(cons astate rest))))))
|
||
|
|
;; fields
|
||
|
|
(define T
|
||
|
|
(lambda (alof)
|
||
|
|
(cond
|
||
|
|
((null? alof) null)
|
||
|
|
(else (cons (list (cadr (car alof)) (car (car alof)))
|
||
|
|
(T (cdr alof)))))))
|
||
|
|
|
||
|
|
(define row1 (list (list 1 1) (list 1 2) (list 1 3)))
|
||
|
|
(define row2 (list (list 2 1) (list 2 2) (list 2 3)))
|
||
|
|
(define row3 (list (list 3 1) (list 3 2) (list 3 3)))
|
||
|
|
(define col1 (list (list 1 1) (list 2 1) (list 3 1)))
|
||
|
|
(define col2 (list (list 1 2) (list 2 2) (list 3 2)))
|
||
|
|
(define col3 (list (list 1 3) (list 2 3) (list 3 3)))
|
||
|
|
(define posd (list (list 1 1) (list 2 2) (list 3 3)))
|
||
|
|
(define negd (list (list 1 3) (list 2 2) (list 3 1)))
|
||
|
|
|
||
|
|
(define TERMINAL-STATES (list row1 row2 row3 col1 col2 col3 posd negd))
|
||
|
|
|
||
|
|
(define ALL-FIELDS (append row1 row2 row3))
|