ビットボンバーマン, http://qiita.com/Nabetani/items/709d61dff282cff7a890

2013-03-01-bit-bomberman.lisp

;;;; Last modified: 2013-11-26 20:05:07 tkych


;;====================================================================
;; Bit Bomberman
;;====================================================================

;; - [第8回オフラインリアルタイムどう書くの問題](http://qiita.com/Nabetani/items/709d61dff282cff7a890)
;; - [ビットボンバーマン 〜 横へな 2013.3.1](http://nabetani.sakura.ne.jp/hena/ord8biboma/)


;;--------------------------------------------------------------------

(in-package :cl-user)
(defpackage :bit-bomberman (:use :cl))
(in-package :bit-bomberman)


;;--------------------------------------------------------------------
;; Main
;;--------------------------------------------------------------------

;;=> (parse-input "802b1200/01400c20")
;; #2A((1 1 1 1 1 1 1 1)     ; walls with sentinel
;;     (1 1 0 0 0 0 0 1)
;;     (1 0 0 0 0 1 0 1)
;;     (1 1 0 1 1 0 0 1)
;;     (1 0 1 0 0 1 0 1)
;;     (1 0 0 0 0 0 0 1)
;;     (1 1 1 1 1 1 1 1)),
;; #2A((0 0 0 0 0 0)         ; bombs
;;     (0 1 0 1 0 0)
;;     (0 0 0 0 0 0)
;;     (0 0 1 1 0 0)
;;     (0 0 1 0 0 0)),
;; #2A((0 0 0 0 0 0)         ; bombs -> blast
;;     (0 1 0 1 0 0)
;;     (0 0 0 0 0 0)
;;     (0 0 1 1 0 0)
;;     (0 0 1 0 0 0))
(defun parse-input (input)
  (let ((wall-bits (parse-integer input :end 8 :radix 16))
        (bomb-bits (parse-integer input :start 9 :radix 16)))
    (flet ((to-grid (bits)
             (let ((grid (make-array '(5 6) :element-type 'bit :initial-element 0)))
               (dotimes (row 5)
                 (dotimes (col 6)
                   (when (logbitp (- 31 (* 6 row) col) bits)
                     (setf (sbit grid row col) 1))))
               grid))
           (to-grid-with-sentinel (bits)
             (let ((grid (make-array '(7 8) :element-type 'bit :initial-element 1)))
               (dotimes (row 5)
                 (dotimes (col 6)
                   (unless (logbitp (- 31 (* 6 row) col) bits)
                     (setf (sbit grid (1+ row) (1+ col)) 0))))
               grid)))
      (values (to-grid-with-sentinel wall-bits)
              (to-grid bomb-bits)
              (to-grid bomb-bits)))))

(defun main (input)
  (multiple-value-bind (walls bombs blast) (parse-input input)
    (dotimes (row 5)
      (dotimes (col 6)
        (when (bomb-exists-p row col bombs)
          (explode row col blast walls))))
    (to-hex-string blast)))

(defun bomb-exists-p (row col bombs)
  (= 1 (sbit bombs row col)))

(defun wall-exists-p (row col walls)
  (= 1 (sbit walls (1+ row) (1+ col))))

(defun blow-up (row col blast)
  (setf (sbit blast row col) 1))

(defun explode (row col blast walls)
  (loop :with col+ := (1+ col)
        :with col- := (1- col)
        :with row+ := (1+ row)
        :with row- := (1- row)
        :do ;; Horizontal+
            (unless (eq col+ :wall)
              (if (wall-exists-p row col+ walls)
                  (setf col+ :wall)
                  (progn
                    (blow-up row col+ blast)
                    (incf col+))))
            ;; Horizontal-
            (unless (eq col- :wall)
              (if (wall-exists-p row col- walls)
                  (setf col- :wall)
                  (progn
                    (blow-up row col- blast)
                    (decf col-))))
            ;; Vertical+
            (unless (eq row+ :wall)
              (if (wall-exists-p row+ col walls)
                  (setf row+ :wall)
                  (progn
                    (blow-up row+ col blast)
                    (incf row+))))
            ;; Vertical-
            (unless (eq row- :wall)
              (if (wall-exists-p row- col walls)
                  (setf row- :wall)
                  (progn
                    (blow-up row- col blast)
                    (decf row-))))
        :until (and (eq col+ :wall) (eq col- :wall)
                    (eq row+ :wall) (eq row- :wall))))

(defun to-hex-string (bit-array)
  (let ((hex 0))
    (dotimes (i 30)
      (when (= 1 (row-major-aref bit-array i))
        (setf (ldb (byte 1 (- 31 i)) hex) 1)))
    (format nil "~(~8,'0X~)" hex)))


;;--------------------------------------------------------------------
;; Tests
;;--------------------------------------------------------------------

(defun =>? (got want)
  (assert (string= got want)))

(progn
  (=>? (main "802b1200/01400c20") "53c40cfc")
  (=>? (main "28301068/84080504") "d64fef94")
  (=>? (main "100a4010/80010004") "e241850c")
  (=>? (main "81020400/000000fc") "0e3cfbfc")
  (=>? (main "80225020/7e082080") "7fdd24d0")
  (=>? (main "01201200/40102008") "fe1861fc")
  (=>? (main "00201000/01000200") "43c48f08")
  (=>? (main "00891220/81020408") "ff060c1c")
  (=>? (main "410033c0/0c300000") "3cf0c000")
  (=>? (main "00000000/01400a00") "7bf7bf78")
  (=>? (main "00000000/20000a00") "fca2bf28")
  (=>? (main "00000000/00000000") "00000000")
  (=>? (main "00cafe00/00000000") "00000000")
  (=>? (main "aaabaaaa/50000000") "51441040")
  (=>? (main "a95a95a8/56a56a54") "56a56a54")
  (=>? (main "104fc820/80201010") "ea30345c")
  (=>? (main "4a940214/05000008") "05000008")
  (=>? (main "00908000/05000200") "ff043f48")
  (=>? (main "00c48c00/fe1861fc") "ff3873fc")
  (=>? (main "00000004/81020400") "fffffff0")
  (=>? (main "111028b0/40021100") "e08fd744")
  (=>? (main "6808490c/01959000") "17f7b650")
  (=>? (main "30821004/81014040") "c75de5f8")
  (=>? (main "0004c810/10003100") "fe4937c4")
  (=>? (main "12022020/88200000") "edf08208")
  (=>? (main "2aa92098/01160000") "45165964")
  (=>? (main "00242940/10010004") "fc43c43c")
  (=>? (main "483c2120/11004c00") "33c3de10")
  (=>? (main "10140140/44004a04") "eda3fe3c")
  (=>? (main "0c901d38/72602200") "f36da280")
  )


;;====================================================================