nimmt/nimmt.lisp

(ql:quickload "alexandria")

(defun extremum (vector pred &key (key #'identity) (start 0) (end (length vector)))
  (let ((extremum-index)
        (extremum)
        (extremum-keyed))
    (loop for i upfrom start below end
          do (let* ((e (aref vector i))
                    (x (funcall key e)))
               (when (or (null extremum-index)
                         (funcall pred x extremum-keyed))
                 (setq extremum-index i
                       extremum e
                       extremum-keyed x))))
    (values extremum extremum-index extremum-keyed)))

(defun less (a b)
  "Like #'< but ignores nils.
   Works only with two parameters."
  (if (and a b)
      (< a b)
      (if a a)))

(defclass nimmt-player ()
  ((name :accessor name :initarg name)
   (hand :accessor hand :initarg hand :initform nil)
   (score :accessor score :initform 0)))

(defclass human-player (nimmt-player)
  ((name :initform "domonkos")))

(defmethod pick-row ((object human-player))
  (1- (query-player-for-row)))

(defmethod pick-card ((object human-player))
  (let ((selection))
    (format t "Pick a card!~%")
    (setf selection (query-player-for-card (hand object)))
    (setf (hand object) (remove selection (hand object)))
    selection))

(defclass random-bot (nimmt-player)
  ((name :initform "random-bot")))

(defmethod pick-card ((object random-bot))
  (let ((rand (random (length (hand object)))))
    (elt (hand object) rand)))

(defmethod pick-row ((object random-bot))
  (let ((selection (random (length board))))
    ;(format t "Randomly selecting row: ~s~%" selection)
    selection))

(defclass always-smallest-bot (nimmt-player)
  ((name :initform "always-smallest-bot")))

(defmethod pick-row ((object always-smallest-bot))
  "Select row with the smallest penality."
  (extremum (coerce (alexandria::iota (length board)) 'vector) #'< :key #'row-penality))

(defmethod pick-card ((object always-smallest-bot))
  "Select the card that is the closest to the ones on the board."
  (multiple-value-bind (card index diff)
    (extremum (coerce (remove-if (lambda (e) (> e my-card)) (map 'list #'first board)) 'vector)
              #'<
              :key (lambda (e) (- my-card e)))
    (if diff
        card
        (first (hand object)))))

(defmethod punish-player (object nimmt-player score)
  (incf (score object) score))

(defun penality (n)
  (cond ((= n 55) 7)
        ((zerop (mod n 11)) 5)
        ((zerop (mod n 10)) 3)
        ((zerop (mod n 5)) 2)
        (1)))

(defvar cards-per-turn 10)
(defparameter board (make-array 4 :initial-element nil))
(defparameter deck (alexandria::iota 104 :start 1))
(defparameter ai-count 1)
(defparameter players nil)
(defparameter cards-in-this-turn nil)

(defun deck-init ()
  "Returns a shuffled set of 104 cards."
  (setf deck (alexandria::shuffle (alexandria::iota 104 :start 1))))

(defun draw (&optional (n 1))
  (loop while deck
        repeat n
        collect (pop deck)))

(defun players-init ()
  (mapc (lambda (player)
          (setf (hand player) (sort (draw cards-per-turn) #'<)))
        players))

(defun reset-player-scores ()
  (mapc (lambda (player)
          (setf (score player) 0))
        players))

(defun board-init ()
  (setf board (map 'vector
                   (lambda (e) (setf e (draw)))
                   (make-array 4 :initial-element nil))))

(defun game-init ()
  (deck-init)
  (board-init)
  (sort-board)
  (print-board))

(defun row-penality (row-num)
  (reduce #'+ (mapcar #'penality (aref board row-num)))) ; TODO: apply?

(defun card-distance-from (card)
  (let ((anchor card))
    (lambda (other-card)
      (let ((diff (- anchor (first other-card))))
        (if (plusp diff) diff)))))

(defun select-row (card)
  (let ((measure (card-distance-from card)))
    (extremum board #'less :key measure)))

(defun place-card (card player)
  (multiple-value-bind (row row-index distance) (select-row card)
    (declare (ignore row))
    (if distance ; we have a row with a smaller number -> push
        (if (check-row-length row-index)
            (push card (aref board row-index))
            (progn (punish-player player 'score (row-penality row-index))
                   (empty-row row-index card)))
        (let ((selected-row (pick-row player)))
          (punish-player player 'score (row-penality selected-row))
          (empty-row selected-row card)))))

(defun check-row-length (row-index)
  (> 5 (length (aref board row-index))))

(defun query-player-for-row ()
  (print-board)
  (format t "Select a row (1-4): ")
  (loop for num = (read)
        when (and (integerp num)
                  (<= 1 num 4))
        return num
        do (format t "Couldn't parse, retry:~%")))

(defun print-board ()
  (loop for i below (length board)
        do (format t "~d: penality: ~d, row: (~{~4d~})~%" (1+ i) (row-penality i) (aref board i))))

(defun query-player-for-card (hand)
  (format t "Select a card from hand: ~s" (sort hand #'<))
  (loop for selection = (read)
        when (and (integerp selection)
                  (member selection hand))
        return selection
        do (format t "Couldn't parse, retry:~%")))

(defun sort-board ()
  (sort board #'< :key #'first))

(defun empty-row (row new-card)
  ;(format t "Emptying row...~%")
  (setf (aref board row) (list new-card)))
  ;(sort-board)) ; TODO: temporarly disabled

(defun query-player-number (message &rest parameters)
  (format t message parameters)
  (loop
    for input = (read)
    when (numberp input)
    return input
    do (format t "That's not a number")))

;(defun start-new-game ()
;  (setf ai-count (query-player-number "How many AI players you want to play against?~%"))
;  (setf player-count (1+ ai-count))
;  (game-init :player-count player-count)
;  (play-game))

(defun select-cards ()
  (loop for player in players
        for card = (pick-card player)
        do (progn
             (setf (hand player) (remove card (hand player)))
             (push (cons card player) cards-in-this-turn)))) ; TODO: collect

(defun place-cards (cards)
  (loop for (card . player) in (sort cards #'< :key #'first)
        do (progn
             (format t "c ~s p ~s~%" card (name player))
             (place-card card player))))

(defun print-results ()
  (format t "Results:~%")
  (mapc (lambda (p) (format t "~13a: ~s~%" (name p) (score p)))
        (sort players #'< :key #'score)))

(defun play-game ()
  (loop
    ;repeat cards-per-turn
    repeat 1
    do (progn
         (setf cards-in-this-turn nil)
         (select-cards)
         ;(format t "cards: ~s~%" cards-in-this-turn)
         (place-cards cards-in-this-turn)
         (print-board)
         ))
  ;(print-results)
  )