; here is the main code for the program.


; We want to represent the entire state in a variable that contains;
; A structure
; The first element should be a list '(n m) that tells the dimensions
;    of the board
; The second element should be an n x m array that contains 0's or 1's,
; or 2's depending
; on whether there is a ship on that square
; 0 = we don't know
; 1 = ship on the square
; 2 = water; no ship on the square

; The third element should be a list of lists of length n and m, each
;   containing the number of ships in that row or column
; The fourth element should be a list of the ships left to place. This will be a list
;   of four elements, indicating how many of each kind of ship we have left
;   to place. It should be the list (submarines, destroyers, cruisers, battleships).
;   These ships are of length 1,2,3, and 4, respectively.

(defstructure battleship-struc
  (size '(10 10))          ; size of the 2-d array
  (grid NIL)                ; should be a 2-d array of 0's or 1's
  (column-constraints NIL)  ; should be a size "n" list of column constraints
  (row-constraints NIL)     ; should be a size "m" list of row constraints
  (ship-list NIL)           ; should be a list of 4 elements representing a certain number of each ship.
  (ships-placed '(0 0 0 0))        ; should be a list of all the ships placed already
                            ; it should initially start at 0, since no ships
                            ; are placed 
)



(defun create-blank-grid (n m)
  "Create a blank nxm grid"
  (make-array (list n m) :initial-element 0))


(defun print-battleship-board (b-board)
  "Print function for the battleship structure"
  (let ((row 0)
        (numcolumns (first (battleship-struc-size b-board)))
        (thegrid (battleship-struc-grid b-board))
       )
    (dolist (row-constraint (battleship-struc-row-constraints b-board))
      ; for each row element we want to print out a separator,
      ; then print out the actual row.
      (print-separator numcolumns)
      (dotimes (x numcolumns)
        (format t "| ~D " (square-representation (aref thegrid row x))))
      (princ "|")
      (princ row-constraint)
      (princ #\newline)
      (setf row (+ row 1))
      )
    (print-separator numcolumns)
      ; last row after all the ships
    (dolist (column-constraint (battleship-struc-column-constraints b-board))
      (format t "  ~D " column-constraint))
    (princ #\newline)
))


; This is the original, un-optimized legal-moves function as I described in my paper.
;(defun legal-battleship-moves
;       (b-board)
;  "Return all the legal moves. Since cross-off-squares crosses off
;illegal moves, we can move to any empty square. We only need to check0
;whether there are any squares left to place and we couldn't have placed
;any ships that we didn't to place because cross-off-squares would have
;prevented this case"
;  (let ((grid (battleship-struc-grid b-board))
;       (legal-moves NIL)
;          ; this eventually will contain the list of possible moves
;       (numcolumns (first (battleship-struc-size b-board)))
;       (numrows (second (battleship-struc-size b-board)))
;       )
;   (dotimes (x numrows)
;     (dotimes (y numcolumns)
;       ; we need to cycle through each square to see if it's empty
;       ; we can move to any empty square that we know doesn't have
;       ; water on it (has been x'ed off), or doesn't already have a ship
;       (if (eql (aref grid x y) 0)
;          ; if the square is empty
;         (setf legal-moves (cons (list x y) legal-moves))
;         )
;       )
;     )
;   legal-moves
;    ; return the list
;   )
;)

(defun legal-battleship-moves
       (b-board)
"This should be a better function that returns legal moves. Besides just giving the
 possible squares to move into, it should also
  1. Check whether we have x'ed off any ships that we didn't have left to check off
  2. Count the number of ship squares. It shouldn't exceed the number of
     squares in the ships we have to place

 Also, we want to return better moves first. 
 Since this is a constraint satisfaction problem, we may want to first
   return squares that are in rows or columns that have multiple squares
 We will process squares in the order of the 'greatest-first' function to
   get a better-ordered list"

  (let ((grid (battleship-struc-grid b-board))
        (legal-moves NIL)
          ; this eventually will contain the list of possible moves
        (ship-list (battleship-struc-ship-list b-board))
        (ships-placed (battleship-struc-ships-placed b-board))
        (numsquares 0)
        (numplacedsquares 0)
        (contradiction NIL)
          ; we'll set this to true if we do find a contradiction
        
        (row-order
         (greatest-first (battleship-struc-row-constraints b-board)))
        (column-order
         (greatest-first (battleship-struc-column-constraints b-board)))
        )

    (setf numsquares
          (+ 
           (first ship-list)
           (* 2 (second ship-list))
           (* 3 (third ship-list))
           (* 4 (fourth ship-list))))
       ; we want to count the number of placable squares



    (if (or
         (> (first ships-placed) (first ship-list))
         (> (second ships-placed) (second ship-list))        
         (> (third ships-placed) (third ship-list))
         (> (fourth ships-placed) (fourth ship-list)))
      (setf contradiction T))
      ; check #1, we've x'ed off extra ships.

    (dolist (x row-order)
      (dolist (y column-order)
        ; we need to cycle through each square to see if it's empty
        ; we can move to any empty square that we know doesn't have
        ; water on it (has been x'ed off), or doesn't already have a ship
        (cond ((eql (aref grid x y) 0) (setf legal-moves (cons (list x y) legal-moves)))
              ((eql (aref grid x y) 1) (incf numplacedsquares))
                ; as long as we're parsing through every square in the board
                ; we want to count the number of placed ship squares (step 2)
                ; we don't want to do this in a seperate function so that we don't
                ; parse through the board multiple times.
              )
          )
        )
    (if (>= numplacedsquares numsquares) (setf contradiction T))
       ; we put too many squares on the board already
    (if (not contradiction)
      legal-moves
      ; return the list
        NIL
        )
    )
)

(defun greatest-first
       (constraint-list)
  "This function is used by the legal-moves function. Since we are really doing a constraint
satisfaction problem, we want to pick the most limiting constraints first. That would mean
that we placed squares in rows that have the most squares in them, which meant that there
was the least amount of possibilities for the row. This function should take in a constraint list
(for either row or column), for example, '(1 2 2 3 1 0 0 3) and return a list describing where
the most constraints are... so, in the example, it should return (3 7 1 2 0 4 5 6).
If legal-moves goes through moves in this order, it should reach a conclusion faster."
(let ((assoc-list NIL))
  (dotimes (x (length constraint-list))
    (setf assoc-list 
          (cons 
           (cons (nth x constraint-list) x)
           assoc-list)))
  ; create a list associating each element with its position
  (setf assoc-list (sort assoc-list #'> :key #'car))
  (mapcar #'cdr assoc-list)
   ; return the second elements of the list, sorted by the first element
))
     
(defun game-over-p
       (b-board)
  "This tests whether the game's over. The game is over when the ships placed
are the same as the ships that we have to place"
  (equal (battleship-struc-ship-list b-board)
         (battleship-struc-ships-placed b-board)))

(defun make-battleship-move
       (move b-board)
  "All this function has to do is place the sure on the board and
then call cross-off-squares to cross off any new ships or constraints
that are the result of this square"
  (setf (aref
         (battleship-struc-grid b-board)
         (first move)
         (second move))
        1)
  ; put a ship on the requested square
  (cross-off-squares b-board)
  ; take care of the implications of the move
)

(defun cross-off-squares (b-board)
  "Cross off impossible squares. This is the guts of the program and
helps constrain the problem to keep it from being too bushy"
; This involves 
; 1. Crossing off rows that are full
; 2. Crossing off squares that are diagonal from any filled squares
; 3. If a filled square connects to another filled squre, crossing
;    off squares that are perpendicular to the line
; 3.5. Update the "ships placed list" before step 4 so that ships that became
;    places by steps 1-3 can be crossed off first.
; 4. If there is a row of ships that is as long as the longest
;    ship left, cross off the squares around the ship.
; 5. Update the "ships placed" list. A ship is placed if it is surrounded
;    by water or the edges of the board.
  (cross-off-full-rows b-board)
   ; cross off any rows or columns that are full
  (cross-off-adjacent-squares b-board)
   ; this function should do steps 2-3; it should go through
   ; each square that's a filled in square. Squares diagonal to
   ; that square should be crossed off.
  (cross-off-ships-list b-board)
   ; this function does steps 3.5 through 5; it updates the "ships placed list", it then
   ;   crosses off any ships that are as long as the the longest unplaced ships and repeats...
)


; helper functions
(defun cross-off-ships-list
       (b-board)
"This function should do steps 3.5 -> 5. It actually should do update-ships-placed-list, 
cross off new-ships, update-ships-placed-list, cross-off-new ships until no new ships are 
crossed off"
(let* ( (thegrid (battleship-struc-grid b-board))
        (numcolumns (first (battleship-struc-size b-board)))
        (numrows (second (battleship-struc-size b-board)))
        (squares-list (find-all-ships
                     (find-all-ship-squares thegrid numrows numcolumns)))
          ; get a list of all the "ships" on the board. This is a list of all sets of
          ; adjacent squares. We pass this in to several functions to make the program
          ; more efficient - this won't change since we're not placing any ship squares
          ; in this function and it takes a while to scan 144 squares each time.
       )
  (update-ships-placed-list b-board squares-list)
    ; update the "ships-placed" list to include newly placed/crossed-off ships
  (cross-off-new-ships b-board squares-list)
    ; cross of uncrossed ships and update the "ships-placed" list
))

(defun cross-off-new-ships
       (b-board squares-list)
  "This function should look through the 'ships-placed list' and the original 'ships list'
 to find the largest, unplaced ship. If there is a ship of that length in the squares-list,
 we want to cross it off (surround it with x's) and add it to the 'ships-placed' list. We
 then want to call this function again until there's no ships left to cross off."
  (let* ((grid (battleship-struc-grid b-board))
         (ships-list (battleship-struc-ship-list b-board))
         (ships-placed (battleship-struc-ships-placed b-board))
         (longest-length (longest-ship-length ships-list ships-placed))
         (unplaced-squares (remove-if #'(lambda (x) (surrounded-ship x grid)) squares-list))
           ; this is a list of all ships that are either unfinished or not yet corssed off
         (uncrossed-off-ship (member-if #'(lambda (x) (= (length x) longest-length)) unplaced-squares))
           ; this is a list whose first element contains the ship to be crossed off
         )

    (if (null uncrossed-off-ship) 
      NIL
      (progn
        (cross-off-ship (car uncrossed-off-ship) grid)
        ; cross off the ship
        (setf (battleship-struc-grid b-board) grid)
        ; update the real board
        (incf (nth (- longest-length 1) ships-placed))
        ; increment the ships placed list to represent the newly crossed off ship
        (setf (battleship-struc-ships-placed b-board) ships-placed)
        ; update the real board
        (cross-off-new-ships b-board squares-list)
        ; call the function again to cross off any remaining ships
      )
      )
    )
)

(defun cross-off-ship
       (ship grid)
  "This function takes in a ship and crosses off all the squares around that ship"
  (dolist (z ship)
    (let ((x (first z)) (y (second z)))
      (if (eql (aref grid (- x 1) (- y 1)) 0) (setf (aref grid (- x 1) (- y 1)) 2))
      (if (eql (aref grid (- x 1) y) 0) (setf (aref grid (- x 1) y) 2))
      (if (eql (aref grid (- x 1) (+ y 1)) 0) (setf (aref grid (- x 1) (+ y 1)) 2))
      (if (eql (aref grid x (+ y 1)) 0) (setf (aref grid x (+ y 1)) 2))
      (if (eql (aref grid (+ x 1) (+ y 1)) 0) (setf (aref grid (+ x 1) (+ y 1)) 2))
      (if (eql (aref grid (+ x 1) y) 0) (setf (aref grid (+ x 1) y) 2))
      (if (eql (aref grid (+ x 1) (- y 1)) 0) (setf (aref grid (+ x 1) (- y 1)) 2))
      (if (eql (aref grid x (- y 1)) 0) (setf (aref grid x (- y 1)) 2)))))

                 
        

(defun longest-ship-length
   (ships-list placed-list)
  "This function takes in a ships-list and a placed-list and returns the length of the
longest, unplaced ship"
  (let ((longest 0))
    (dotimes (x 4)
      (if (> (nth x ships-list) (nth x placed-list))
        (setf longest (+ x 1))))
    longest))


(defun update-ships-placed-list
       (b-board ships-list)
  "This function takes in a 'ships-list; and the entire board and updates the ships-placed
 list to include any ships that are completely surrounded"
  (let ((placed-list (list 0 0 0 0))
        (grid (battleship-struc-grid b-board))
        )
    (dolist (x ships-list)
      (if (surrounded-ship x grid)
        (incf (nth (- (length x) 1) placed-list))))
         ; for each ship that's surrounded, we want to update the correct kind of ship
         ; in the "placed-list" (this depends on the length of ship)
    (setf (battleship-struc-ships-placed b-board) placed-list))
         ; update the entire structure
)

(defun surrounded-ship
       (ship grid)
       "This takes in a 'ship' (a set of squares that are adjacent) and returns true if the 
ship is surrounded by squares"
       (if (null ship) 
         T
         ; bottom recursive case
         (and (surrounded-square (car ship) grid)
              (surrounded-ship (cdr ship) grid))))


(defun surrounded-square
       (square grid)
      "This returns true is a square is not surrounded by any blank space"
      (let ((x (first square)) (y (second square)))
        (not (or
              (eql (aref grid (- x 1) (- y 1)) 0)
              (eql (aref grid (- x 1) y) 0)
              (eql (aref grid (- x 1) (+ y 1)) 0)
              (eql (aref grid x (+ y 1)) 0)
              (eql (aref grid (+ x 1) (+ y 1)) 0)
              (eql (aref grid (+ x 1) y) 0)
              (eql (aref grid (+ x 1) (- y 1)) 0)
              (eql (aref grid x (- y 1)) 0)))))

(defun find-all-ship-squares
       (grid numrows numcolumns)
  "This function takes in a battleship grid and returns a set of squares (x,y) with 
ships on them"
  (let ((ships-set NIL))
    (dotimes (x numrows)
      (dotimes (y numcolumns)
        (if (eql (aref grid x y) 1)
          (setf ships-set (cons (list x y) ships-set)))))
    ships-set
    ;return the set of all squares with ships on them
))


(defun find-all-ships
       (ship-set)
  "This function takes in the set of all ship-squares (from the find-all-ship-squares
function) and returns a list of all adjacent squares (ships) in the form of 
'( ((x11 y11) (x12 y12) (x13 y13)) ((x21 y21) (x22 y22) (x23 y23)))"
  (if (null ship-set)
    NIL
    (let ((first-ship
           (complete-ship ship-set (car ship-set))))
          ; this is the first ship in the ship-set
      (cons first-ship
            (find-all-ships (remove-if #'(lambda (x) (member x first-ship :test #'equal)) (cdr ship-set) ))))))

(defun complete-ship
  (ship-squares square)
  "This function takes in the set of all ship squares and a specific square in that set and
finds all the squares in the ship-set that are part ofth same ship. This function uses the fact that
the function that returns the ship-set will return squares in reverse order"
  (let ((x (first square)) (y (second square)))
    (cond ((member (list x (- y 1)) ship-squares :test #'equal)
           (cons square 
                 (complete-ship ship-squares (list x (- y 1)))))
          ((member (list (- x 1) y) ship-squares :test #'equal)
           (cons square
                 (complete-ship ship-squares (list (- x 1) y))))
          (t (list square)))))

(defun adjacent
       (square1 square2)
  "This function takes in (x1, y1) and (x2, y2) and returns true if the square
are adjacent"
  (eql 
   (+ 
    (abs (- (first square1) (first square2)))
    (abs (- (second square1) (second square2)))) 
   1)
)

(defun cross-off-adjacent-squares 
       (b-board)
  "Takes in a board and goes through every filled in square in the
grid. Squares diagonal to that square should be crossed off. If that
square is next to another filled in square, squares orthogonal to the
line should be crossed off"
  (let ((thegrid (battleship-struc-grid b-board))
        (numcolumns (first (battleship-struc-size b-board)))
        (numrows (second (battleship-struc-size b-board)))
        )
    (dotimes (x numrows)
      (dotimes (y numcolumns)
        ; loop through each square.
        ; i feel like i'm programming in basic.
        (if (eql (aref thegrid x y) 1)
           ; we hit a ship
          (progn
            (cross-off-diagonal-squares thegrid x y)
             ; cross of squares diagonal to the actual square
            (if (horizontal-ships-p thegrid x y)
              (cross-off-vertical-squares thegrid x y))
             ; if there was a ship left or right to the square,
             ;   cross of square above and below the square
            (if (vertical-ships-p thegrid x y)
              (cross-off-horizontal-squares thegrid x y))))))
    (setf (battleship-struc-grid b-board) thegrid)
     ; update the entire structure
    ))


(defun cross-off-diagonal-squares
       (grid x y)
  "Cross of the squares diagonal to square (x,y). There's no reason
to check if they're already crossed off because that takes as much
time as actually crossing them off"
  (setf (aref grid (- x 1) (- y 1)) 2)
  (setf (aref grid (- x 1) (+ y 1)) 2)
  (setf (aref grid (+ x 1) (+ y 1)) 2)
  (setf (aref grid (+ x 1) (- y 1)) 2))

(defun horizontal-ships-p
       (grid x y)
  "This returns true if ships exist left or right of the square."
  (or (eql (aref grid x (- y 1)) 1)
      (eql (aref grid x (+ y 1)) 1)))

(defun cross-off-vertical-squares
       (grid x y)
  "This function crosses off squares up and down of a square"
  (setf (aref grid (- x 1) y) 2)
  (setf (aref grid (+ x 1) y) 2))

(defun vertical-ships-p
       (grid x y)
  "This returns true if ships exist up or down of the square."
  (or (eql (aref grid (- x 1) y) 1)
      (eql (aref grid (+ x 1) y) 1)))

(defun cross-off-horizontal-squares
       (grid x y)
  "This function crosses off squares up and down of a square"
  (setf (aref grid x (- y 1)) 2)
  (setf (aref grid x (+ y 1)) 2))
  

(defun cross-off-full-rows (b-board)
"This function takes a battleship environment and crosses off full rows"
; we need to go through each row and column, checking whether the
;   number of squares in each row matches the number of squares in 
;   the constraints. If it does, we need to cross off any non-crossed
;   off squares in that row
(let ((row-constraints (battleship-struc-row-constraints b-board))
      (column-constraints (battleship-struc-column-constraints b-board))
      (thegrid (battleship-struc-grid b-board))
      (numcolumns (first (battleship-struc-size b-board)))
      (numrows (second (battleship-struc-size b-board)))
      )
  (dotimes (x numrows)
    ; go through each row
    (let ((row-constraint (nth x row-constraints))
          (num-squares (count-row-squares thegrid x numcolumns))
            ; the number of squares already filled in that row
          )
      (if (eql row-constraint num-squares)
        (fill-row thegrid x numcolumns))))
  (dotimes (x numcolumns)
    ; go through each column
    (let ((column-constraint (nth x column-constraints))
          (num-squares (count-column-squares thegrid x numrows))
            ; the number of squares already filled in that row
          )
      (if (eql column-constraint num-squares)
        (fill-column thegrid x numrows))))))

(defun count-row-squares (thegrid x numcolumns)
  (let ((cnt 0))
    (dotimes (i numcolumns cnt)
      (when (aref thegrid x i) (incf cnt)))))

(defun count-column-squares (thegrid y numrows)
  (let ((cnt 0))
    (dotimes (i numrows cnt)
      (when (aref thegrid i y) (incf cnt)))))