kozima の日記

パズル解いてみた

17:41

http://d.hatena.ne.jp/lkozima/20111125/1322209841 の実装というか，適当にコード書いて確認しました的な。

どう書く？.org で似たような問題を見たことはあって，似たような解法も見たことがあって，そのときにはわかったようなわからないような感じだったけど，やってみたら少し感覚がつかめたのかもしれない。

;; p ::= !A | !B | KA p | KB p | not p
(defun satisfies (w m n p)
  (cond ((eql p '!A)
         (= 1 (loop for (i . j) in w count (= (* i j) (* m n)))))
        ((eql p '!B)
         (= 1 (loop for (i . j) in w count (= (+ i j) (+ m n)))))
        (t
         (ecase (car p)
           (KA (loop for (i . j) in w
                  always (or (/= (* i j) (* m n))
                             (satisfies w i j (cadr p)))))
           (KB (loop for (i . j) in w
                  always (or (/= (+ i j) (+ m n))
                             (satisfies w i j (cadr p)))))
           (not (not (satisfies w m n (cadr p))))))))

(defun filter (w p)
  (remove-if-not (lambda (x) (satisfies w (car x) (cdr x) p)) w))

;; m + n < 14 なら mn < 49 だから，48 まででよい気がする
(let* ((w0 (loop for m from 2 to 48 nconc
               (loop for n from m to (/ 48 m) collect (cons m n))))
       (w1 (filter w0 '(KB (not !A))))
       (w2 (filter w1 '(not !A)))
       ;; ここは論理式で書けてない
       (w3 (remove-if-not (lambda (x) (< (+ (car x) (cdr x)) 14)) w2))
       (w4 (filter w3 '!A))
       (w5 (filter w4 '!B)))
  w5)