Парсер логических выражений (генерация таблицы истинности)

Я связываюсь с вами, потому что в настоящее время мне необходимо проанализировать (что можно записать как) логическое выражение, чтобы сказать, какие члены должны быть 1 или нет.

Чтобы прояснить тему, вот пример. У меня есть это уравнение:

equ = ((((SIPROT:1 INTERACT (((((((ACTIVE_drawing OR ACTIVE_hd) OR ACTIVE_dm) OR PDIFF_drawing) OR NDIFF_drawing) NOT polyact_sign_mkr) NOT ((COPY (NWELL_drawing OR NWELL_hd)) AND (((((ACTIVE_drawing OR ACTIVE_hd) OR ACTIVE_dm) OR PDIFF_drawing) OR NDIFF_drawing) NOT polyact_sign_mkr))) NOT ((COPY (PPLUS_drawing OR PPLUS_hd)) OR (COPY ((NPLUS_drawing OR NPLUS_dm) OR NPLUS_hd))))) INSIDE RHDMY_drawing) INTERACT ((((COPY ((NPLUS_drawing OR NPLUS_dm) OR NPLUS_hd)) AND (((((ACTIVE_drawing OR ACTIVE_hd) OR ACTIVE_dm) OR PDIFF_drawing) OR NDIFF_drawing) NOT polyact_sign_mkr)) INTERACT (N(((((ACTIVE_drawing OR ACTIVE_hd) OR ACTIVE_dm) OR PDIFF_drawing) OR NDIFF_drawing) NOT polyact_sign_mkr) INTERACT ((COPY (PPLUS_drawing OR PPLUS_hd)) AND (((((ACTIVE_drawing OR ACTIVE_hd) OR ACTIVE_dm) OR PDIFF_drawing) OR NDIFF_drawing) NOT polyact_sign_mkr)))) NOT NLDEMOS_FINAL)) OUTSIDE (COPY GO2_25_drawing))

Это описание уравнения формы, включающее рисунок нескольких других, нарисованных разными «цветами».

Итак, входными данными моего уравнения являются «цвета», например, ACTIVE_drawing. Моя цель состоит в том, чтобы сказать, имея это уравнение, какие цвета являются обязательными, запрещенными или необязательными, чтобы иметь equ=1. Вот почему я говорю о таблице истинности.

Уравнение на самом деле не является логическим, но его можно обработать. INTERACT можно заменить на AND, COPY можно удалить и, возможно, потребуются другие операции.

Итак, мой вопрос заключается не в том, чтобы заменить мое уравнение, чтобы иметь «настоящее логическое», а в алгоритме, который нужно реализовать, чтобы правильно проанализировать логическое выражение и получить соответствующую таблицу истинности.

У вас есть какие-нибудь намеки на это? Я работаю в Perl над созданием уравнения, поэтому я хотел бы сохранить его, но если вы знаете другой инструмент, который мог бы использовать мой ввод для его обработки, почему бы и нет.


parsing boolean equation perl truthtable
person Sylvain Trx    schedule 30.04.2015    source источник
comment
Используйте модуль CPAN для синтаксического анализа, например Parse :: RecDescent ‹metacpan.org/pod/Parse::RecDescent ›. Вы не можете разобрать язык, допускающий неограниченное вложение, с помощью одних только регулярных выражений. Для этого требуется токенизатор и стек для отслеживания уровней.   -  person shawnhcorey    schedule 30.04.2015
comment
P :: RD работает довольно медленно. Я слышал хорошие отзывы о Марпе. Хотя сам никогда не использовал.   -  person ikegami    schedule 30.04.2015
comment
Спасибо, ребята, посмотрю на редизайн.   -  person Sylvain Trx    schedule 30.04.2015
comment
Что такое ((X AND B) NOT C); есть ли там подразумеваемое AND? Как в ((X AND B) AND NOT C)?   -  person Kaz    schedule 15.12.2015
comment
Это «уравнение» описывает геометрические операции. X, B и C - формы. Вы создаете новую форму, комбинируя B и X, и еще одну, вычитая C из этой последней. Не уверен, ясно ли я. Вы можете взглянуть на язык SVRF графики наставника, если вам интересно. Пока   -  person Sylvain Trx    schedule 17.12.2015
comment
См. Мой SO-ответ о том, как создать парсер: stackoverflow.com/questions/2245962/ Он также включает способ оценивать выражения.   -  person Ira Baxter    schedule 20.12.2015

Ответы (2)


arrow_upward
0
arrow_downward

Решение в TXR Lisp версии 128.

Интерактивный пробег:

