;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ILC 2003 Programming Contest                                         ;;
;; Solution submitted by Russ Ross                                      ;;
;; russ@russross.com                                                    ;;
;; September 24, 2003                                                   ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; My solution is a very straightforward approach to solving the puzzle.
; Conceptually, it works as follows:
;
; 1. Start with the board empty except for the piece labeled 3 which has
;    a fixed position.
; 2. Starting at the bottom right and moving right-to-left then down-to-up,
;    find a space on the 8x8 board that isn't occupied by a piece.
; 3. Place one of the remaining pieces at that position and repeat from
;    step 2.  Do this for all the pieces that can fit at this position.
;    Note: all spaces on the board below this position or to the right in
;    the current row will already be occupied.
; 4. When we find a solution, record it.  When we get stuck, backtrack until
;    there is something new to try.
;
; It's simple, it's naive, but it works pretty well, it's intuitive, and
; with a little preparation it can run quickly.
;
; We represent the board as a 64-bit integer whose bits represent positions on
; the board.  The lowest bit represents the bottom right spot on the board, and
; higher bits move right-to-left and then down-to-up until the highest bit
; represents the top left position on the board.
;
; In addition, we assign numbers to each piece such that the number is 2^n for
; some n unique to that piece.  That way, we can track which pieces have been
; used so far using a single integer and we can test if a piece has been used
; already with a bit operation.
;
; Before starting the search, we prepare a table of pieces.  The table includes
; every piece in every possible position and rotation.  To generate all these
; variations for each piece, we rely on a few observations:
;
; 1. if a position is valid, the position two spots to the right or left is
;    also valid (as long as it doesn't go off the edge of the board)
; 2. if we move up or down a single spot, we also need to move left or right
;    a single spot to get another valid piece.
; 3. if we rotate a position 90 degrees in either direction, we need to shift
;    it one spot in any direction to get a valid position.
;
; These translate into bit operations as:
;
; 1. if a piece represented by the bitmask n is valid, (ash n 2) and (ash n -2)
;    are also valid unless they hit the edge of the board (which we can test
;    using a suitable bitmask).
; 2. if we shift a piece off the edge, it will reappear on the other edge
;    up or down a row (depending on which way we shifted it), so shifts that
;    cross the edge should be an odd number of bits to yield another valid
;    bitmask n'.
; 3. if we start with a piece in a valid position, we can get another valid
;    position by rotating it 180 degrees, and we can get the other two valid
;    rotations of the piece by rotating it 90 and 270 degrees and shifting
;    right or left once.  note that some pieces are symmetric so a 180 degree
;    rotation yields a duplicate piece.
;
; In addition to generating all the different rotations and positions of each
; piece, we partition the list (around 900 piece-position-rotations in total)
; into 64 sublists, based on the lowest set bit in the piece's representation,
; i.e., according to the rightmost lowest spot on the board that it occupies.
; If we refer to the basic overview given at the top, step #3 can be easily
; an efficiently implemented by searching through the appropriate sublist of
; pieces for any that will fit.
;
; With that preparation, the search itself is quite simple and follows the
; high level overview in a straightforward way.
;
; For input, we take a sample fitting of all the pieces on the board such as
; that given in the problem statement:
;
;   JJJJLLLL
;   NNsJL3QQ
;   TNss33Qj
;   TNNstQQj
;   TTWtttjj
;   TWWZZZll
;   WWSSFZZl
;   SSSFFFFl
;
; We extract all the pieces from that (except the special piece 3) and use
; them to generate the table used by the solver (note: we assume no piece
; is longer than four spots in any direction).  Then we feed that table and
; the location of piece 3 (using the same representation as the solver--a
; bitmask on an otherwise blank board) and let it scan all the possible
; fittings to find the solutions.  The solver gives back a list of proofs,
; where each proof is a list of pieces (each in a specific position and
; rotation) that make up the solution.  From that we can easily print a nice
; representation of the solution in a form similar to our input.
;
; I've tested this using CMUCL, GCL, and CLISP (CLISP requires the fix below)
;
; This solution is released into the public domain, though I ask that you
; acknowledge me as the author.
;
; - Russ Ross <russ@russross.com>, September 24, 2003
;


; clisp has a bug in the logtest function.  if you use clisp, uncomment this
; code to replace it with something that works
;(unless (logtest (ash 1 63) (ash 1 63))
;  (defun logtest (a b) (not (zerop (logand a b))))
;  (compile 'logtest))

;; take an 8x8 board (stored as a string of length 64)
;; and rotate it 90 degrees
(defun rotate (source)
  (let ((target (make-string 64 :initial-element #\-)))
    (do ((y 0 (+ 1 y)))
        ((= y 8) target)
      (do ((x 0 (+ 1 x)))
          ((= x 8))
        (setf (char target (+ (* x 8) (- 7 y))) (char source (+ (* y 8) x)))))))

;; take an 8x8 board (as 8 strings of 8 characters each) and return a list of
;; pieces of the form: ((name . mask) ...)
;; where name is the original char that identified the piece, and mask is a
;; bitmask for the piece
;; ignore the piece matching the "exclude" char
(defun makepieces (source exclude)
  (let ((table (make-hash-table))
        (result nil))
    (do ((i 63 (- i 1))         ; the position on the board
         (mask 1 (ash mask 1))) ; the bitmask representing that position
        ((< i 0))
      (let ((key (char source i)))
        (unless (eql key exclude)
          ; the first time we see a char we create an entry for it in the table
          (unless (gethash key table) (setf (gethash key table) (cons key 0)))
          (let ((elt (gethash key table)))
               ; add the current bitmask to the appropriate piece
               (setf (cdr elt) (logior (cdr elt) mask))))))
    ; convert the hash table to a list
    (maphash #'(lambda (key val) (setq result (cons val result))) table)
    result))

;; generate the table of pieces (in every rotation and shifted position)
;; for the solver, and the table of piece number -> piece name mappings
;; "in" is a list of strings whose combined length should be 64 char.
;; it represents all the pieces on the board in some configuration.
;; the pieces will be generated from that input board (except the piece
;; named by "exclude") and the result is of the form (names . solver)
;; where names is a hashtable mapping piece numbers -> piece names and
;; solver is a table of the form (((num0 . mask0) ...) ((num1 . mask1) ...))
;; where maskN is a piece identified by numN whose lowest set bit is N.
(defun maketables (in exclude)
  (let ((table (make-array '(64) :initial-element nil))
        (dups (make-hash-table :test #'equal))
        (idnums (make-hash-table))
        (nextnum 1)
        (source (apply #'concatenate 'string in)))
  (labels (
     ; find the index of the lowest set bit
     (find-lowest-bit (piece)
       (do ((mask 1 (ash mask 1))
            (n 0 (+ n 1)))
           ((logtest mask piece) n)))
     ; shift a piece right or left one--whichever doesn't push it past an edge
     (shift1 (piece)
       (if (logtest (cdr piece) #x8080808080808080)
           (cons (car piece) (ash (cdr piece) -1))
           (cons (car piece) (ash (cdr piece) 1))))
     ; get (and possibly create) the mapping from piece label to number
     (getnum (id)
       (unless (gethash id idnums)
         (setf (gethash id idnums) nextnum)
         (setq nextnum (ash nextnum 1)))
       (gethash id idnums))
     ; add a piece to the table of results unless it's a duplicate
     (addpiece (id piece index)
       (let ((p (cons (getnum id) piece)))
         (unless (gethash p dups)
           (setf (gethash p dups) t)
           (setf (svref table index)
                 (cons p (svref table index))))))
     ; save this piece and all left-shifted variants of it
     (left  (id piece index)
       (let (; ex tells us if the piece overlaps the left two columns
             (ex  (logtest piece #xc0c0c0c0c0c0c0c0))
             ; e_x tells us if the piece overlaps the column fourth from left
             (e_x (logtest piece #x1010101010101010))
             ; ey tells us if the piece overlaps the top row
             (ey  (logtest piece #xff00000000000000)))
         (addpiece id piece index)
         (cond ((not ex)                 (left  id (ash piece  2) (+ index 2)))
               ((and (not e_x) (not ey)) (left  id (ash piece  3) (+ index 3)))
               ((and e_x (not ey))       (left  id (ash piece  5) (+ index 5)))
               (t                        nil))))
     ; save this piece and all right-shifted variants of it
     (right (id piece index)
       (let ((ex  (logtest piece #x0303030303030303))
             (e_x (logtest piece #x0808080808080808))
             (ey  (logtest piece #x00000000000000ff)))
         (addpiece id piece index)
         (cond ((not ex)                 (right id (ash piece -2) (- index 2)))
               ((and (not e_x) (not ey)) (right id (ash piece -3) (- index 3)))
               ((and e_x (not ey))       (right id (ash piece -5) (- index 5)))
               (t                        nil))))
     ; save this piece and all its shifted variants
     (expand (piece)
       (let ((low (find-lowest-bit (cdr piece))))
         (left  (car piece) (cdr piece) low)
         (right (car piece) (cdr piece) low))))

    ; the excluded piece needs a numeric id, and generating ids is a
    ; side-effect of getnum
    (getnum exclude)

    ; find all rotations of all pieces
    (let* ((rotate90 (rotate source))
           (rotate180 (rotate rotate90))
           (rotate270 (rotate rotate180))
           ; a 90/270 degree rotation of the board must be followed by shifting
           ; every piece one space in any direction.  a 0/180 rotation is
           ; okay as-is.
           (lst (append (makepieces source exclude)
                        (makepieces rotate180 exclude)
                        (mapcar #'shift1 (makepieces rotate90 exclude))
                        (mapcar #'shift1 (makepieces rotate270 exclude)))))
      ; now we have each piece in each rotation, find every shifted variant
      (mapc #'expand lst)))

    ; the result is two tables -- a reverse map of number to character ids
    ; and the main lookup table for the solver (as a list, not an array)
    (cons (let ((rev (make-hash-table)))
            (maphash #'(lambda (x y) (setf (gethash y rev) x)) idnums)
            rev)
          (reduce #'cons table :from-end t :initial-value nil))))

(compile 'maketables)

;; solve the puzzle
;; takes as input a solver table generated by maketables and a starting piece
;; and finds all ways of fitting pieces from the table around the starting
;; piece to form a complete board
;; returns a list of proofs--each containing all the pieces that make
;; up a solution
(defun solve (table start)
   (labels (; see if a piece will fit at this spot on the board, and make sure
            ; it hasn't already been used at an earlier spot
            (valid (frame used piece)
              (and (not (logtest used  (car piece)))
                   (not (logtest frame (cdr piece)))))
            ; search for the next empty spot on the board
            (outer (tab pos frame used proof)
              (if (endp tab)
                  ; we made it through the whole board--we have a solution!
                  (list proof)
                  (if (logtest frame pos)
                      ; this spot is already filled--try the next spot
                      (outer (cdr tab) (ash pos 1) frame used proof)
                      ; this spot is empty--call inner to fit a piece here
                      (inner tab pos frame used (car tab) proof))))
            ; search for a piece that will fit at the current spot on the board
            (inner (tab pos frame used lst proof)
              (if (endp lst)
                  ; out of pieces--backtrack
                  nil
                  (if (valid frame used (car lst))
                      ; we have a piece that fits--combine all solutions
                      ; that include this piece and all pieces already placed
                      (append (outer tab pos (logior frame (cdar lst))
                                     (logior used (caar lst))
                                     (cons (car lst) proof))
                              ; also search for other solutions that exclude
                              ; this piece but include all other pieces already
                              ; placed
                              (inner tab pos frame used (cdr lst) proof))
                      ; this piece doesn't fit or it's already been used--try
                      ; all the rest at this spot
                      (inner tab pos frame used (cdr lst) proof)))))
     ; kick off the search
     (outer table 1 (cdr start) 0 (list start))))

(compile 'solve)

;; given a proof (a list of pieces that make up a solution) and a table to
;; translate piece numbers -> piece names, print the solution in a nice form
(defun print-proof (proof table)
  (let ((a (make-string 64 :initial-element #\-)))
    (dolist (piece proof)
      (do ((x 0 (+ x 1)))
          ((= x 64))
          (if (logtest (ash 1 x) (cdr piece))
            (setf (char a x) (gethash (car piece) table)))))
    (do ((x 63 (- x 1)))
        ((< x 0))
        (write-char (char a x))
        (if (zerop (mod x 8)) (terpri))))
  (terpri))

;; given a board, a bitmask representing a piece in a specific location, and
;; the char that identifies that piece, generate and print all possible
;; ways of fitting the other pieces around the special piece
(defun run (in exception exlabel)
  (let ((tables (maketables in exlabel)))
    (mapc #'(lambda (x) (print-proof x (car tables)))
          (solve (cdr tables) (cons 1 exception))))
  t)

;; solve the puzzle outlined in the problem
;; we give as input:
;;   1. the sample false solution (which includes all the pieces)
;;   2. a bitmask showing where piece 3 has to go (lowest bit is bottom-right)
;;   3. the name of the piece that is in a fixed location (3)
(run '("JJJJLLLL"
       "NNsJL3QQ"
       "TNss33Qj"
       "TNNstQQj"
       "TTWtttjj"
       "TWWZZZll"
       "WWSSFZZl"
       "SSSFFFFl")
     #b00000000000000000000001000000011
     #\3)

;; $Id: //info.ravenbrook.com/user/ndl/lisp/contest/entries/russ-ross.lisp#2 $