与えた条件を満たす候補 in Common Lisp DouKaku?

与えた条件を満たす候補

['and', 'or', 'not', 'and']
のような入力が与えられた場合に、
式 x1 and x2 or not x3 and x4 の値が
Trueとなるような、x1～x4の組み合わせを全て
出力するプログラムを作成してください。
x1～x4には真と偽の2通りの値だけが入るものとします。

Pythonであれば上の入力に対し、
(True, True, True, True)
(True, True, False, True)
(True, False, False, True)
(False, True, False, True)
(False, False, False, True)
と出力します。

andとorの優先順位は同じで左結合性、
つまりa and b or c and dは
(((a and b) or c) and d)
という順番で評価されるものとします。

参考：
d.y.d.

キミならどう書く2.0の小町算問題と似てますが。

このお題はmorchinさんの投稿をもとに作成しました。ご投稿ありがとうございました。
元ネタの充足可能性問題 - Wikipedia は、同じリテラル(x1とかnot x2とか)が複数回出てくることを想定しているので、今回の問題のようにそれぞれ別の変数でだと乗法標準形 - Wikipediaにした場合に、答えが…と色々悩みどころでした。

post comment

Posted feedbacks - Common Lisp

S式に変換するところでめちゃくちゃ苦労した。

(defpackage doukaku43 (:use common-lisp))
(in-package :doukaku43)

(defun make-sexp (operators)
  "入力から式を生成。"
  (labels ((tmp (ops)
             (loop for op in ops
                with i = -1
                appending
                (if (eq op 'not)
                    (list 'not)
                    (list `(nth ,(incf i) l) op)) into lst
                finally
                (return `(,@lst (nth ,(incf i) l)))))
           (parse-not (ops)
             (let ((pos (position 'not ops :from-end t)))
               (if pos
                   (parse-not (replace ops `((not ,(nth (1+ pos) ops)) nil) :start1 pos))
                   (delete nil ops))))
           (infix2prefix (ops)
             (loop for (op x) on (cdr ops) by #'cddr with res = (car ops)
                do (setf res `(,op ,res ,x))
                finally (return res))))
    (infix2prefix (parse-not (tmp operators)))))

;; テスト
(make-sexp '(and or not and))           ; => (AND (OR (AND (NTH 0 L) (NTH 1 L)) (NOT (NTH 2 L))) (NTH 3 L))
(make-sexp '(not not not))              ; => (NOT (NOT (NOT (NTH 0 L))))

(defun func (operators)
  "入力から式を計算する関数を返す。"
  (let ((sexp (make-sexp operators)))
    (lambda (l)
      (declare (special l))
      (eval sexp))))

(defun boolean-combination (n)
  "[t,nil]のN個の全組み合わせ。"
  (cond ((= n 1)
         '((t) (nil)))
        (t
         (let ((it (boolean-combination (1- n))))
           (loop for c in it appending
                `((t ,@c) (nil ,@c)))))))

(defun arity (operators)
  (- (length operators) (count 'not operators) -1))

(defun solve (operators)
  (let ((expr (func operators)))
    (loop for bools in (boolean-combination (arity operators))
       when (funcall expr bools)
       collecting bools)))

(solve '(and or not and))               ; => ((T T T T) (T T NIL T) (NIL T NIL T) (T NIL NIL T) (NIL NIL NIL T))
(solve '(not not not))                  ; => ((NIL))
(solve '())                             ; => ((T))
(solve '(and and and and and and))      ; => ((T T T T T T T))
(solve '(and))                          ; => ((T T))
(solve '(or))                           ; => ((T T) (NIL T) (T NIL))
(solve '(and or))                       ; => ((T T T) (NIL T T) (T NIL T) (NIL NIL T) (T T NIL))

DouKaku?

与えた条件を満たす候補

Posted feedbacks - Common Lisp

Index

Feed

Other

Link

Pathtraq