I am building an AI for a game of tick-tack-toe, using the stub given in the Realm of Racket book as a basis. So far, everything has gone well. However, when I try to run my minimax function on the root of the tree, it returns a list of the lowest possible values you can get by running it (With either player as the predicate).
Here is a code dump of the function:
(define (minimax tree player depth)
(define (generate-score tree player depth)
(define won (winner (ttt-tree-board tree)))
(if (<= depth 0) 0
(+ (cond
[(equal? won player) 1]
[(false? won) 0]
[else -1])
(apply +
(for/list ([t (ttt-tree-moves tree)])
(generate-score (second t) player (sub1 depth)))))))
(for/list ([t (ttt-tree-moves tree)])
(generate-score (second t) player depth)))
This is only my minimax function, because none of the others (except for winner) need to be displayed. Here is winner:
(define (winner board)
(or
(ormap (lambda (row) (if (all-equal? row) (first row) #f)) board) ; Horizontal
(ormap (lambda (i) (if ; Vertical
(all-equal? (map (lambda (j) (list-ref (list-ref board j) i)) (stream->list (in-range (length board)))))
(list-ref (first board) i) #f))
(stream->list (in-range (length board))))
(if ; Diagonal
(all-equal? (map (lambda (i) (list-ref (list-ref board i) i)) (stream->list (in-range (length board)))))
(first (first board)) #f)
(if ; Diagonal cont.
(all-equal? (map (lambda (i) (list-ref (reverse (list-ref board i)) i)) (stream->list (in-range (length board)))))
(last (first board)) #f)))
(It is a bit sloppy, so if anyone has an idea to make it shorter, tell me your suggestion)
ttt-tree structures follow this pattern:
(ttt-tree board moves)
In which board is a 2D array corresponding to the tick-tack-toe board (with the form '((X - O) (O X -) (- X O))), and moves is a list of possible moves that can be made from that node, each of which is a list with two elements: the position that changed, and a ttt-tree which forms the next node. So (second t) refers to the next node, if t is (list-ref (ttt-tree-moves #<ttt-tree>) x)
My original thought was that there may be some error in the cond, but I'm using equal? not eq?, so I don't see how that would be a problem. The other possibility is that I'm defining winner wrong, but I have tested it many times so I don't know what could go wrong. Please help!
It turns out that the problem was that in my winner function, I never checked if the winner was "-", the empty tile. Therefore that would trigger in most cases, activating the else clause and resulting in a score of -1.
Related
Im trying to learn scheme and Im having trouble with the arithmetic in the Scheme syntax.
Would anyone be able to write out a function in Scheme that represents the Geometric Series?
You have expt, which is Scheme power procedure. (expt 2 8) ; ==> 256 and you have * that does multiplication. eg. (* 2 3) ; ==> 6. From that you should be able to make a procedure that takes a n and produce the nth number in a specific geometric series.
You can also produce a list with the n first if you instead of using expt just muliply in a named let, basically doing the expt one step at a time and accumulate the values in a list. Here is an example of a procedure that makes a list of numbers:
(define (range from to)
(let loop ((n to) (acc '())
(if (< n from)
acc
(loop (- 1 n) (cons n acc)))))
(range 3 10) ; ==> (3 4 5 6 7 8 9 10)
Notice I'm doing them in reverse. If I cannot do it in reverse I would in the base case do (reverse acc) to get the right order as lists are always made from end to beginning. Good luck with your series.
range behaves exactly like Python's range.
(define (range from (below '()) (step 1) (acc '()))
(cond ((null? below) (range 0 from step))
((> (+ from step) below) (reverse acc))
(else (range (+ from step) below step (cons from acc)))))
Python's range can take only one argument (the upper limit).
If you take from and below as required arguments, the definition is shorter:
(define (range from below (step 1) (acc '()))
(cond ((> (+ from step) below) (reverse acc))
(else (range (+ from step) below step (cons from acc)))))
Here is an answer, in Racket, that you probably cannot submit as homework.
(define/contract (geometric-series x n)
;; Return a list of x^k for k from 0 to n (inclusive).
;; This will be questionable if x is not exact.
(-> number? natural-number/c (listof number?))
(let gsl ((m n)
(c (expt x n))
(a '()))
(if (zero? m)
(cons 1 a)
(gsl (- m 1)
(/ c x)
(cons c a)))))
I'm starting to write a function to see if a queen is 'safe' from the other positions on the board, the board is in the form of (row col) and 1-indexed. Here is what I have thus far:
(define (get-row p) (car p))
(define (get-col p) (cadr p))
(define (is-equal p1 p2)
(and (= (car p1) (car p2)) (= (cadr p1) (cadr p2))))
(define (safe? k positions)
(filter
(lambda (p) (not (and (is-equal p
(list (get-row p) k))
(is-equal p
(list (+ (get-row p) (- k (get-col p)))
k
))
(is-equal p
(list (- (get-row p) (- k (get-col p)))
k
)))))
positions))
I am trying to call it something like:
(safe? 4 '((3 1) (1 2) (4 3) (2 4)))
To see if the fourth queen (in the forth column) on the board with position (2 4) is safe.
However, what I have currently is wide of the mark and returns basically all the 'other' columns instead of the one I want. What would be a better way to do this?
There are many ways to solve this problem. For starters, I'd suggest a simpler representation for the board, I chose to use a list of numbers. The indexes in the list start from one and indicate the queen's column and the value its row (origin of coordinates is on the upper-left corner, new positions are adjoined at the end of the list); all the other positions are assumed to be empty. For instance, the following board:
(. Q)
(Q .)
Would be represented by the list '(2 1). With my representation, the safe? procedure looks like this - and notice that the diagonals? check is a bit trickier to implement:
; a new queen is safe iff there are no other queens in the same
; row nor in any of the diagonals preceding its current position
; we don't need to check the column, this is the only queen on it
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (<= (number-occurrences row board) 1)
(diagonals? row board))))
; counts how many times an element appears on a list
(define (number-occurrences e lst)
(count (curry equal? e) lst))
; traverses the board looking for other queens
; located in one of the diagonals, going backwards
; starting from the location of the newest queen
(define (diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (sub1 row))
(lower (add1 row)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (sub1 upper) (add1 lower))))))
The result is as expected:
(safe? 4 '(2 4 1 3))
=> #t
You can adapt the above code to use a different origin of coordinates if you wish so, or to use pairs of coordinates to represent the queens.
I have been stuck on this question for days. Apparently I need to write a better algorithm to win the algorithm below. The below code is implemented from the famous Aima file. Is there any expert here who could guide me on how to win the algorithm?
(defun find-closest (list)
(x (car (array-dimensions list)))
(y (cadr (array-dimensions list)))
(let ((elems (aref list x y)))
(dolist (e elems)
(when (eq (type-of e) type)
(return-from find-closest (list x y)))) nil))
I tried implementing a DFS but failed and I do not quite know why. Below is my code.
(defun find-closest (list)
(let ((open (list list))
(closed (list))
(steps 0)
(expanded 0)
(stored 0))
(loop while open do
(let ((x (pop open)))
(when (finished? x)
(return (format nil "Found ~a in ~a steps.
Expanded ~a nodes, stored a maximum of ~a nodes." x steps expanded stored)))
(incf steps)
(pushnew x closed :test #'equal)
(let ((successors (successors x)))
(incf expanded (length successors))
(setq successors
(delete-if (lambda (a)
(or (find a open :test #'equal)
(find a closed :test #'equal)))
successors))
(setq open (append open successors))
(setq stored (max stored (length open))))))))
Looking at the code, the function find-some-in-grid returns the first found thing of type. This will, essentially, give you O(n * m) time for an n * m world (imagine a world, where you have one dirt on each line, alternating between "left-most" and "right-most".
Since you can pull out a list of all dirt locations, you can build a shortest traversal, or at least a shorter-than-dump traversal, by instead of picking whatever dirt you happen to find first you pick the closest (for some distance metric, from the code it looks like you have Manhattan distances (that is, you can only move along the X xor the Y axis, not both at the same time). That should give you a robot that is at least as good as the dumb-traversal robot and frequently better, even if it's not optimal.
With the provision that I do NOT have the book and base implementation purely on what's in your question, something like this might work:
(defun find-closest-in-grid (radar type pos-x pos-y)
(labels ((distance (x y)
(+ (abs (- x pos-x))
(abs (- y pos-y)))))
(destructuring-bind (width height)
(array-dimensions radar)
(let ((best nil)
((best-distance (+ width height))))
(loop for x from 0 below width
do (loop for y from 0 below height
do (loop for element in (aref radar x y)
do (when (eql (type-of element) type)
(when (<= (distance x y) best-distance)
(setf best (list x y))
(setf best-distance (distance x y))))))))
best)))
I am trying to replace the elements in a scheme list with its position.
For example, calling:
(position '((a b) c))
should return:
'((0 1) 2)
So far, my code keeps the list format, but the index is not updating.
(define (position term1)
(define index 0)
(cond [(null? term1) '()]
[(list? term1) (cons (position (car term1)) (position(cdr term1)))]
[else (+ 1 index) index]))
When (position '((a b) c)) is called, it returns
'((0 0) 0)
Can anybody explain why the index isn't updating?
There are a couple things wrong: first notice that every time you recursively call position, index is bound to zero.
Second, look at your else branch. (+ 1 index) evaluates to 1 (it does not change any variables) and index evaluates to 0. This branch can only evaluate to one thing, so what happens is the last one is returned and the rest are discarded. This is where your zeroes come from.
It seems like within your function you are trying to keep a global state (the current index) and modify it each time you label a leaf. The "modifying state" part is not good functional style, but if you are okay with that then take a look at set!.
Here is one solution using CPS:
#lang racket
(define (index xs [i 0] [continue (λ (xs i) xs)])
(match xs
[(cons x xs) (index x i
(λ (js j)
(index xs j
(λ (ks k)
(continue (cons js ks) k)))))]
['() (continue '() i)]
[x (continue i (+ i 1))]))
; Example
;(index '((a b) (c d) x (e (f g) h)))
; '((0 1) (2 3) 4 (5 (6 7) 8))
Here (index xs i continue) replaces the elements in xs with their indices, the count starts from i. Let's say the result of indexing xs is js, then continue is called with the indexing result and the next index to be used: (continue js j).
Daenerys Naharis already pointed out what's wrong, so let me point out some features of Scheme and Racket you may be unaware of that you could use in a solution that maintains functional style.
This is called a named let:
(let loop ((index 0)
(result '()))
(if (= index 10)
(reverse result)
(loop (+ 1 index) (cons index result)))
Within the let form, loop is bound as a function that takes all the local variables as arguments. Calling it recursively calls the let form itself. This way you can make index an argument without making it an argument of position. You can also put the result in an argument, which allows you to make the call to loop a tail call.
The other feature is less widespread among existing Scheme implementations: Optional arguments. In Racket, they're defined like this:
(define (position term1 (index 0)) ...)
Then position can be called with or without the index argument.
An example using mutation that maintains it's own state so that each item of each list has a unique id.
Example Usage:
> (position '((a b) c))
'((0 1) 2)
> (position '((a b) c (d (e))))
'((3 4) 5 (6 (7)))
Example Implementation:
#lang racket
(provide position)
(define base -1)
(define (indexer)
(set! base (add1 base))
base)
(define (position list-of-x)
(cond [(null? list-of-x) null]
[else
(define head (first list-of-x))
(cond [(list? head)
(cons (position head)
(position (rest list-of-x)))]
[else (cons (indexer)
(position (rest list-of-x)))])]))
We made a matrix library for scheme in class (documentation here:
http://www.cs.indiana.edu/cgi-pub/c211/wombat/docs/c211-matrix.htm
So as a little project I decided to do with matrices is a Sudoku solver. (This is not for credit, this was given as sort of a practice with matrices before a test).
I've gotten mostly through the program so far I'm just stuck on a couple final functions.
I want to write a function called check-block that will take a north-west-corner row a north-west-corner column and a value and check and see if that value can go in that block. So basically the top left of one of the Sudoku 3X3 boxes and itll need to check if the number has all ready occurred or not. I have a check-row and check-col function below that checks each specific row and column to see if a number can go there, but it starts at the very first column or square each time, not sure how to go about making it start from a given northwest corner.
It'd start of something like:
(define (check-block nwr nwc val))
I'm assuming I'll have to use some sort of loop to check each part of the block.
After this I want to write something called valid? which takes a row index r, a column index c, and a value val and checks that it is possible to put the value in the given position.
Those two I really am stuck on, then to end it I know how to think of it as an algorithm stand point. Which is I need four more functions solve, try-row, try-cell, and try-value.
The idea is that solve simply calls try-row 0 which starts filling the puzzle from row 0. The procedure try-row assumes that all the previous rows are properly filled and, if the puzzle is not finished, attempts to make progress by calling (try-cell r 0). The procedure try-cell assumes all the previous rows and the columns to the left are properly filled. If the current row is filled, it proceeds to the next row. If the current cell is not blank, it skips it. Otherwise, if the current cell is blank, it calls (try-value r c 1) which attempts to fill the current cell with 1. The procedure try-value takes the coordinates of a cell and a value v to be placed in the given position. If the value exceeds 9 then the procedure, having failed, returns. If it is possible to put the given value, the procedure tries the next value. If it is possible to put the given value, the board is modified, and the computation proceeds by trying to fill the next cell. If the attempt to fill the next fails, the added value is removed, and the next value is tried.
So here is the code I have so far:
;This function defines an empty cell as _
(define empty #\_)
;This makes it so there are 9 rows in the matrix
(define rows 9)
;This makes it so there are 9 columns in the matrix
(define cols 9)
;This makes it soa block size is considered 3X3
(define block-size 3)
;This makes board be the matri
(define board (make-matrix rows cols empty))
;This function physically builds the matrix
(define read-puzzle
(lambda (fname)
(with-input-from-file
fname
(lambda ()
(let row-loop ([r 0])
(unless (= r rows)
(let col-loop ([c 0])
(if (= c cols)
(row-loop (add1 r))
(begin
(matrix-set! board r c (read-cell))
(col-loop (add1 c)))))))))))
;This reads what cell has what value
(define read-cell
(lambda () (let ([c (read)]) (if (eq? c '-) empty c))))
;This function checks a specific cell to see if it is blank or has a value
(define (blank? r c)
(equal? empty (matrix-ref board r c)))
;This clears the board to an empty 9x9 matrix
(define (clear-board)
(set! board (make-matrix rows cols empty)))
;This function checks if the value given can be put in that row by checking
;if that value all ready occurs in that row giving #t if it doesnt occur and
;#f if it does occur
(define (check-row r val)
(define (cr-helper r c val)
(cond
[(>= c cols) #t]
[(equal? val (matrix-ref board r c)) #f]
[else (cr-helper r (add1 c) val)]))
(cr-helper r 0 val))
;This function checks if the value given can be put in that column by checking
;if that value all ready occurs in that column giving #t if it doesnt occur and
;#f if it does occur
(define (check-col c val)
(define (cc-helper r c val)
(cond
[(>= r rows) #t]
[(equal? val (matrix-ref board r c)) #f]
[else (cc-helper (add1 r) c val)]))
(cc-helper 0 c val))
Your check-block function will need two nested loops, one loop that advances by rows and one loop that advances by columns, starting from the northwest corner. Each of the two loops checks the cell at an offset of 0, 1 or 2 from the northwest corner, and returns #f if it is the same as the target number.
I wrote a somewhat different Sudoku solver based on lists rather than matrices. I'll repeat the code below; you can see the explanation at my blog.
(define (sudoku puzzle)
(define (safe? filled digit cell)
(cond ((null? filled) #t)
((and (= (vector-ref (car filled) 0) (vector-ref cell 0))
(char=? (vector-ref (car filled) 3) digit)) #f)
((and (= (vector-ref (car filled) 1) (vector-ref cell 1))
(char=? (vector-ref (car filled) 3) digit)) #f)
((and (= (vector-ref (car filled) 2) (vector-ref cell 2))
(char=? (vector-ref (car filled) 3) digit)) #f)
(else (safe? (cdr filled) digit cell))))
(define (next digit) (integer->char (+ (char->integer digit) 1)))
(define (new old digit) (vector (vector-ref old 0) (vector-ref old 1) (vector-ref old 2) digit))
(let scan ((s 0) (empty '()) (filled '()))
(if (< s 81)
(let* ((row (quotient s 9))
(col (modulo s 9))
(box (+ (* (quotient row 3) 3) (quotient col 3)))
(digit (string-ref puzzle s))
(cell (vector row col box digit)))
(if (char=? digit #\0)
(scan (+ s 1) (cons cell empty) filled)
(scan (+ s 1) empty (cons cell filled))))
(let solve ((empty empty) (filled filled))
(if (pair? empty)
(let try ((cell (car empty)) (digit (next (vector-ref (car empty) 3))))
(cond ((char<? #\9 digit) ; backtrack
(solve (cons (car filled) (cons (new cell #\0) (cdr empty))) (cdr filled)))
((safe? filled digit cell) ; advance
(solve (cdr empty) (cons (new cell digit) filled)))
(else (try cell (next digit))))) ; try next digit
(let ((str (make-string 81 #\0)))
(do ((filled filled (cdr filled))) ((null? filled) str)
(let* ((cell (car filled)) (s (+ (* (vector-ref cell 0) 9) (vector-ref cell 1))))
(string-set! str s (vector-ref cell 3))))))))))
A Sudoku puzzle is represented as an 81-character string, in row-major order, with empty cells represented as zero. Here is a sample solution:
> (sudoku "700100000020000015000006390200018000040090070000750003078500000560000040000001002")
"789135624623947815451286397237418569845693271916752483178524936562379148394861752"
You can run the program at http://programmingpraxis.codepad.org/PB1czuyF.
You might also enjoy the matrix library in my Standard Prelude.