テトロミノ認識, http://nabetani.sakura.ne.jp/hena/ord4tetroid/

2012-10-06-tetorominoes.lisp

;;;; Last modified: 2013-12-27 20:02:07 tkych


;;====================================================================
;; テトロミノ認識
;;====================================================================
;; - [テトロミノ認識 〜 横へな 2012.10.6](http://nabetani.sakura.ne.jp/hena/ord4tetroid/)


;;--------------------------------------------------------------------
;; Package
;;--------------------------------------------------------------------

(in-package :cl-user)
(defpackage :tetromino (:use :cl))
(in-package :tetromino)


;;--------------------------------------------------------------------
;; Utils
;;--------------------------------------------------------------------

(defun group (n lst)
  (when (zerop n) (error "zero length"))
  (labels ((rec (lst acc)
             (let ((rest (nthcdr n lst)))
               (if (consp rest)
                   (rec rest (cons (subseq lst 0 n)
                                   acc))
                   (nreverse (cons lst acc))))))
    (if lst (rec lst nil) nil)))


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

(defparameter *tetrominoes*
  (let ((ht (make-hash-table :test #'equal)))
    (loop :for (finger tetromino)
          :in '( ;; L
                ("01,10,20" "L") ("10,2-1,20" "L")
                ("10,11,12" "L") ("01,02,12" "L")
                ("10,20,21" "L") ("1-2,1-1,10" "L")
                ("01,11,21" "L") ("01,02,10" "L")
                ;; I
                ("01,02,03" "I") ("10,20,30" "I")
                ;; O
                ("01,10,11" "O")
                ;; T
                ("10,11,20" "T") ("1-1,10,11" "T")
                ("1-1,10,20" "T") ("01,02,11" "T")
                ;; S
                ("01,11,12" "S") ("1-1,10,2-1" "S")
                ("01,1-1,10" "S") ("10,11,21" "S")
                )
          :do (setf (gethash finger ht) tetromino))
    ht))

;; "07,17,06,05" -> ((0 7) (1 7) (0 6) (0 5))
(defun parse (input)
  (group 2 (map 'list #'digit-char-p (remove #\, input))))

;; ((0 7) (1 4) (0 6) (0 5)) -> ((0 5) (0 6) (0 7) (1 4))
(defun sort-by-x-y (coords)
  (stable-sort (sort coords #'< :key #'second)
               #'< :key #'first))

(defun parallel-to-up-left (input)
  (destructuring-bind (origin . xs) (sort-by-x-y (parse input))
    (format nil "~{~{~A~}~^,~}"
            (mapcar (lambda (x) (mapcar #'- x origin))
                    xs))))

(defun main (input)
  (nth-value 0 (gethash (parallel-to-up-left input)
                        *tetrominoes* "-")))


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

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

(progn
  (=>? (main "55,55,55,55") "-")
  (=>? (main "07,17,06,05") "L")
  (=>? (main "21,41,31,40") "L")
  (=>? (main "62,74,73,72") "L")
  (=>? (main "84,94,74,75") "L")
  (=>? (main "48,49,57,47") "L")
  (=>? (main "69,89,79,68") "L")
  (=>? (main "90,82,91,92") "L")
  (=>? (main "13,23,03,24") "L")
  (=>? (main "24,22,25,23") "I")
  (=>? (main "51,41,21,31") "I")
  (=>? (main "64,63,62,65") "I")
  (=>? (main "49,69,59,79") "I")
  (=>? (main "12,10,21,11") "T")
  (=>? (main "89,99,79,88") "T")
  (=>? (main "32,41,43,42") "T")
  (=>? (main "27,16,36,26") "T")
  (=>? (main "68,57,58,67") "O")
  (=>? (main "72,62,61,71") "O")
  (=>? (main "25,24,15,14") "O")
  (=>? (main "43,54,53,42") "S")
  (=>? (main "95,86,76,85") "S")
  (=>? (main "72,73,84,83") "S")
  (=>? (main "42,33,32,23") "S")
  (=>? (main "66,57,67,58") "S")
  (=>? (main "63,73,52,62") "S")
  (=>? (main "76,68,77,67") "S")
  (=>? (main "12,11,22,01") "S")
  (=>? (main "05,26,06,25") "-")
  (=>? (main "03,11,13,01") "-")
  (=>? (main "11,20,00,21") "-")
  (=>? (main "84,95,94,86") "-")
  (=>? (main "36,56,45,35") "-")
  (=>? (main "41,33,32,43") "-")
  (=>? (main "75,94,84,95") "-")
  (=>? (main "27,39,28,37") "-")
  (=>? (main "45,34,54,35") "-")
  (=>? (main "24,36,35,26") "-")
  (=>? (main "27,27,27,27") "-")
  (=>? (main "55,44,44,45") "-")
  (=>? (main "70,73,71,71") "-")
  (=>? (main "67,37,47,47") "-")
  (=>? (main "43,45,41,42") "-")
  (=>? (main "87,57,97,67") "-")
  (=>? (main "49,45,46,48") "-")
  (=>? (main "63,63,52,72") "-")
  (=>? (main "84,86,84,95") "-")
  (=>? (main "61,60,62,73") "-")
  (=>? (main "59,79,69,48") "-")
  (=>? (main "55,57,77,75") "-")
  )

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