ビットあみだくじ, http://qiita.com/Nabetani/items/93cde1a6b7561426a3ac

2013-06-01-bit-amida.lisp

;;;; Last modified: 2013-11-24 15:17:19 tkych


;;====================================================================
;; Bit Amida
;;====================================================================

;; [第11回オフラインリアルタイムどう書くの問題](http://qiita.com/Nabetani/items/93cde1a6b7561426a3ac)
;; [ビットあみだくじ 〜 横へな 2013.6.1](http://nabetani.sakura.ne.jp/hena/ord11bitamida/)


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

(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :split-sequence))

(defpackage :bit-amida (:use :cl))

(in-package :bit-amida)


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

;; (parse-input "d6-7b-e1-9e") => (214 123 225 158)
(defun parse-input (input)
  (mapcar (lambda (hex) (parse-integer hex :radix 16))
          (split-sequence:split-sequence #\- input)))

(defun logbitp* (i integer)
  (unless (minusp i)
    (logbitp i integer)))

(defun bits->convertor (bits)
  (lambda (i)
    (let ((left-path-p  (logbitp* (- 8 i) bits))
          (right-path-p (logbitp* (- 7 i) bits)))
      (cond ((and left-path-p (not right-path-p))
             ;; Go left path
             (loop :for j :downfrom (1- i)
                   :while (logbitp* (- 8 j) bits)
                   :finally (return j)))
            ((and (not left-path-p) right-path-p)
             ;; Go right path
             (loop :for j :from (1+ i)
                   :while (logbitp* (- 7 j) bits)
                   :finally (return j)))
            (t i)))))

;; 214 = #b11010110
;; (lex b #b11010110)
;; (lex conv (bits->convertor b))
;; (dotimes (i 9) (format t "~&~D -> ~D" i (funcall conv i)))

(defun main (input)
  (let* ((bits-list  (parse-input input))
         (convertors (mapcar #'bits->convertor bits-list))
         (result     (make-string 9)))
    (loop :for i :from 0 :to 8
          :for j := (reduce (lambda (prev conv) (funcall conv prev))
                            convertors :initial-value i)
          :do (setf (char result j) (digit-char i)))
    result))


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

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

(progn
  (=>? (main "d6-7b-e1-9e") "740631825")
  (=>? (main "83-4c-20-10") "123805476")
  (=>? (main "fb-f7-7e-df") "274056813")
  (=>? (main "55-33-0f-ff") "123456780")
  (=>? (main "00-00-00-00") "012345678")
  (=>? (main "00-00-00-55") "021436587")
  (=>? (main "40-10-04-01") "021436587")
  (=>? (main "00-00-aa-00") "103254768")
  (=>? (main "80-20-08-02") "103254768")
  (=>? (main "ff-7e-3c-18") "876543210")
  (=>? (main "aa-55-aa-55") "351708264")
  (=>? (main "55-aa-aa-55") "012345678")
  (=>? (main "db-24-db-e7") "812543670")
  (=>? (main "00-01-00-40") "021345687")
  (=>? (main "00-00-80-00") "102345678")
  (=>? (main "01-40-00-00") "021345687")
  (=>? (main "00-00-00-02") "012345768")
  (=>? (main "00-00-02-00") "012345768")
  (=>? (main "00-14-00-00") "012436578")
  (=>? (main "00-00-01-40") "021345687")
  (=>? (main "00-80-01-00") "102345687")
  (=>? (main "c8-00-00-81") "120354687")
  (=>? (main "05-48-08-14") "021435687")
  (=>? (main "24-05-00-f0") "413205687")
  (=>? (main "40-08-14-01") "021536487")
  (=>? (main "18-c8-80-80") "210534678")
  (=>? (main "1c-88-52-00") "120564738")
  (=>? (main "ec-dc-67-62") "213468705")
  (=>? (main "0a-b6-60-e9") "035162784")
  (=>? (main "52-d6-c6-c2") "120345678")
  (=>? (main "47-e7-b0-36") "231047658")
  (=>? (main "0f-85-91-aa") "108263754")
  (=>? (main "76-b6-ed-f3") "601435782")
  (=>? (main "f5-5e-f7-3d") "025847163")
  (=>? (main "dd-e7-fb-f9") "610247538")
  (=>? (main "8f-f4-af-fd") "583246017")
  (=>? (main "bf-fb-cb-f7") "105382674")
  (=>? (main "e5-fd-ff-ff") "512046378")
  (=>? (main "ef-df-ef-fe") "713205648")
  (=>? (main "bf-7f-fd-d7") "826437105")
  (=>? (main "36-ff-df-de") "814527603")
  (=>? (main "6f-dd-ff-ff") "230685147")
  )

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