Name: Anonymous 2012-01-30 20:27
I have a complex list of lists and want something to check the second element of every list of the list in the loop, any supported features like this?
(arch (parts lintel post1 post2)
(lintel must-be-supported-by post1)
(lintel must-be-supported-by post2)
(lintel a-kind-of wedge)
(post1 a-kind-of brick)
(post1 must-not-touch post2)
(post2 must-not-touch post1))
(defun lispify-relations (relation-list)
(mapcar #'(lambda (x)
(destructuring-bind (first relation . rest) x
`(,first ,relation ,@rest)))
relation-list))
(lispify-relations '((parts lintel post1 post2)
(lintel must-be-supported-by post1)
(lintel must-be-supported-by post2)
(lintel a-kind-of wedge)
(post1 a-kind-of brick)
(post1 must-not-touch post2)
(post2 must-not-touch post1)))
(defun lispify-relations (relation-list)
(mapcar #'(lambda (x)
(destructuring-bind (first relation . rest) x
`(,relation ,first ,@rest)))
relation-list))
CL-USER> (lispify-relations '((parts lintel post1 post2)
(lintel must-be-supported-by post1)
(lintel must-be-supported-by post2)
(lintel a-kind-of wedge)
(post1 a-kind-of brick)
(post1 must-not-touch post2)
(post2 must-not-touch post1)))
((LINTEL PARTS POST1 POST2) (MUST-BE-SUPPORTED-BY LINTEL POST1)
(MUST-BE-SUPPORTED-BY LINTEL POST2) (A-KIND-OF LINTEL WEDGE)
(A-KIND-OF POST1 BRICK) (MUST-NOT-TOUCH POST1 POST2)
(MUST-NOT-TOUCH POST2 POST1))
(defun type-lint(pass &optional buzzword)
(let ( (temp ()))
(con temp (car arch))
(setq arch (delete (car arch) arch))
(loop
(if (null arch) (return))
(setq temp ())
(if = (car :(car arch)) `must-be-supported-by
(setq arch (delete (car arch) arch))
(con must-be ((car (car arch)) (car temp)))
(setq arch(delete (car arch)))
)
(if = (car :(car arch)) `a-kind-of
(setq arch (delete (car arch) arch))
(con a-kind ((car (car arch)) (car temp)))
(setq arch(delete (car arch)))
)
(if = (car :(car arch)) `must-not-touch
(setq arch (delete (car arch) arch))
(con must-not ((car (car arch)) (car temp)))
(setq arch(delete (car arch)))
)
)
)
)
(defun generate-buzzword-hashtable (list)
(let ((ht (make-hash-table)))
(loop for (first relation . rest) in list
do (push (cons first rest) (gethash relation ht) ))
ht))(defun bref (board square) (aref board square))
(defsetf bref (board square) (val)
`(setf (aref ,board ,square) ,val))setf how to modify the value of a call to bref, for example (setf (bref x y) z). It can't just call bref and modify that, because it will return something by value instead of by reference.
(setf (car x) y), this is what it doesn't do:(let ((z (car x)))
(setf z y))z just contains the value of (car x), not a pointer to it. So (setf z y) wouldn't actually modify the cons cell, and the code wouldn't work.setf sees the call to car, it passes the cons cell to rplaca, which modifies the car.defsetf tells setf which function you want it to call when you have (setf (bref x y) z). In the code you posted, that will expand to (setf (aref x y) z), which well then expand to whatever code setf was told to use to set an aref form.
setf, and section 12.5 is about defsetf.
(defun get-move ()
(setq counter (+ counter 1))
(let* ((x 9) )
(when (eql (mod counter 2) 0)
(setq x (check-for-win))
(if null x
(setq x (check-for-loss))
(if null x
(setq x (random-get))
)
)
(setf (aref board-values x) 2)
(setf (aref board-symbols x) 'O)
)
(when (eql (mod counter 2) 1)
(print "Enter a number between 1 and 9: ")
(loop until (and (>= x 0) (<= 8 x) (valid-move x)
;;;;ERROR HERE;;;;;;;;;;;
(setq x (read))
(setq x (- x 1))
)
(setf (aref board-values x) 1)
(setf (aref board-symbols x) 'X)
))ifs are doing what you want them to. First of all, null x needs to be inside parentheses. Also, in the first if expression, the inner if is part of the else block - it will be executed if x is non-null.(setq counter (+ counter 1)) -> (incf counter)let* is unnecessary in this case - use let.(if (null x) ...) -> (unless x ...) if there's no else(equal (mod counter 2) 0) -> (evenp counter) - same for 1, oddploop, close the parenthesis around and, and then you need the loop keyword do.
(defun checkwin (board &optional player)
(print "in check win")
(when (null player)
(setq player 2)
)
(block nil
(when (eql (aref board 0) player)
(when (and (eql (aref board 0) (aref board 1)) (eql (aref board 1) (aref board 2))) (return T))
(when (and (eql (aref board 0) (aref board 4)) (eql (aref board 1) (aref board 8))) (return T))
(when (and (eql (aref board 0) (aref board 3)) (eql (aref board 1) (aref board 6))) (return T))
)
(when (eql (aref board 1) player)
(when (and (eql (aref board 1) (aref board 5)) (eql (aref board 7) (aref board 5))) (return T))
)
(when (eql (aref board 2) player)
(when (and (eql (aref board 2) (aref board 4)) (eql (aref board 1) (aref board 3))) (return T))
(when (and (eql (aref board 2) (aref board 5)) (eql (aref board 1) (aref board 8))) (return T))
)
(when (eql (aref board 3) player)
(when (and (eql (aref board 3) (aref board 4)) (eql (aref board 1) (aref board 5))) (return T))
)
(when (eql (aref board 6) player)
(when (and (eql (aref board 6) (aref board 7)) (eql (aref board 1) (aref board 8))) (return T))
))
)defparameter.setf for consistency, even when setq will work. They compile to the same code.cond. For example, the first would be (cond ((evenp counter) ...) (t ...)).prints, are equivalent to (setq y (or (check-for-win) (check-for-loss) (random-get))). That's assuming that those functions only return either a number or nil.(setq x (1- (read)))(when (< -1 x 9) ...) - same for 76(and (<= 0 x 8) (= (aref board-values x) 0)) (defun gen-list (turn boards)
"minimax"
(let ((bestscore -2) (tempscore -2)) ;keeps track of score
(print "ALPHA")
(listp (free-return boards)) ;;debugging statement
(when (or (eql (free-return boards) nil) (eql turn 9)) ;;error occurs here the second time, expected type list
(return-from gen-list bestscore)
)
(print "A")
(if (evenp turn)
(setf bestscore -2) ;;forces the computer to pick a move
(setf bestscore 2))
(print "B")
(loop for x in (free-return boards) do ;gets all free areas in the form of a list
(print "C")
(when (evenp turn) ;;if computers turn
(print "D")
(setf (car (nth x boards)) 2) ;;sets element at position x
(print "E")
(when (checkwin boards) ;;if there is a victory
(print "F")
(setf tempscore 1)) ;;set temp to 1
(print "G")
(when (not (eql tempscore 1))
(print "H")
(if (checkwin boards 1) ;;if the opponent has the win
(setf tempscore 0) ;;set score to 0
(setf tempscore -1) ;;else -1
))) (print "I")
(when (oddp turn) ;;if players turn just perform a move
(print boards ) (terpri) (terpri) ;debug
(print "J")
(setf (car (nth x boards)) 1)
(print "k")
)
(print "L")
(setf tempscore (gen-list (+ 1 turn) (free-return boards))); send
(print "M")
(setf (car (nth x boards)) 0) ;;returns board to passed value so it can try another value
(print "N")
;;if it's the computers turn and a better move has been found update it
(when (and (evenp turn) (> tempscore bestscore))
(setf bestmove x)
(setf bestscore tempscore)
))
(return-from gen-list bestmove)
))
(defun free-return (boards)
"returns every available position to move"
(loop for x from 0 to 8 when (eql (car (nth x boards)) 0) collect x))