$txr -i truth.tl 
1> (parse-infix '(a and b or c and d))
(or (and a b)
  (and c d))
2> (pretty-truth-table '(a))
    a   | a
--------+--
    F   | F
    T   | T
nil
    a   | not a
--------+------
    F   |   T  
    T   |   F  
nil
4> (pretty-truth-table '(a and t))
    a   | a and t
--------+--------
    F   |    F   
    T   |    T   
nil
5> (pretty-truth-table '(a and nil))
    a   | a and nil
--------+----------
    F   |     F    
    T   |     F    
nil
6> (pretty-truth-table '(a and b))
    a     b   | a and b
--------------+--------
    F     F   |    F   
    F     T   |    F   
    T     F   |    F   
    T     T   |    T   
nil
7> (pretty-truth-table '(a -> b))
    a     b   | a -> b
--------------+-------
    F     F   |   T   
    F     T   |   T   
    T     F   |   F   
    T     T   |   T   
nil
8> (pretty-truth-table '(a or b))
    a     b   | a or b
--------------+-------
    F     F   |   F   
    F     T   |   T   
    T     F   |   T   
    T     T   |   T   
nil
9> (pretty-truth-table '(a and b or c and d))
    a     b     c     d   | a and b or c and d
--------------------------+-------------------
    F     F     F     F   |         F         
    F     F     F     T   |         F         
    F     F     T     F   |         F         
    F     F     T     T   |         T         
    F     T     F     F   |         F         
    F     T     F     T   |         F         
    F     T     T     F   |         F         
    F     T     T     T   |         T         
    T     F     F     F   |         F         
    T     F     F     T   |         F         
    T     F     T     F   |         F         
    T     F     T     T   |         T         
    T     T     F     F   |         T         
    T     T     F     T   |         T         
    T     T     T     F   |         T         
    T     T     T     T   |         T         
nil

Код в truth.tl:

;; auto-incrementing precedence level
(defvarl prec-level 0)

;; symbol to operator definition hash
(defvarl ops (hash))

;; operator definition structure
(defstruct operator nil
  sym                           ;; operator symbol
  (assoc :left)                 ;; associativity: default left
  (arity 2)                     ;; # of arguments: 1 or 2; default 2.
  (prec 0)                      ;; precedence: if zero, automatically assign.

  (:postinit (self)             ;; post-construction hook
    (set [ops self.sym] self)   ;; register operator in hash
    (if (zerop self.prec)       ;; assign precedence if necessary
      (set self.prec (inc prec-level)))))

;; define operators
(new operator sym '->)
(new operator sym 'or)
(new operator sym 'and)
(new operator sym 'not assoc :right arity 1)

;; conditional function
(defun -> (a b)
  (or (not a) b))

;; parse infix to prefix
;; https://en.wikipedia.org/wiki/Shunting-yard_algorithm
(defun parse-infix (expr)
  (let (nodestack opstack)
    (flet ((add-node (oper)
              (caseql oper.arity
                (1 (push (list oper.sym
                               (pop nodestack)) nodestack))
                (2 (let ((y (pop nodestack))
                         (x (pop nodestack)))
                     (push (list oper.sym x y) nodestack))))))
      (each ((tok expr))
        (condlet
          (((o1 [ops tok]))
           (whilet ((o2 (first opstack))
                    (yes (when o2 (caseq o2.assoc
                                    (:left  (>= o2.prec o1.prec))
                                    (:right (>  o2.prec o1.prec))))))
             (pop opstack)
             (add-node o2))
           (push o1 opstack))
          (((c (consp tok)))
           (push (parse-infix tok) nodestack))
          (t (push tok nodestack))))
      (whilet ((o2 (first opstack)))
        (pop opstack)
        (add-node o2)))
    (first nodestack)))

;; extract leaf terms from expression
(defun terms-of (prefix)
  (if (atom prefix)
    (list prefix)
    [mappend terms-of (rest prefix)]))

;; generate truth table materials
(defun truth-table (prefix)
  (let* ((vars (uniq [keep-if 'bindable (terms-of prefix)]))
         (truths (rperm '(nil t) (length vars)))
         (fun (eval ^(lambda (,*vars) ,prefix)))
         (expr-truths [mapcar (apf fun) truths]))
    (list vars truths expr-truths)))

;; overridable column width
(defvar *col-width* 5)

;; parse infix, generate truth table and format nicely
(defun pretty-truth-table (infix-expr : (stream *stdout*))
  (tree-bind (vars truths expr-truths) (truth-table (parse-infix infix-expr))
    (let ((cols (length vars))
          (cw *col-width*)
          (infix-expr-str `@{infix-expr}`))
      ;; header
      (each ((v vars))
        (put-string `@{v (- cw)} ` stream))
      (put-string "  | " stream)
      (put-line infix-expr-str stream)
      (each ((v vars))
        (put-string `------` stream))
      (put-line `--+-@{(repeat "-" (length infix-expr-str)) ""}` stream)
      (each ((vr truths)
             (et expr-truths))
        (each ((vt vr))
          (put-string `@{(if vt "T" "F") (- cw)} ` stream))
        (put-string "  | " stream)
        (format stream "~^*a\n" (length infix-expr-str) (if et "T" "F"))))))
person Kaz    schedule 20.12.2015
comment
Привет @kaz и спасибо за ваш комментарий. Благодаря вашему сообщению у меня будет стажер, который будет работать над этой темой, и мы будем использовать ваш код для начала. Извините, я не ответил ранее, но до сих пор мне нечего было обсуждать. С уважением, Сильвен - person Sylvain Trx; 03.04.2017

arrow_upward
0
arrow_downward

Я знаю, что это старый вопрос, но вы можете попробовать https://logic.lerax.me. Источник доступен как открытый исходный код, и если вы используете quicklisp + ultralisp, вы можете сделать это следующим образом:

(ql-dist:install-dist "http://dist.ultralisp.org" :replace t :prompt nil)
(ql:quickload :lisp-inference)
(inference:truth-infix ((p ^ q) => r))

; +------------------------------------------------+
; |  P  |  Q  |  R  |  (P ^ Q)  |  ((P ^ Q) => R)  |
; +------------------------------------------------+
; |  T  |  T  |  T  |     T     |        T         |
; |  T  |  T  |  F  |     T     |        F         |
; |  T  |  F  |  T  |     F     |        T         |
; |  T  |  F  |  F  |     F     |        T         |
; |  F  |  T  |  T  |     F     |        T         |
; |  F  |  T  |  F  |     F     |        T         |
; |  F  |  F  |  T  |     F     |        T         |
; |  F  |  F  |  F  |     F     |        T         |
; +------------------------------------------------+

Отказ от ответственности: я являюсь автором системы вывода Lisp.

person Manoel Vilela    schedule 04.03.2019