のんびり座りたい, http://qiita.com/Nabetani/items/4364285801d1c9f370a1

2013-02-02-nonnbiri.lisp

;;;; Last modified: 2013-12-18 20:12:33 tkych


;;====================================================================
;; のんびり座りたい
;;====================================================================
;; - [のんびり座りたい 〜 横へな 2013.2.2](http://nabetani.sakura.ne.jp/hena/ord7selectchair/)
;; - [第7回オフラインリアルタイムどう書くの問題](http://qiita.com/Nabetani/items/4364285801d1c9f370a1)


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

(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:anaphora :cl-ppcre)))

(defpackage :nonnbiri
  (:use :cl)
  (:import-from :anaphora :it :acond)
  (:import-from :cl-ppcre :scan))

(in-package :nonnbiri)


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

(defun parse (input)
  (multiple-value-bind (num-chairs colon-pos) (parse-integer input :junk-allowed t)
    (values num-chairs
            (subseq input (1+ colon-pos)))))

(defun main (input)
  (multiple-value-bind (num-chairs people) (parse input)
    (let ((chairs (make-string num-chairs :initial-element #\-)))
      (loop :with last := (1- num-chairs)
            :for p :across people
            ;; :do (print chairs)  ; for DBG
            :do (if (lower-case-p p)
                    (setf chairs (nsubstitute #\- (char-upcase p) chairs))
                    (acond
                      ((scan "^--" chairs)
                       (setf (char chairs 0) p))

                      ((search "---" chairs)
                       (setf (char chairs (1+ it)) p))
                      
                      ((search "--" chairs)
                       (if (scan "--$" chairs)
                           (setf (char chairs last) p)
                           (setf (char chairs it) p)))

                      ((search "-" chairs)
                       (cond ((scan "^-" chairs)
                              (setf (char chairs 0) p))
                             ((scan "-$" chairs)
                              (setf (char chairs last) p))
                             (t
                              (setf (char chairs it) p)))))))
      chairs)))


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

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

(progn
  (=>? (main "6:NABEbBZn") "-ZAB-E")
  (=>? (main "1:A") "A")
  (=>? (main "1:Aa") "-")
  (=>? (main "2:AB") "AB")
  (=>? (main "2:AaB") "B-")
  (=>? (main "2:AZa") "-Z")
  (=>? (main "2:AZz") "A-")
  (=>? (main "3:ABC") "ACB")
  (=>? (main "3:ABCa") "-CB")
  (=>? (main "4:ABCD") "ADBC")
  (=>? (main "4:ABCbBD") "ABDC")
  (=>? (main "4:ABCDabcA") "-D-A")
  (=>? (main "5:NEXUS") "NUESX")
  (=>? (main "5:ZYQMyqY") "ZM-Y-")
  (=>? (main "5:ABCDbdXYc") "AYX--")
  (=>? (main "6:FUTSAL") "FAULTS")
  (=>? (main "6:ABCDEbcBC") "AECB-D")
  (=>? (main "7:FMTOWNS") "FWMNTSO")
  (=>? (main "7:ABCDEFGabcdfXYZ") "YE-X-GZ")
  (=>? (main "10:ABCDEFGHIJ") "AGBHCIDJEF")
  )

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