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.
124 lines
3.2 KiB
Scheme
124 lines
3.2 KiB
Scheme
27 years ago
|
;; --------------------------------------------------------------------------
|
||
|
|
;; tic-bang.ss
|
||
|
|
;; This is an imperative version.
|
||
|
|
|
||
|
|
;; 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.
|
||
|
|
|
||
|
|
;; This program lacks the capability to print how a situation arose.
|
||
|
|
|
||
|
|
;; It relies on list-library.ss.
|
||
|
|
|
||
|
|
;; representations of fields, states, and collections of states
|
||
|
|
(define BLANK 0)
|
||
|
|
|
||
|
|
(define new-state
|
||
|
|
(lambda ()
|
||
|
|
(make-2vec 3 BLANK)))
|
||
|
|
|
||
|
|
(define update-state
|
||
|
|
(lambda (state x y token)
|
||
|
|
(2vec-set! state x y token)
|
||
|
|
state))
|
||
|
|
|
||
|
|
(define blank?
|
||
|
|
(lambda (astate i j)
|
||
|
|
(eq? (2vec-ref astate i j) BLANK)))
|
||
|
|
|
||
|
|
(define clone-state
|
||
|
|
(lambda (state)
|
||
|
|
(let ((s (new-state)))
|
||
|
|
(let loop ((i 0) (j 0))
|
||
|
|
(cond
|
||
|
|
((and (= i 3) (= j 0)) (void))
|
||
|
|
((< j 3) (update-state s i j (2vec-ref state i j)) (loop i (+ j 1)))
|
||
|
|
((< i 3) (loop (+ i 1) 0))
|
||
|
|
(else 'bad)))
|
||
|
|
s)))
|
||
|
|
|
||
|
|
;(define-type state (2vector (union 'x 'o '_)))
|
||
|
|
;(define-type states (listof state))
|
||
|
|
|
||
|
|
(define PLAYER 1)
|
||
|
|
(define OPPONENT 2)
|
||
|
|
|
||
|
|
(define tic-tac-toe
|
||
|
|
(lambda (x y)
|
||
|
|
(tic (list (update-state (new-state) (- x 1) (- y 1) PLAYER)))))
|
||
|
|
|
||
|
|
(define make-move
|
||
|
|
(lambda (other-move p/o tag)
|
||
|
|
(lambda (states)
|
||
|
|
(printf "~s: processing ~s states ~n" tag (length 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
|
||
|
|
(lambda (p/o)
|
||
|
|
(lambda (astate)
|
||
|
|
(let loop ((i 0) (j 0))
|
||
|
|
(cond
|
||
|
|
((and (= i 3) (= j 0)) null)
|
||
|
|
((< j 3) (if (blank? astate i j)
|
||
|
|
(cons (update-state (clone-state astate) i j p/o)
|
||
|
|
(loop i (+ j 1)))
|
||
|
|
(loop i (+ j 1))))
|
||
|
|
((< i 3) (loop (+ i 1) 0))
|
||
|
|
(else (error 'make-player "ouch")))))))
|
||
|
|
|
||
|
|
(define player (make-players PLAYER))
|
||
|
|
|
||
|
|
(define opponent (make-players OPPONENT))
|
||
|
|
|
||
|
|
(define print&remove-terminals
|
||
|
|
(local ((define print-state
|
||
|
|
(lambda (x)
|
||
|
|
;(display ".")
|
||
|
|
(void))))
|
||
|
|
|
||
|
|
(collect null (lambda (_ astate rest)
|
||
|
|
(if (terminal? astate)
|
||
|
|
(begin (print-state astate) rest)
|
||
|
|
(cons astate rest))))))
|
||
|
|
|
||
|
|
(define terminal?
|
||
|
|
(lambda (astate)
|
||
|
|
(or (terminal-row 0 astate)
|
||
|
|
(terminal-row 1 astate)
|
||
|
|
(terminal-row 2 astate)
|
||
|
|
(terminal-col 0 astate)
|
||
|
|
(terminal-col 1 astate)
|
||
|
|
(terminal-col 2 astate)
|
||
|
|
(terminal-posdg astate)
|
||
|
|
(terminal-negdg astate))))
|
||
|
|
|
||
|
|
(define terminal-row
|
||
|
|
(lambda (n state)
|
||
|
|
(and (not (blank? state n 0))
|
||
|
|
(= (2vec-ref state n 0) (2vec-ref state n 1) (2vec-ref state n 2)))))
|
||
|
|
|
||
|
|
(define terminal-col
|
||
|
|
(lambda (n state)
|
||
|
|
(and (not (blank? state 0 n))
|
||
|
|
(= (2vec-ref state 0 n) (2vec-ref state 1 n) (2vec-ref state 2 n)))))
|
||
|
|
|
||
|
|
(define terminal-posdg
|
||
|
|
(lambda (state)
|
||
|
|
(and (not (blank? state 0 0))
|
||
|
|
(= (2vec-ref state 0 0) (2vec-ref state 1 1) (2vec-ref state 2 2)))))
|
||
|
|
|
||
|
|
(define terminal-negdg
|
||
|
|
(lambda (state)
|
||
|
|
(and (not (blank? state 0 2))
|
||
|
|
(= (2vec-ref state 0 2) (2vec-ref state 1 1) (2vec-ref state 2 0)))))
|