#|
                     "Last Piece Puzzle" solver


Terminology, data structures, function arguments, etc.:

  board      2-dimensional array, 8x8, referenced by (aref board row col).
             The elements are called board squares.  Each is nil or has a
             piece.  The same piece is in each it occupies.
             The upper left square of the board is 0 0, the upper right is
             0 7, the lower left is 7 0, the lower right is 7 7.  See row
             col below.
  square     A board square or a piece square.  Each square is a list of 3
             items.  The first two items are a row number and a column
             number.  For board squares, see row col below.  For piece
             squares, see piece below.  The 3rd item of the list is the
             parity of the square.  See parity below.
  row col    The row and column of a board square.  See board above.
             Wherever the words row col appear together, as function args or
             whatever, they have this same definition, and have nothing to do
             with rows and columns of the squares of a piece.
  pnbr       A piece number.  See piece below for details.
  piece      Static information about a particular piece, as a list of five
             items:  First, the name string, giving the piece a name such as
             "t" or "Z".  Second through fifth, the rotations of the piece.
             Each rotation is a list of squares.  Each square is a list of
             three items:  two numbers and the parity of that square.  The
             two numbers are the row and column offsets from the top left
             of an imaginary rectangle which would hold that piece in that
             rotation.  The offsets are not referred to as row col.  See row
             col above.  Note that there are 14 pieces and they are referred
             to by their name string only when printing.  When using them,
             they're referred to by their piece number, which is 0-13.  The
             numbers are assigned according to the layout of the pieces on
             the original board shown in the contest rules.  The first piece,
             i.e. the piece to be moved to the lower right, is piece 0.  The
             other 3 landlocked pieces are 1-3 from bottom to top.  The
             upper left corner is 4.  The numbering continues clockwise from
             there, with all the rest of the pieces having frontage on the
             edge of the board, and that frontage determining the numbering
             sequence clockwise.  Note that the overall numbering sequence
             is a clockwise outward spiral from piece 0 to piece 13.
  parity     A symbol, t or 's, to indicate whether a particular square is a
             tab square or a slot square.
  psq        A particular square of a particular rotation of a piece.  Given
             a rotation and a psq argument, use (nth psq rotation) to get
             the square.  See piece above.
  rot        Rotation number.  See piece above.  rot 0 is unrotated, 1 is 90
             degrees clockwise, 2 is 180, 3 is 270.

|#

