Connect 4 in lisp

[methusala]

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]

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]

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.