#| Comp210 CONNECT 5 Author: Dominique Shelton (0850681) Lab: Thurs 7pm Date Due: 12/19/01 |# ; The input to the program is a board. ; A board is a list of list-of-symbols, an nxn array ; Requirement: Array MUST be square (nxn) ; Each symbol may be either: ; '- represents an empty spot ; 'X represents the program's (my) piece ; 'O represents the opponent's (your) piece ;Examples of boards: ;NOTE: a single quote appears for Scheme to recognize them. ;When actually running the program, this quote is not used. (define board1 '((- - - - -) (X X X X -) (- O O O O) (- - - - -) (- - - - -))) (define board2 '((O O X O O X -) (- X - - - - O) (- - O X X - O) (- - X O O O X) (X - - X O - O) (X - - - - O O) (X - - X - - -))) (define board3 '((- - - - - - -) (- - - - - - -) (- - O O O - X) (- - O X X X X) (- - - O - - X) (- - - - - - X) (- - - O - - O))) (define board4 '((X - - - - - - - - - O - - - - - - - - -) (- X - - - - - - - - O - - - - - - - - -) (- - X - - - - - - - O - - - - - - - - -) (- - - - - - - - - - - - - - - - - - - -) (- - - - X - - - - - O - - - - - - - - -) (- - - - - X - - - - O - - - - - - - - -) (- - - - - - X - - - O - - - - - - - - -) (- - - - - - - X - - - - - - - - - - - -) (- - - - - - - - - - O - - - - - - - - -) (- - - - - - - - - X O - - - - - - - - -) (- - - - - - - - - - X - - - - - - - - -) (- - - - - - - - - - O X - - - - - - - -) (- - - - - - - - - - - - - - - - - - - -) (- - - - - - - - - - O - - X - - - - - -) (- - - - - - - - - - O - - - X - - - - -) (- - - - - - - - - - O - - - - X - - - -) (- - - - - - - - - - O - - - - - X - - -) (- - - - - - - - - - - - - - - - - O - -) (- - - - - - - - - - O - - - - - - - - -) (- - - - - - - - - - - - - - - - - - - X))) (define board5 '((- - - - - - - -) (- - - - - - - -) (- - - - - - - -) (- - - - - - - -) (- - - - - - - -) (- - - - - - - -) (- - - - - - - -) (- - - - - - - -))) (define board6 '((X X X - - - -) (- - O O O - -) (X - O O O X -) (- - O X X X X) (- - - O - - X) (- - - - - - X) (- - - O - - O))) ;--------------------------------------------------- ;SOME DEFINITIONS (define n (read)) ;n is a quoted list-of-lists ; m (defined below) is the matrix representation of n (define row-length (length (first n))) (define col-length (length n)) (define L 5) ;L is the Length needed to win (define EMPTY '-) (define AGGRESIVENESS 150) ;num between 0 and 4000, 4000 is the most aggressive, ;(was at 170 for first tournament, perhaps I'll be a little more defensive now) ;Possible patterns for cells surrounding empty cells ;what the chunk will look like if move is made: (define WINNER 4000) ;XXXXX (define FOURFREE 690) ;-XXXX- (define THREEFREE 170) ;-XXX- (define FOUR1OPP 150) ;OXXXX- (define THREESPACE 150) ;-XX-X- (define FOUR1OPPSPACE 135) ;OX-XXX- (define TWOFREE 17) ;-XX- (define TWOSPACE 15) ;-X-X- (define THREE1OPP 13) ;OXXX- (define TWO1OPP 1) ;OXX- (define NONE .1) ;cell is of no significance (define MISC 3) ;just in case I missed something ;A matrix is: ; A vector-of-vectors ; (make-vector (make-vector )) ;where the row and column numbers are equal ;build-row: list number --> vector ;makes a vector from a list (define (build-row list row-length) (local [(define arow (make-vector row-length empty)) (define (build-row-h arow list row-length row-acc) (cond [(< row-acc row-length) (begin (vector-set! arow row-acc (first list)) (build-row-h arow (rest list) row-length (add1 row-acc)))] [else arow]))] (build-row-h arow list row-length 0))) ;(build-row (first n) row-length) ;(build-row (second n) row-length) ;(build-row (third n) row-length) ;build-matrix: list-of-lists number number --> matrix ;makes a matrix from a list-of-lists (define (build-matrix lol row-length col-length) (local [(define amatrix (make-vector col-length empty)) (define (build-matrix-h lol row-length col-length col-acc) (cond [(< col-acc col-length) (begin (vector-set! amatrix col-acc (build-row (first lol) row-length)) (build-matrix-h (rest lol) row-length col-length (add1 col-acc)))] [else amatrix]))] (build-matrix-h lol row-length col-length 0))) ;(build-matrix board1 5 5) = (vector ; (vector '- '- '- '- '-) ; (vector 'X 'X 'X 'X '-) ; (vector '- 'O 'O 'O 'O) ; (vector '- '- '- '- '-) ; (vector '- '- '- '- '-)) ;matrix-rows: matrix --> number ;returns the number of rows in a given matrix (define (matrix-rows m) (vector-length m)) ;(matrix-rows m1) = 5 ;matrix-cols: matrix --> number ;returns the number of columns in a given matrix (define (matrix-cols m) (vector-length (vector-ref m 0))) ;(matrix-cols m1) = 5 (define m (build-matrix n row-length col-length)) ;Behold, the matrix! (define MRL (matrix-rows m)) ;m-row-length (define MCL (matrix-cols m)) ;m-column-length ;(define m1 (build-matrix board1 5 5)) ;For testing purposes ; Generic matrix functions ----------------------------------------------------- ;make-matrix: size value --> matrix ;makes a matrix of length size x size filled with value (define (make-matrix size value) (local [(define vector (make-vector size empty)) (define (make-v i size value) (cond [(< i size) (begin (vector-set! vector i (make-vector size value)) (make-v (add1 i) size value))] [else vector]))] (make-v 0 size value))) ;initialize all the matrices (define diag-num (* (+ (* (- MRL L) 2) 1) 2)) ;# of diag. of at least length L (must be square) ;all rows, columns, and diagonals are represented as rows (define r-vec-me (build-matrix n row-length col-length)) (define r-vec-op (build-matrix n row-length col-length)) (define c-vec-me (make-vector MCL empty)) (define c-vec-op (make-vector MCL empty)) (define d-vec-me (make-vector diag-num empty)) (define d-vec-op (make-vector diag-num empty)) ;all of the above representations are converted back to "normal" ;(normal - as they originally were: rows, columns, or diagonals) (define m-r-me (make-matrix MCL 0)) (define m-r-op (make-matrix MCL 0)) (define m-c-me (make-matrix MCL 0)) (define m-c-op (make-matrix MCL 0)) (define m-d-me (make-matrix MCL 0)) (define m-d-op (make-matrix MCL 0)) ;final offensive matrix containing scores (define m-score-me (make-matrix MCL 0)) ;final defensive matrix containing scores (define m-score-op (make-matrix MCL 0)) ;matrix-ref: matrix number number --> any ;returns the contents of a location within a matrix (define (matrix-ref m row-num col-num) (vector-ref (vector-ref m row-num) col-num)) ;(matrix-ref m1 0 0) = '- ;(matrix-ref m1 2 3) = 'O ;(matrix-ref m1 4 4) = '- ;matrix-set!: matrix number number any --> (void) ;sets the context of a given cell in a matrix (define (matrix-set! m row-num col-num value) (vector-set! (vector-ref m row-num) col-num value)) ;(define dog (vector (vector 1 1 1 1 1 1) ; (vector 1 1 1 1 1 1) ; (vector 1 1 1 1 1 1) ; (vector 1 1 1 1 1 1) ; (vector 1 1 1 1 1 1) ; (vector 1 1 1 1 1 1))) ;(matrix-set! dog 2 2 999) ; ;(matrix-set! m1 2 3 x) = (vector ; (vector '- '- '- '- '-) ; (vector 'X 'X 'X 'X '-) ; (vector '- 'O 'O 'O 'O) ; (vector '- '- 'X '- '-) ; (vector '- '- '- '- '-)) ;fill!: value number number matrix --> (void) ;takes in a legal board value (number or symbol) and updates a matrix ;WARNING: it intentionally will ignore values of zero (define (fill! value row-num col-num matrix) (local [(define contents (matrix-ref matrix row-num col-num))] (cond [(and (number? value) (zero? value)) (void)] [(number? value) (matrix-set! matrix row-num col-num (+ value contents))] [else (matrix-set! matrix row-num col-num value)]))) ;Work with columns ------------------------------------------------ ;col-ref: matrix number --> vector ;returns a vector representing a column of the matrix (define (col-ref m col-num) (local [(define row-acc 0) (define row-vec (make-vector MCL empty)) (define (col-ref-h m row-acc row-num col-num) (cond [(< row-acc row-num) (begin (vector-set! row-vec row-acc (matrix-ref m row-acc col-num)) (col-ref-h m (add1 row-acc) row-num col-num))] [else row-vec]))] (col-ref-h m 0 MCL col-num))) ;(col-ref m 0) = (vector '- 'X '- '- '-) ;so, this is column 0 of m1 ;build-c-vec!: matrix vector number --> (void) ;SIDE-EFFECT: updates matrix ;makes a matrix representation of columns as rows (define (build-c-vec! m vector col-num) (local [(define index 0) (define (build-c-vec-h m vector col-num) (cond [(< index col-num) (begin (vector-set! vector index (col-ref m index)) (set! index (add1 index)) (build-c-vec-h m vector col-num))] [else (void)]))] (build-c-vec-h m vector col-num))) (build-c-vec! m c-vec-me col-length) (build-c-vec! m c-vec-op col-length) ;Work with diagonals ----------------------------------------------------- ;fill-diag!: vector matrix number number symbol --> vector ;SIDE-EFFECT: updates matrix ;fills a vector representation of a diagonal with the appropriate symbols (define (fill-diag! vector m row-num col-num slope) (local [(define length (vector-length vector)) (define index 0)] (cond [(symbol=? slope 'neg) (local [(define max-r (+ row-num (- length 1))) (define (fill-neg vector m row-num col-num) (cond [(<= row-num max-r) (begin (vector-set! vector index (matrix-ref m row-num col-num)) (set! index (add1 index)) (fill-neg vector m (add1 row-num) (add1 col-num)))] [else vector]))] (fill-neg vector m row-num col-num))] [(symbol=? slope 'pos) (local [(define min-r (- row-num (- length 1))) (define (fill-pos vector m row-num col-num) (cond [(>= row-num min-r) (begin (vector-set! vector index (matrix-ref m row-num col-num)) (set! index (add1 index)) (fill-pos vector m (sub1 row-num) (add1 col-num)))] [else vector]))] (fill-pos vector m row-num col-num))]))) ;neg-diag!: vector number number number number --> (void) ;SIDE-EFFECT: updated matrix ;makes the diagonal vector representations for the negatively-sloped diagonals (define (neg-diag! m vector acc1 first-index r c) (local [(define index first-index) (define (diag-set! i r c diag-length) (begin (vector-set! vector i (fill-diag! (make-vector diag-length 'neg) m r c 'neg)) (set! index (add1 index)))) (define (col-up x r c) (cond [(<= x acc1) (begin (diag-set! index r (add1 c) (- col-length (add1 c))) (col-up (add1 x) r (add1 c)))] [else (void)])) (define (row-up x r c) (cond [(<= x acc1) (begin (diag-set! index (add1 r) c (- row-length (add1 r))) (row-up (add1 x) (add1 r) c))] [else (void)]))] (begin (diag-set! index r c col-length) (col-up 1 r c) (row-up 1 r c)))) ;pos-diag!: matrix vector number number number number --> (void) ;SIDE-EFFECT: updates matrix ;makes the diagonal vector representations for the positively-sloped diagonals (define (pos-diag! m vector acc1 first-index r c) (local [(define index first-index) (define (diag-set! i r c diag-length) (begin (vector-set! vector i (fill-diag! (make-vector diag-length 'pos) m r c 'pos)) (set! index (add1 index)))) (define (col-up x r c) (cond [(<= x acc1) (begin (diag-set! index r (add1 c) (- col-length (add1 c))) (col-up (add1 x) r (add1 c)))] [else (void)])) (define (row-down x r c) (cond [(<= x acc1) (begin (diag-set! index (sub1 r) c r) (row-down (add1 x) (sub1 r) c))] [else (void)]))] (begin (diag-set! index (- row-length 1) 0 col-length) (col-up 1 r c) (row-down 1 r c)))) ;diag-vec!: matrix vector number --> (void) ;SIDE-EFFECT: updates matrix ;makes a diagonal vector from a normal vector (define (diag-vec! m vector length) (local [(define acc1 (- MRL L))] (begin (neg-diag! m vector acc1 0 0 0) (pos-diag! m vector acc1 (/ diag-num 2) (- row-length 1) 0)))) ;THE MOST IMPORTANT RESULTS OF THIS DIAGONAL SECTION (diag-vec! m d-vec-me col-length) (diag-vec! m d-vec-op col-length) ; Reverse the Diagonal -------------------------------------------------- ;fill-neg!: matrix vector number number number --> (void) ;SIDE-EFFECT: updates matrix ;fills the negatively sloped diagonals (define (fill-neg! matrix vector row-num col-num diag-length) (local [(define i 0) (define index 0) (define (fill-neg vector row-num col-num) (cond [(and (<= row-num (- MRL 1)) (<= col-num (- MRL 1)) (>= row-num 0) (>= col-num 0)) (begin (fill! (vector-ref vector index) row-num col-num matrix) (set! index (add1 index)) (set! i 0) (fill-neg vector (add1 row-num) (add1 col-num)))] [else (set! i 0)]))] (fill-neg vector row-num col-num))) ;fill-pos!: matrix vector number number number --> (void) ;SIDE-EFFECT: updates matrix ;fills the positively sloped diagonals (define (fill-pos! matrix vector row-num col-num diag-length) (local [(define i 0) (define index 0) (define (fill-pos vector row-num col-num) (cond [(and (<= row-num (- MRL 1)) (<= col-num (- MRL 1)) (>= row-num 0) (>= col-num 0)) (begin (fill! (vector-ref vector index) row-num col-num matrix) (set! index (add1 index)) (set! i 0) (fill-pos vector (sub1 row-num) (add1 col-num)))] [else (set! i 0)]))] (fill-pos vector row-num col-num))) ;rpos-diag!: matrix vector number number number number --> (void) ;SIDE-EFFECT: fill-diag! can fill m-d with the appropriate symbols/numbers ;makes the diagonal vector representations for the positively-sloped diagonals (define (rpos-diag! matrix vector i-value first-index r c) (local [(define index first-index) (define (diag-set! r c diag-length) (begin (fill-pos! matrix (vector-ref vector index) r c diag-length) (set! index (add1 index)))) (define (col-up x r c) (cond [(<= x i-value) (begin (diag-set! r (add1 c) (- col-length (add1 c))) (col-up (add1 x) r (add1 c)))] [else (void)])) (define (row-down x r c) (cond [(<= x i-value) (begin (diag-set! (sub1 r) c r) (row-down (add1 x) (sub1 r) c))] [else (void)]))] (begin (diag-set! (- row-length 1) 0 col-length) (col-up 1 r c) (row-down 1 r c)))) ;rneg-diag!: matrix vector number number number number --> (void) ;SIDE-EFFECT: updates matrix ;makes the diagonal vector representations for the negatively-sloped diagonals (define (rneg-diag! matrix vector i-value first-index r c) (local [(define index first-index) (define (diag-set! i r c diag-length) (begin (fill-neg! matrix (vector-ref vector index) r c diag-length) (set! index (add1 index)))) (define (col-up x r c) (cond [(<= x i-value) (begin (diag-set! index r (add1 c) (- col-length (add1 c))) (col-up (add1 x) r (add1 c)))] [else (void)])) (define (row-up x r c) (cond [(<= x i-value) (begin (diag-set! index (add1 r) c (- row-length (add1 r))) (row-up (add1 x) (add1 r) c))] [else (void)]))] (begin (diag-set! index r c col-length) (col-up 1 r c) (row-up 1 r c)))) ;reverse-diag: diagonal-vector matrix --> (void) ;SIDE-EFFECT: changes m-d from a matrix of 0's to one with 0, 'O, 'X, and scores (1) ;the main function for reversing diagonals (define (reverse-diag d-vec m-d) (local [(define diag-num (vector-length d-vec)) (define i-value (- MRL L))] (begin (rneg-diag! m-d d-vec i-value 0 0 0) (rpos-diag! m-d d-vec i-value (/ diag-num 2) (sub1 row-length) 0)))) ;This work is done later: ;(reverse-diag d-vec-me m-d-me) ;(reverse-diag d-vec-op m-d-op) ;Evaluate ------------------------------------------------------------ ;The most important part of this program! ;See Readme for a more thorough explanation of what I am doing. ; A chunk is: ;(make-chunk m4 m3 m2 m1 cell p1 p2 p3 p4) ;Where cell is an empty cell whose score is about to be evaluated ;and m1-m4 are 4 cells before the cell of interest and p1-p4 are ;four cells after the cell of interest. If the edge of the board ;is reached and no such cell exists, the contents is occupied with ;'D, which will default to the else statements. (define-struct chunk (m4 m3 m2 m1 cell p1 p2 p3 p4)) ;Examples of chunks (more thorough in the test cases document) ;(define c01 (make-chunk 'O 'X 'X 'O '- 'X 'X 'X 'X)) ;= 4000 ;(define c02 (make-chunk 'O 'O 'O 'X '- 'X 'X 'X 'O)) ;= 4000 ;(define c02 (make-chunk 'X 'X 'X 'X '- 'O 'O 'O 'O)) ;= 4000 ;(define c04 (make-chunk '- '- 'X 'X '- 'X 'X 'D 'D)) ;= 4000 ;(define c05 (make-chunk 'D 'D 'D 'O '- 'X 'X 'X 'X)) ;= 4000 ;(define c06 (make-chunk 'D 'D '- 'X '- 'X 'X '- 'O)) ;= 650 ;(define c07 (make-chunk 'O 'O 'O '- '- 'X 'X 'X '-)) ;= 650 ;(define c08 (make-chunk 'O 'X 'O '- '- 'X 'X 'X 'O)) ;= 150 ;chunker: vector number --> number ;makes a chunk given a vector and an empty cell within the vector (define (chunker vec acc) (local [(define length (vector-length vec)) (define (chunk n) (local [(define i (+ n acc))] (if (and (< i length) (>= i 0)) (vector-ref vec i) 'D)))] ;'D is default, if nothing exists (make-chunk (chunk -4) (chunk -3) (chunk -2) (chunk -1) (chunk 0) (chunk 1) (chunk 2) (chunk 3) (chunk 4)))) ;(chunker (vector 'X '- 'O 'O '- '- '-) 4) = (make-chunk 'X '- 'O 'O '- '- '- 'D 'D) ;(chunker (vector '- '- 'O 'O 'O '- '-) 1) ;(chunker (vector '- '- 'O 'O 'O '- '-) 5) ;BEGIN EVALUATION SECTION ----------------------------------------------- ;Now we go through the process of evaluating a single chunk ;(i.e. one-dimensional empty cell) ;rchunk: chunk --> chunk ;reverses the chunk to be evaluated the other way ;this cuts the needed code for evaluating a chunk in half (define (rchunk achunk) (make-chunk (chunk-p4 achunk) (chunk-p3 achunk) (chunk-p2 achunk) (chunk-p1 achunk) (chunk-cell achunk) (chunk-m1 achunk) (chunk-m2 achunk) (chunk-m3 achunk) (chunk-m4 achunk))) ;EVALUATION ;not-blocked?: chunk symbol --> boolean ;returns true if 5 in a row is possible ;if 5 in a row isn't even possible, ;we aren't going to bother with the rest of the code (define (not-blocked? achunk type) (local [(define m4 (chunk-m4 achunk)) (define m3 (chunk-m3 achunk)) (define m2 (chunk-m2 achunk)) (define m1 (chunk-m1 achunk)) (define p4 (chunk-p4 achunk)) (define p3 (chunk-p3 achunk)) (define p2 (chunk-p2 achunk)) (define p1 (chunk-p1 achunk)) (define (lot? cell) (or (equal? cell type) (equal? cell EMPTY)))] (cond [(and (lot? m4) (lot? m3) (lot? m2) (lot? m1)) true] [(and (lot? m3) (lot? m2) (lot? m1) (lot? p1)) true] [(and (lot? m2) (lot? m1) (lot? p1) (lot? p2)) true] [(and (lot? m1) (lot? p1) (lot? p2) (lot? p3)) true] [(and (lot? p1) (lot? p2) (lot? p3) (lot? p4)) true] [else false]))) ;(not-blocked? c15 'X) = false ;(not-blocked? c15 'O) = true ;chunk-p2-type: chunk symbol --> number ;At this point, p2 is the type being evaluated (define (chunk-p2-type achunk type) (local [(define m4 (chunk-m4 achunk)) (define m3 (chunk-m3 achunk)) (define m2 (chunk-m2 achunk)) (define m1 (chunk-m1 achunk)) (define p4 (chunk-p4 achunk)) (define p3 (chunk-p3 achunk)) (define p2 (chunk-p2 achunk)) (define p1 (chunk-p1 achunk))] (cond [(equal? p3 type) (cond [(equal? p4 type) WINNER] ;*XXXX [(equal? p4 EMPTY) (cond [(equal? m1 type) WINNER] ;X*XXX- [(equal? m1 EMPTY) FOURFREE] ;-*XXX- [else FOUR1OPP])] ;O*XXX- [(equal? m1 type) WINNER] ;X*XXXO [(equal? m1 EMPTY) FOUR1OPP] ;-*XXXO [else NONE])] ;O*XXXO [(equal? p3 EMPTY) (cond [(equal? m1 EMPTY) THREEFREE] ;-*XX- [(equal? m1 type) (cond [(equal? m2 EMPTY) FOURFREE] ;-X*XX- [(equal? m2 type) WINNER] ;XX*XX [else FOUR1OPP])] ;OX*XX- [(equal? p4 EMPTY) THREE1OPP] ;O*XX-- [(equal? p4 type) FOUR1OPPSPACE] ;O*XX-X [else NONE])] ;O*XX-O [(equal? m1 type) (cond [(equal? m2 type) WINNER] ;OXX*XXO [else 0])] ;O-X*XXO [(equal? m1 EMPTY) (cond [(equal? m2 EMPTY) THREE1OPP] ;--*XXO [(equal? m2 type) FOUR1OPPSPACE] ;X-*XXO [else NONE])] ;O-*XXO [else NONE]))) ;O*XXO ;chunk-p2-empty: chunk symbol --> number ;at this point, p2 is empty (define (chunk-p2-empty achunk type) (local [(define m4 (chunk-m4 achunk)) (define m3 (chunk-m3 achunk)) (define m2 (chunk-m2 achunk)) (define m1 (chunk-m1 achunk)) (define p4 (chunk-p4 achunk)) (define p3 (chunk-p3 achunk)) (define p2 (chunk-p2 achunk)) (define p1 (chunk-p1 achunk))] (cond [(equal? m1 EMPTY) (cond [(equal? m2 type) (cond [(equal? m3 EMPTY) THREESPACE] ;-X-*X- [(equal? m3 type) FOUR1OPPSPACE] ;XX-*X- [else THREE1OPP])] ;OX-*X- [(equal? m2 EMPTY) (cond [(equal? p3 EMPTY) TWOFREE] ;--*X-- [(equal? p3 type) (cond [(equal? p4 EMPTY) THREESPACE] ;--*X-X- [(equal? p4 type) FOUR1OPPSPACE] ;--*X-XX [else THREE1OPP])] ;--*X-XO [else THREE1OPP])] [else TWOFREE])] ;--*X-O [(equal? m1 type) (cond [(equal? m2 EMPTY) THREEFREE] ;-X*X- [(equal? m2 type) ;XX*X- (cond [(equal? m3 empty) FOURFREE] ;-XX*X- [(equal? m3 type) WINNER] ;XXX*X- [else FOUR1OPP])] ;OXX*X- [else MISC])] [(equal? p3 EMPTY) TWOFREE] ;O-*- [(equal? p3 type) (cond [(equal? p4 EMPTY) THREESPACE] ;O-*X-X- [(equal? p4 type) FOUR1OPPSPACE] ;O-*X-XX [else THREE1OPP])] ;O-*X-XO [else NONE]))) ;O-*X-O ;chunk-m1-type: chunk symbol --> number ;at this point, m1 is the type being evaluated (define (chunk-m1-type achunk type) (local [(define m2 (chunk-m2 achunk)) (define p3 (chunk-p3 achunk))] (cond [(equal? m2 EMPTY) THREEFREE] ;-X*X- [(equal? p3 EMPTY) THREE1OPP] ;OX-X-- [(equal? p3 type) FOUR1OPPSPACE] ;OX*X-X [else NONE]))) ;OX-X*O ;chunk-p3-empty: chunk symbol --> number ;at this point, p3 is empty (define (chunk-p3-empty achunk type) (local [(define p4 (chunk-p4 achunk))] (cond [(equal? p4 EMPTY) TWO1OPP] ;O*X--- [(equal? p4 type) TWO1OPP] ;O*X--X [else NONE]))) ;O*X--O ;chunk-p3-type: chunk symbol --> number ;at this point, p3 is the type being evaluated (define (chunk-p3-type achunk type) (local [(define p4 (chunk-p4 achunk))] (cond [(equal? p4 EMPTY) THREE1OPP] ;O*X-X- [(equal? p4 type) FOUR1OPPSPACE] ;O*X-XO [else NONE]))) ;O*X-XO ;chunk-m1-empty: chunk symbol --> number ;at this points, m1 is empty (define (chunk-m1-empty achunk type) (local [(define m4 (chunk-m4 achunk)) (define m3 (chunk-m3 achunk)) (define m2 (chunk-m2 achunk)) (define m1 (chunk-m1 achunk)) (define p4 (chunk-p4 achunk)) (define p3 (chunk-p3 achunk)) (define p2 (chunk-p2 achunk)) (define p1 (chunk-p1 achunk))] (cond [(equal? m2 type) (cond [(equal? m3 EMPTY) THREE1OPP] ;-X-*XO [(equal? m3 type) FOUR1OPPSPACE] ;XX-*XO [else NONE])] ;OX-*XO [(equal? m2 EMPTY) (cond [(equal? m3 EMPTY) TWO1OPP] ;---*XO [(equal? m3 type) TWO1OPP] ;X--*XO [else NONE])] ;O--*XO [else NONE]))) ;O*-XO ;chunk-p1-type: chunk symbol --> number ;at this point, p1 is the type being evaluated (define (chunk-p1-type achunk type) (local [(define m1 (chunk-m1 achunk)) (define p2 (chunk-p2 achunk)) (define p3 (chunk-p3 achunk))] (cond [(equal? p2 type) (chunk-p2-type achunk type)] [(equal? p2 EMPTY) (chunk-p2-empty achunk type)] [(equal? m1 type) (chunk-m1-type achunk type)] [(equal? p3 EMPTY) (chunk-p3-empty achunk type)] [(equal? p3 type) (chunk-p3-type achunk type)] [(equal? m1 EMPTY) (chunk-m1-empty achunk type)] [else NONE]))) ;chunk-p1-not-type: chunk symbol --> number ;at this point, p1 is either empty or the opposite type (define (chunk-p1-not-type achunk type) (local [(define m4 (chunk-m4 achunk)) (define m3 (chunk-m3 achunk)) (define m2 (chunk-m2 achunk)) (define m1 (chunk-m1 achunk)) (define p4 (chunk-p4 achunk)) (define p3 (chunk-p3 achunk)) (define p2 (chunk-p2 achunk)) (define p1 (chunk-p1 achunk))] (cond [(and (equal? p1 EMPTY) (equal? p2 type)) (cond [(and (equal? m1 EMPTY) (equal? p3 EMPTY)) TWOSPACE] ;-*-X- [(and (equal? m1 EMPTY) (equal? p3 type)) (cond [(equal? p4 EMPTY) THREESPACE] ;-*-XX- [(equal? p4 type) FOUR1OPPSPACE] ;-*-XXX [else THREE1OPP])] ;-*-XXO [(and (equal? p3 type) (equal? p4 type)) FOUR1OPPSPACE] ;*-XXX [else THREE1OPP])] ;O*-XX [(and (equal? p1 EMPTY) (equal? p2 EMPTY) (equal? p3 type)) (cond [(and (equal? m1 EMPTY) (equal? p4 EMPTY)) TWOSPACE] [(and (equal? m1 EMPTY) (equal? p4 type)) TWOSPACE] [(equal? m1 EMPTY) TWO1OPP] [else TWO1OPP])] [else NONE]))) ;evaluate-a-chunk: chunk symbol --> number ;Determines the number to be assigned to an empty cell (define (evaluate-a-chunk achunk type) (local [(define p1 (chunk-p1 achunk))] (if (equal? p1 type) (chunk-p1-type achunk type) (chunk-p1-not-type achunk type)))) ;evaluate-chunk: chunk symbol --> number ;determines the value of the chunk (define (evaluate-chunk achunk type) (local [(define norm (evaluate-a-chunk achunk type)) (define rev (evaluate-a-chunk (rchunk achunk) type))] (if (not-blocked? achunk type) (if (> norm rev) norm rev) NONE))) ;NOTE: Due to the plethora of test cases, they are listed in the Readme file. ;END EVALUATION SECTION ------------------------------------------- ;duplicate: vector --> vector ;duplicates a vector so you have an unaltered vector copy even when you abuse set! (define (duplicate vector) (local [(define length (vector-length vector)) (define temp-vec (make-vector length empty)) (define (mock acc) (cond [(< acc length) (begin (vector-set! temp-vec acc (vector-ref vector acc)) (mock (add1 acc)))] [else temp-vec]))] (mock 0))) ;(duplicate (vector 'X 'O '-)) = (vector 'X 'O '-) ;evaluate-row!: vector symbol --> (void) ;analyzes a single row (define (evaluate-row! vec type) (local [(define mock-row (duplicate vec)) (define row-length (vector-length vec)) (define (evaluate-row-h mock vec acc) (cond [(< acc row-length) (local [(define cell (vector-ref mock acc))] (begin (cond [(symbol=? '- cell) (local [(define the-chunk (chunker mock acc)) (define score (evaluate-chunk the-chunk type))] (vector-set! vec acc score))] [else (void)]) (evaluate-row-h mock vec (add1 acc))))] [else (void)]))] (evaluate-row-h mock-row vec 0))) ;evaluate: vector-of-vector symbol--> (void) ;sends each row of a vector to be evaluated (define (evaluate vec type) (local [(define vec-length (vector-length vec)) (define (evaluate-h vec acc) (cond [(< acc vec-length) (begin (evaluate-row! (vector-ref vec acc) type) (evaluate-h vec (add1 acc)))] [else (void)]))] (evaluate-h vec 0))) ;evaluate the row, column, and diagonal vectors as rows (evaluate r-vec-me 'X) (evaluate r-vec-op 'O) (evaluate c-vec-me 'X) (evaluate c-vec-op 'O) (evaluate d-vec-me 'X) (evaluate d-vec-op 'O) ;convert the row representations of rows, columns, and diagonals back to a normal matrix (set! m-r-me r-vec-me) ;builds m-r (set! m-r-op r-vec-op) (build-c-vec! c-vec-me m-c-me col-length) ;builds m-c (build-c-vec! c-vec-op m-c-op col-length) (reverse-diag d-vec-me m-d-me) ;builds m-d (reverse-diag d-vec-op m-d-op) ;overlay the three matrices into one -------------------------------------- ;combine-matrices: matrix matrix matrix matrix --> matrix ;combines the values of three matrices (define (combine-matrices m1 m2 m3 final) (local [(define row 0) (define max-row (sub1 MRL)) (define col 0) (define max-col (sub1 MCL)) (define (combine m) (if (<= col max-col) (begin (fill! (matrix-ref m row col) row col final) (set! col (add1 col)) (combine m)) (if (< row max-row) (begin (set! col 0) (set! row (add1 row)) (combine m)) (begin (set! row 0) (set! col 0)))))] (begin (combine m1) (combine m2) (combine m3)))) (combine-matrices m-r-me m-c-me m-d-me m-score-me) (combine-matrices m-r-op m-c-op m-d-op m-score-op) ;choose the max from the overlayed matrix ;if the maximum number appears more than once, it will take the first one ;max: matrix --> list ;WARNING: assumes matrix is at least 5 x 5 (by definition) ;returns the maximum number in the matrix, ignoring symbols (define (max matrix) (local [(define max-so-far 0) (define max-place (list empty empty)) (define row 0) (define max-row (sub1 (matrix-rows matrix))) (define col 0) (define max-col (sub1 (matrix-cols matrix))) (define (determine-max) (if (<= col max-col) (begin (cond [(number? (matrix-ref matrix row col)) (if (>= (matrix-ref matrix row col) max-so-far) (begin (set! max-so-far (matrix-ref matrix row col)) (set! max-place (list col row))) (void))] [else (void)]) (set! col (add1 col)) (determine-max)) (if (< row max-row) (begin (set! col 0) (set! row (add1 row)) (determine-max)) (begin (set! row 0) (set! col 0) (list max-so-far max-place)))))] (determine-max))) ;(define tweety (vector (vector 7 'X 6 4) (vector 3 21 'X 'O))) ;(max tweety) = (list 1 1) ;determine-score: (void) --> list ;determines the winning answer (define (determine-score) (local [(define me (max m-score-me)) (define op (max m-score-op)) (define max-me (first me)) (define move-me (second me)) (define max-op (first op)) (define move-op (second op))] (cond [(>= max-me 4000) (printf "~s~n" move-me)] [(>= max-op 170) (printf "~s~n" move-op)] [else (printf "~s~n" move-me)]))) ;AND FINALLY, THE ANSWER (determine-score)