Discussion of Common Lisp
-
methusala
- Posts: 35
- Joined: Fri Oct 03, 2008 6:35 pm
Post
by methusala » Fri Nov 13, 2009 5:43 pm
Here's the beginning of a mini lisp practice project, connect 4. Feel free to chime in with code, critiques or other input. I would like to practice the coding approach of a dsl and simultaneous bottom up and top down, so to start here is some pseudo code:
bottom up:
Code: Select all
(defun make-board () )
(defun print-board (board) )
(defun end-game () )
(defun get-move () )
(defun make-move (board, x y player) )
(defun test-for-win (board, player) )
(defun count-how-many-in-horizontal-line (board, player, line) )
(defun count-how-many-in-vertical-line (board, player, line) )
(defun count-how-many-in-diagonal-line (board, player, x1,x2,y1,y2) )
(defun list-of-board-rows (board) )
(defun list-of-board-columns (board) )
(defun list-of-board-diagonals (board) )
(defun get-list-of-moves (board,player) )
(defun find-best-move (board,player) )
(defun move-evaluator (board, player) )
(defun min-max (board, player) )
top down:
Code: Select all
(defun connect4 ()
(setf live-board (make-board ))
(do ((repeat))
((eq x 99) (end-game))
(print-board (live-board) )
(multiple-value-bind x y (get-move))
;;first version wont use min-max
(make-move (live-board,x,y,human) )
(setf mate-avoid-move (test-for-win (live-board,player) )
(if (not (null mate-avoid-move)) (make-move (mate-avoid-move (live-board, computer)))
(progn
(multiple-value-bind (find-best-move (live-board, computer) )
(make-move (live-board,x,y,computer))
)
)
)
-
ebie
- Posts: 14
- Joined: Thu Jun 11, 2009 11:11 pm
Post
by ebie » Tue Dec 22, 2009 1:49 pm
I'm finishing up a connect 4 project and was wondering if anyone would be willing to critique it. I don't really know how to program, so I know I'm doing some of it all wrong. Thanks.
-
ebie
- Posts: 14
- Joined: Thu Jun 11, 2009 11:11 pm
Post
by ebie » Mon Jul 05, 2010 10:27 am
Finished this a couple days after my original post (way back in December), but wanted to get some input. Ruthless criticism welcome. Thanks for your time.
Code: Select all
;;;Connect4
(setf b1 (make-array '(6 7) :initial-element nil)) ;empty board.
(setf *num-connect* 4) ;number connected to win.
; up right up-right up-left
(setf *chk-dir-list* '((-1 0) (0 +1) (-1 +1) (-1 -1))) ;list of directions needed to check if consecutive multiples in a row.
(defun start-game (board)
"Starts the game.
Calls MAKE-MOVE."
(format t "~&Who would like to go first? red or blk? ")
(finish-output)
(let ((player (read)))
(if (or (eql player 'red)
(eql player 'blk))
(make-move board player)
(progn (format t "~%Please enter either red or blk!~%~%")
(start-game board)))))
(defun make-move (board player)
"Calls NUM-COLS, PLACE-CHIP."
(print-matrix board)
(let ((num-cols (num-cols board)))
(format t "~&~&~S - enter a column from 1 to ~S: " player num-cols)
(finish-output)
(let ((col (read))) ;move input
(cond ((equal col 'quit) 'quitted) ;exit point.
((or (> col num-cols) ;if not valid coordinates
(< col 1)) (format t "~&You must enter a column number between 1 and ~S!~%" num-cols) ;then print
(make-move board player)) ;and call for make move prompt.
((equal player 'red) (place-chip board (- col 1) 'red)) ;if current player is red then place red chip.
(t (place-chip board (- col 1) 'blk)))))) ;else place black chip at given column.
(defun place-chip (board col player)
"Given board and the player marker it will drop the chip down the given column.
Calls NUM-ROWS, PLACE-CHIP-AUX."
(let ((row (- (num-rows board) 1))) ;sets row to the last row.
(place-chip-aux board col player row))) ;calls PLACE-CHIP-AUX with the last row as the beginning row.
(defun place-chip-aux (board col player row)
"Begins on the bottom row and moves up until it finds an empty spot, then places players marker there.
Calls GET-ELEM, MAKE-MOVE, CONNECTED-P."
(let ((cur-elem (get-elem board row col)))
(cond ((< row 0) (format t "~&Column ~S is full." col)
(make-move board player))
((null cur-elem) (setf (aref board row col) player)
(connected-p board player row col)) ;######! if current spot is empty then set to players num.
(t (place-chip-aux board col player (- row 1)))))) ;else move up a row.
(defun valid-coords-p (board row col)
"Checks if coordinates are within the given board.
Calls NUM-ROWS, NUM-COLS."
(if (and (<= 0 row (- (num-rows board) 1)) ; if from zero to one less the number of rows
(<= 0 col (- (num-cols board) 1))) ; and from zero to one less the number of columns
t ; then return T
nil)) ; else nil
(defun connected-p (board player row col)
(let ((num-connect *num-connect*)
(chk-dir-list *chk-dir-list*))
(connected-p-aux board player row col chk-dir-list num-connect)))
(defun connected-p-aux (board player row col chk-dir-list num-connect)
"Calls Make-move, Walker, Print-matrix."
(cond ((and (null chk-dir-list)
(equal player 'red)) (make-move board 'blk))
((and (null chk-dir-list)
(equal player 'blk)) (make-move board 'red))
((>= (walker board row col (car chk-dir-list) player) num-connect) (format t "~&~%~S Won!~%" player)
(print-matrix board))
(t (connected-p-aux board player row col (cdr chk-dir-list) num-connect))))
(defun get-elem (board row col)
"Checks for valid coordinates and then gets value at that location.
Calls VALID-COORDS-P."
(when (valid-coords-p board row col) ;when row and column coordinates are valid...
(aref board row col))) ;return element at given coordinates.
(defun num-rows (board)
"Returns the number of rows in board (an array)."
(car (array-dimensions board))) ;returns first element in list returned by (ARRAY-DIMENSIONS MATRIX-NAME).
(defun num-cols (board)
"Returns the number of columns in the given board (an array)."
(cadr (array-dimensions board))) ;returns second element in list returned by (ARRAY-DIMENSIONS.
(defun walker (board row col dir-pair key)
"Returns the number of elements that match the given key in the direction given and in opposite direction (so along the same line). NOTE! : this function might not be needed, whatever function calls WALKER-AUX below will pass the ROW-INCR and the COL-INCR to it, instead of this function."
(let ((row-incr (car dir-pair))
(col-incr (cadr dir-pair)))
(walker-aux board row col row-incr col-incr key)))
(defun walker-aux (board row col row-incr col-incr key &optional (count 0) (pass 1))
(let ((new-row (+ row row-incr))
(new-col (+ col col-incr)))
(cond ((and (or (not (valid-coords-p board new-row new-col)) ;if either NOT valid coords or
(not (eql (get-elem board new-row new-col) key))) ;new element is NOT equal to the key element.
(eql pass 1)) ;and we are on the first pass
(walker-aux board new-row new-col (* row-incr -1) (* col-incr -1) key 0 (+ pass 1))) ;then turn 180, set count back to zero and begin pass two.
((eql (get-elem board new-row new-col) key)
(walker-aux board new-row new-col row-incr col-incr key (+ count 1) pass))
((eql pass 2) count) ;if a valid element which doesn't match key element and we are on the second pass, we're done so return the count of elements that matched the key element.
(t 'dropped-through))))
(defun print-matrix (board)
"Prints the given matrix.
Calls NUM-ROWS, PRINT-ROW."
(dotimes (i (num-rows board))
(format t "~%")
(print-row board i))
(format t "~%~%")) ;puts a blank line between printed matrices.
(defun print-row (board row)
"Given a matrix (an array) and a row number will print elements of that row.
Calls NUM-COLS"
(let ((num-per-row (num-cols board))) ;number elements per row
(dotimes (i num-per-row) ;does num-per-row times.
(format t "~2S " (aref board row i))))) ;prints the elements on given row 0 to num-per-row.