atcoder-q001-c.clj

atcoder-q001-c.clj

;; AtCoder 過去問 : 001-C 【パズルのお手伝】
;; http://arc001.contest.atcoder.jp/tasks/arc001_3

(use '[clojure.set :only (difference)])
(use '[clojure.math.combinatorics :only (permutations)])

(def ^{:private true} r8 (range 1 9))

(defn accession-pos-set
  "座標 x y に置かれた Q の利き筋列挙"
  [[x y]]
  (->> (concat (map #(list x %) r8)
               (map #(list % y) r8)
               (->> (map #(list (+ x %) (+ y %)) r8)
                    (take-while (fn [[x y]] (and (<= x 8) (<= y 8)))))
               (->> (map #(list (- x %) (+ y %)) r8)
                    (take-while (fn [[x y]] (and (> x 0) (<= y 8)))))
               (->> (map #(list (+ x %) (- y %)) r8)
                    (take-while (fn [[x y]] (and (<= x 8) (> y 0)))))
               (->> (map #(list (- x %) (- y %)) r8)
                    (take-while (fn [[x y]] (and (> x 0) (> y 0))))))
       (into #{})))

(defn init-grid
  [& args]
  (->> (loop [[pos & args] args
              grid (into #{} (for [x r8, y r8] [x y]))]
         (cond (not pos) grid
               (not (grid pos)) (throw (Exception. "No Answer"))
               :else (recur args
                            (difference grid (accession-pos-set pos)))))
       (group-by second)
       (map (fn [[k v]] [k (map first v)]))
       (into (apply sorted-map (mapcat (fn [[x y]] [y (list x)]) args)))))

(defn correct?
  "斜めチェック"
  [xs]
  (loop [[x & xs] xs, s1 #{}, s2 #{}]
    (cond
     (not x) true
     (or (s1 x) (s2 x)) false
     :else (recur xs
                  (into #{} (map inc (conj s1 x)))
                  (into #{} (map dec (conj s2 x)))))))

(defn- perms
  [coll & args]
  (let [xs (into #{} (map first args))
        coll (remove xs coll)]
    (->> (permutations coll)
         (map (fn [xs] (reduce (fn [c [x y]]
                                 (let [[a b] (split-at (dec y) c)]
                                   (concat a (cons x b))))
                               xs
                               args))))))
(defn q001-c*
  [& args]
  (let [xss (map #(into #{} (second %)) (apply init-grid args))]
    (or (->> (apply perms r8 args)
             (filter (fn [xs] (every? (complement nil?) (map #(%1 %2) xss xs))))
             (filter correct?)  ; 不要？
             first)
        (throw (Exception. "No Answer2")))))

(defn read-input
  []
  (->> [r8 (repeatedly read-line)]
       (apply mapcat (fn [y s] (map (fn [x c] [c x y]) r8 s)))
       (filter #(-> % first (= \Q)))
       (map rest)))

(defn to-grid
  [xs]
  (let [s-join clojure.string/join
        to-line (fn [n]
                    (s-join (concat (repeat (dec n) \.)
                                    "Q"
                                    (repeat (- 8 n) \.))))]
    (s-join \newline (map to-line xs))))

(defn q001-c
  []
  (println
   (try
     (->> (read-input) (apply q001-c*) to-grid)
     (catch Exception e (.getMessage e)))))

;;-------------------------------------------------------
;; 以下動作テスト
;;-------------------------------------------------------
(defn run-test
  [f & args]
  (with-in-str (apply str (interpose "\n" args))
    (f)))

(do
  (println "【出力1】")
  (time (run-test q001-c
                  "........"
                  "........"
                  ".......Q"
                  "........"
                  "..Q....."
                  "........"
                  ".Q......"
                  "........"))

  (println "\n【出力2】")
  (time (run-test q001-c
                  ".....Q.."
                  ".Q......"
                  "........"
                  "........"
                  "........"
                  "Q......."
                  "........"
                  "........")))

;; ------------------------------------------
;;結果

;; 【出力1】
;; Q.......
;; ....Q...
;; .......Q
;; .....Q..
;; ..Q.....
;; ......Q.
;; .Q......
;; ...Q....
;; "Elapsed time: 11.903266 msecs"

;; 【出力2】
;; No Answer
;; "Elapsed time: 1.493405 msecs"