(defparameter board (make-array '(8 8)))

;; There are 14 pieces.  They're the 14 elements of this
;; list, which is named pieces.  See piece in the terminlogy
;; section.
;; The constant data you see here only has rotation 0 of each
;; piece.  The other 3 rotations are established by
;; do-all-rotations, which replaces this initial data with the
;; resulting complete data.
(defparameter pieces
  '(("3" ((0 1 t) (1 1 s) (1 0 t)))
    ("Z" ((0 0 t) (0 1 s) (0 2 t) (1 2 s) (1 3 t)))
    ("t" ((0 1 s) (1 0 s) (1 1 t) (1 2 s)))
    ("s" ((0 0 s) (1 0 t) (1 1 s) (2 1 t)))
    ("J" ((0 0 t) (0 1 s) (0 2 t) (0 3 s) (1 3 t)))
    ("L" ((0 0 t) (0 1 s) (0 2 t) (0 3 s) (1 0 s)))
    ("Q" ((0 1 t) (0 2 s) (0 3 t) (1 0 t) (1 1 s)))
    ("j" ((0 1 s) (1 1 t) (2 1 s) (2 0 t)))
    ("l" ((0 0 s) (0 1 t) (1 1 s) (2 1 t)))
    ("F" ((0 1 t) (1 0 t) (1 1 s) (1 2 t) (1 3 s)))
    ("S" ((1 0 s) (1 1 t) (1 2 s) (0 2 t) (0 3 s)))
    ("W" ((2 0 t) (2 1 s) (1 1 t) (1 2 s) (0 2 t)))
    ("T" ((0 0 t) (1 0 s) (2 0 t) (3 0 s) (2 1 s)))
    ("N" ((0 0 s) (0 1 t) (1 1 s) (2 1 t) (2 2 s)))))

;; The number of squares in a particular piece.
(defun piece-size (pnbr)
  (length (cadr (nth pnbr pieces))))

;; The t or s parity of a board square.
;; See parity in terminology.
(defun parity (row col)
  (if (evenp (+ row col)) t 's))

;; Rotate a piece 90 degrees clockwise.  The argument, prev,
;; is the previous rotation of the piece.  See piece in the
;; terminology section.  This is used only when constructing
;; the piece data, which includes 4 rotations per piece.  This
;; makes one of those rotations, and returns it.
;; This works by using an imaginary rectangle, 4x4, with
;; squares being at 0 0 through 3 3.
;; Starting with prev which has squares in that rectangle.
;; The result will have the same number of squares, moved.
;; For each square, the prev vertical offset becomes the new
;; horizontal offset, and the opposite of the prev horizontal
;; offset becomes the new vertical offset.  In other words,
;; swap the horizontal and vertical numbers but subtract the
;; new horizontal number from 3 to get its opposite, mirror
;; image, number.
;; Note that there is no need to "normalize" the rotated piece,
;; i.e. to move it to the upper left of its imaginary rectangle,
;; because all the numbers are relative anyway, always being
;; used as offsets from real board squares, which would work
;; even if some of the offsets were negative.
(defun rotate (prev)
  (loop as square in prev
        collect (list (cadr square)
                      (- 3 (car square))
                      (caddr square))))

;; This makes a rotated copy of each piece for each possible
;; rotation.  To save time when placing the pieces, by not
;; spending time rotating them then.
(defun do-all-rotations ()
  (setq pieces
    (loop as piece in pieces
          as name = (car piece)
          as rot-0 = (cadr piece)
          collect (cons name
                    (loop as rot = rot-0 then (rotate rot)
                          repeat 4
                          collect rot)))))


;; Put the piece on the board.  The list tells what squares it
;; will occupy.  Put it in each.  It's already known to fit.
;; This is more like reserving and marking the board than doing
;; anything interesting with the actual piece.
(defun occupy-squares (list piece)
  (loop as square in list
        as row = (car square)
        as col = (cadr square)
        do (setf (aref board row col) piece)))

;; Determine which board squares are needed to put a given
;; piece on an exact board location in a given orientation.
;; Returns a list of board squares.  Some of them might be
;; off the board and some might be occupied.
(defun squares-needed (piece rot psq row col)
  (let* ((squares (nth rot (cdr piece)))
         (square (nth psq squares))
         (row (- row (car square)))
         (col (- col (cadr square))))
    (loop as square in squares
          collect (list (+ row (car square))
                        (+ col (cadr square))
                        (caddr square)))))

;; Predicate for a list of board squares being ready
;; to be occupied.  If not, it means another piece is
;; in some of them, or some of them are off the board.
(defun squares-are-available (list)
  (loop as square in list
        as row = (car square)
        as col = (cadr square)
        always (eq (caddr square) (parity row col))
        always (and (<= 0 row 7)  (<= 0 col 7))
        never (aref board row col)))

;; Attempt to put a piece at a given place on the board.
;; Return a list of the squares occupied by the piece,
;; or nil if it won't fit.
;; See the terminology section for explanations of the
;; arguments.
(defun put-piece (piece-number rot psq row col)
  (let* ((piece (nth piece-number pieces))
         (list (squares-needed piece rot psq row col)))
    (when (squares-are-available list)
      (occupy-squares list piece)
      list)))

;; Remove what's on specific squares of the
;; board, given a list of squares.  See the
;; terminology section for squares and board.
(defun remove-from-board (list)
  (loop as square in list
        as row = (car square)
        as col = (cadr square)
        do (setf (aref board row col) nil)))

;; This is a slow solver of the puzzle.  It was a first
;; try at coming up with a reasonable solver.  Its main
;; value now is in providing an example of how changing an
;; algorithm can provide far more speed improvement than
;; any difference in languages or fine tuning.
;; The reason why this algorithm is slow is that it tries
;; putting each piece everywhere, then each other piece
;; everywhere else.  The faster way is to build on the
;; pieces that are already there, using them as an anchor
;; to avoid the time consumption of repeatedly putting
;; pieces everywhere.  The logic behind building on the
;; pieces that are already there is that if there is any
;; solution at all possible with those pieces there, that
;; solution must be reachable by building on them, because
;; eventually everything has to touch.
;; The list argument is a list of piece numbers.  This
;; function attempts to put those pieces on the board, given
;; whatever is already there.  If it can't put them, it
;; returns false and cleans up leaving the board with the
;; pieces that were there.  If it does find a solution, it
;; leaves that solution on the board and returns true.
;; The optional vb arg tells how verbose it should be.  Nil
;; or omitted = none, 1 = small amount, 2 = more, etc.
(defun slow-solve (list &optional vb)
  (if list
    (let* ((pnbr (car list))
           (psize (piece-size pnbr)))
      (dotimes (row 8)
        (dotimes (col 8)
          (unless (aref board row col)
            (when vb (format t "~2d at ~a ~a     " pnbr row col))
            (dotimes (rot 4)
              (dotimes (psq psize)
                (let ((squares (put-piece pnbr rot psq row col)))
                  (when squares
                    (let ((vb (and vb (> vb 1) (1- vb))))
                      (if (slow-solve (cdr list) vb)
                        (return-from slow-solve t)
                        (remove-from-board squares)))))))))))
    t))

;; This is the solver actually in use now.  See the slow-solver
;; above for an explanation of the algorithm.  Note in particular
;; the (return-from solve nil) which causes it to quit when it
;; can't find a solution using a particular empty square.  That
;; early quitting, causing it to rearrange nearby stuff sooner,
;; is what makes it orders of magnitude faster than slow-solver.
;; But it also has other differences from slow-solver, to make
;; the different algorithm work.  E.g. going backwards up the
;; board to find the first empty square, and then insisting that
;; the square has to be filled immediately if the presently placed
;; pieces are part of a possible solution.
(defun solve (list &optional vb)
  (if list
    (loop as row from 7 downto 0 do
      (loop as col from 7 downto 0 do
        (unless (aref board row col)
          (dotimes (rot 4)
            (dolist (pnbr list)
              (when vb (format t "~2d at ~a ~a     " pnbr row col))
              (dotimes (psq (piece-size pnbr))
                (let ((squares (put-piece pnbr rot psq row col)))
                  (when squares
                    (let ((vb (and vb (> vb 1) (1- vb))))
                      (if (solve (remove pnbr list) vb)
                        (return-from solve t)
                        (remove-from-board squares))))))))
          (return-from solve nil))))
    t))

(defun clear-the-board ()
  (remove-from-board
    (loop as row below 8
          nconc (loop as col below 8
                      collect (list row col t)))))

;; Put piece zero (named "3") with its square 0 on
;; board square 7 7 rotaded 90 degrees clockwise.
;; This is the forced initial move which starts the game.
(defun put-first-piece ()
  (assert (put-piece 0 1 0 7 7)))

(defun put-published-board ()
  (assert (put-piece 0 0 0 2 6))
  (assert (put-piece 1 0 0 5 3))
  (assert (put-piece 2 0 0 3 4))
  (assert (put-piece 3 0 0 1 2))
  (assert (put-piece 4 0 0 0 0))
  (assert (put-piece 5 0 0 0 4))
  (assert (put-piece 6 0 0 1 5))
  (assert (put-piece 7 0 0 2 7))
  (assert (put-piece 8 0 0 5 6))
  (assert (put-piece 9 0 0 6 4))
  (assert (put-piece 10 0 0 7 0))
  (assert (put-piece 11 0 0 6 0))
  (assert (put-piece 12 0 0 2 0))
  (assert (put-piece 13 0 0 1 0)))

(defun print-board ()
  (loop as y below 8
        do (terpri)
           (loop as x below 8
                 as square = (aref board y x)
                 as name = (if square (car square) 0)
                 do (format t " ~a" name)))
  (terpri)
  (terpri))

;; The following line is part of this program's initialization.
;; It won't work without it, because it establishes the 4 different
;; orientations of each piece.  For speed each piece has 4 copies,
;; each with a different orientation, and those 4 copies are
;; made by this.
(do-all-rotations)

;; These are the other 13 than the forced-play first piece which
;; is piece number 0.
(defvar other-13-piece-numbers (loop as i from 1 to 13 collect i))




;; The following is the stuff to mess with when trying different things
;; with this program.  Or omit this stuff from this file and enter it
;; at the repl.

;; This displays a copy of the original board as published in the
;; contest rules.
(put-published-board)
(print-board)

(format t "The above is the original board, as published in the contest~%")
(format t "rules.  The piece names show where each piece is.  The~%")
(format t "solution will be shown below.  If it seems very slow, try~%")
(format t "compiling it.  It should take less than a minute.~%")

;; This would display a mostly empty board, showing 0 for each empty square,
;; but with the first piece placed where it's supposed to go.  The name
;; of the first piece is "3" and you can see that on the board displayed
;; by this.
;; That's what it would do if the (print-board) weren't commented out.
;; As it is now, it's just setting up the board for solving the puzzle.
(clear-the-board)
(put-first-piece)
; (print-board)

;; This is what actually solves the puzzle and shows the result.
(solve other-13-piece-numbers)
(print-board)

(format t "That is the solution.~%~%")

;; Have fun.

;; $Id: //info.ravenbrook.com/user/ndl/lisp/contest/entries/eric-smith.lisp#1 $