1

我只是在捕获生成的真值表上的条件的循环上有一个小问题。所以你输入一个逻辑表达式然后它把它变成一个真值表，它还解释它是有效的、无效的还是不一致的。到目前为止，这是解释它的程序的一部分，但它只捕获无效或有效......你能指导我吗？谢谢

*edit// 所以程序是这样运行的：

*******欢迎！********

键入 (LogicStart) 开始或 (exit) 随时退出。

;; 加载文件 MyLogic.lisp

T [2]> (LogicStart) 输入逻辑表达式或公式：“(p^(~p))”

p (~p) (p^(~p))
T 无 无

无 无

公式无效

所以输入只是一个逻辑表达式，那么输出就是那个表达式的真值表......并且也可以解释它，但是我的代码只有两种解释：无效或有效（重言式），因为上面的例子应该是不一致/无法满足（因为对公式/表达式的所有解释都是错误的）

结束编辑

(defun interpret() ; interpret if valid or not or inconsistent
(setq lastcolumn (- (column) 1))
(setq lastcolumnROW 1)
(loop   
    (unless (aref (aref tbl lastcolumn) lastcolumnROW) (progn (princ "The formula is Invalid")(return)))

    (setq lastcolumnROW (+ lastcolumnROW 1))
    (when (= lastcolumnROW (+ 1 (row))) (progn (princ "The formula is a Tautology ") (return)))
)
)

编辑两个：///

这是 LogicStart 函数：

(defun LogicStart()  
;Function to run program

(princ "Enter Logical Expression or Formula: " )
(setq input (read))
;Get input

(format t "-----------------------------------------------~C" #\linefeed)

;Create two dimension array(table)
(setq tbl (make-array (column)))
(setq index 0)
(loop 
    (setf (aref tbl index) (make-array  (+ (row) 1)))   
    (setq index (+ 1 index))
    (when (= index (column))(return))
)

(setAtoms)
(setFirstValue)
(tblReplaceValue)
(watchTable)
(format t "-----------------------------------------------~C" #\linefeed)
(interpret)
)

setAtoms 功能：

(defun setAtoms()
;Get ALL possible formula

(setq indexOFTBL (make-array (column)))

(setq openP (make-array (- (column) (length Latoms))))
; Get index of open Parenthesis

(setq cOpenP 0) 
(setq closeP (make-array (- (column) (length Latoms))))
;Get index of close Parenthesis

(setq cCloseP 0) 
(setq index 0)
(loop
    (when (char-equal (char input index) #\() 
        (progn
            (setf (aref openP cOpenP) index)
            (setq cOpenP (+ 1 cOpenP))
        )
    )
    (when (char-equal (char input index) #\)) 
        (progn
            (setf (aref closeP cCloseP) index)
            (setq cCloseP (+ 1 cCloseP))
        )
    )
    (setq index (+ 1 index))
    (when (= index (length input)) (return))
)
;(print openP)

;(print closeP)
(setq index 0)
(loop
    (if (< index (length Latoms))
        (progn
            (setf (aref (aref tbl index) 0) (char Latoms index))
            (setf (aref indexOFTBL index) index)
        )
        (progn
            (setq OpIndex cOpenP)
            (loop
                (setq OpIndex (- OpIndex 1))
                (setq CpIndex 0)
                (loop
                    (if (or (> (aref openP OpIndex) (aref closeP CpIndex)) (= -1 (aref closeP CpIndex)))
                        (progn 
                            (setq CpIndex (+ CpIndex 1))
                        )
                        (progn
                            (setf (aref (aref tbl index) 0) (subseq input (aref openP OpIndex) (+ 1 (aref closeP CpIndex))))
                            (setf (aref closeP CpIndex) -1)
                            (return)
                        )
                    )
                    (when (= CpIndex (length closeP))(return))
                )
                (setq index (+ index 1))
                (when (= OpIndex 0) (return))
            )
            (return)
        )
    )
    (setq index (+ index 1))
    (when (= index (column)) (return))
)
)

watchTable 和列函数

(defun watchTable()
; View table

(setq ro 0)
(loop
    (setq co 0)
    (loop
        (princ(aref (aref tbl co) ro))(format t "~C" #\tab)
        (setq co (+ 1 co))
        (when (= co (column))(return))
    )
    (format t "~C" #\linefeed)
    (setq ro (+ 1 ro))
    (when (= ro (+ (row) 1))(return))
)
)


(defun column()
; Get the number of columns
(+ (atoms) (symbols))
)

//edit 3 所以对于 (OR A (NOT A))，@jkiiski 的代码中的表格缺少“not A”

A   |   NOT A  |  (OR A (NOT A))
----+----------+--------
NIL |    T     |   T  
T   |   NIL    |   T  
This expression is a Tautology.

另一个参考示例：虽然 P 隐含 Q，但此代码接受的隐含为：>

 ; Logical Connectives:
 ; ~ negation
 ; - biconditional
 ; > conditional
 ; ^ and
 ; v or

; Example Input:
;   "(~((a^b)>c))"
;   "(p>q)"

p   q      p>q
T   T       T 
T   NIL    NIL 
NIL T       T
NIL NIL     T

Another example:
Enter an expression: "((p>q)^r)"
T <- True 
NIL <- False
--------------------------------------------
p   q   r   (p>q)   ((p>q)^r)   
T   T   T    T         T    
T   T   NIL  T        NIL   
T   NIL T    NIL      NIL   
T   NIL NIL  NIL      NIL   
NIL T   T    T         T    
NIL T   NIL  T        NIL   
NIL NIL T    T         T    
NIL NIL NIL  T        NIL   
--------------------------------------------

所以它在 (p>q)^r 中显示 p, q, r, (p>q) 最后在真值表上显示 (p>q)^r..

编辑四//

(defun generate-value-combinations (variables)
(let ((combinations (list)))
(labels ((generate (variables &optional (acc (list)))
           (if (endp variables)
               (push (reverse acc) combinations)
               (loop for value in '(t nil)
                     for var-cell = (cons (car variables) value)
                     do (generate (cdr variables) (cons var-cell acc))))))
  (generate variables)
  combinations)))

to this one?
(defun generate-value-combinations (variables)
(let ((combinations (list)))
(labels ((generate (variables &optional (acc (list)))
           (if (endp variables)
               (push (reverse acc) combinations)
               (loop for value in '(t nil)
                     for var-cell = (cons (car variables) value)
                     do (generate (cdr variables) (cons var-cell acc))))))
  (generate variables) nreverse combinations)))
4

2 回答 2

1

Coredump 已经给出了答案，我使用了他/她的解决方案作为其中的一部分（稍作修改），但是由于您的代码不是很简洁，我想我会展示另一个用于学习目的的解决方案。这写得相当快，所以请随时指出所有愚蠢的错误......

在这段代码中，我假设您希望使用通常的 Lisp 语法（如(and a (or b c))）给出逻辑表达式。

让我们从一个函数开始，提取表达式中使用的所有变量。我假设所有不是逻辑运算符（、、或AND）OR的东西都是变量。这需要一个列表作为参数，并使用递归函数 ( ) 遍历它，将所有不是运算符的原子收集到一个列表 ( ) 中。列表最终反转并返回。>NOTEXTRACTVARIABLES

(defun extract-variables (input)
  (let ((variables (list)))
    (labels ((extract (input)
               (if (atom input)
                   (unless (member input '(and or not > -))
                     ;; PUSHNEW only pushes variables that haven't
                     ;; already been added to the list.
                     (pushnew input variables))
                   ;; If INPUT is a list, use MAPC to apply EXTRACT
                   ;; to all its elements.
                   (mapc #'extract input))))
      (extract input)
      (nreverse variables))))

你应该注意的事情是：

  1. 局部变量应该使用LET而不是定义SETQ。
  2. 局部函数是使用定义的LABELS。

您可以测试该功能：

CL-USER> (extract-variables '(and a (or b c (not a))))
(A B C)

接下来，让我们编写一个函数来为这些变量生成所有可能的值组合。为简单起见，我们将使用关联列表的列表来保存变量。关联列表是由键值对组成的列表。例如：

((A . T) (B . T))

您可以使用ASSOC在关联列表中查找元素。它将返回整个对，因此您通常需要使用CDR来获取值：

CL-USER> (cdr (assoc 'b '((a . nil) (b . t))))
T

所以我们希望表达式的值组合列表(AND A B)看起来像这样：

(((A . T) (B . T))
 ((A . T) (B . NIL) ; (B . NIL) would usually be printed (B)
 ((A . NIL) (B . T))
 ((A . NIL) (B . NIL)))

因此，这是实现此目的的功能：

(defun generate-value-combinations (variables)
  (let ((combinations (list)))
    (labels ((generate (variables &optional (acc (list)))
               (if (endp variables)
                   (push (reverse acc) combinations)
                   (loop for value in '(nil t)
                         for var-cell = (cons (car variables) value)
                         do (generate (cdr variables) (cons var-cell acc))))))
      (generate variables)
      combinations)))

我使用了与前一个函数相同的递归模式。内部函数将变量值累积到可选参数ACC中，当到达变量列表的末尾时，累积的关联列表被推送到COMBINATIONS. 颠倒 alist 以保持给定变量的顺序相同。我们现在可以对其进行测试：

CL-USER> (generate-value-combinations '(a b))
(((A) (B)) ((A) (B . T)) ((A . T) (B)) ((A . T) (B . T)))

接下来，我们需要一个函数来使用其中一个列表中的变量值来评估表达式。我们可以使用递归评估器轻松做到这一点：

(defun evaluate (input variables)
  (labels (;; GET-VALUE is just a simple helper to get the value of 
           ;; a variable from the association list.
           (get-value (variable)
             (cdr (assoc variable variables)))
           (evaluator (input)
             (typecase input
               ;; For atoms we just return its value from the alist.
               (atom (get-value input))
               ;; Lists consist of an operator and arguments for it.
               ;; We only recognize three operators: AND, OR and NOT.
               (list (destructuring-bind (operator &rest args) input
                       (ecase operator
                         (and (loop for arg in args always (evaluator arg)))
                         (or (loop for arg in args thereis (evaluator arg)))
                         (> (not (and (evaluator (first args))
                                      (not (evaluator (second args))))))
                         (- (equal (evaluator (first args))
                                   (evaluator (second args))))
                         (not (not (evaluator (first args))))))))))
    (evaluator input)))

再次，让我们测试一下：

CL-USER> (evaluate '(and a (or b c)) '((a . t) (b . nil) (c . t)))
T
CL-USER> (evaluate '(and a (or b c)) '((a . t) (b . nil) (c . nil)))
NIL

使用这些函数，我们可以创建一个像这样的真值表：

CL-USER> (let ((input '(and a (or b c))))
           (mapcar (lambda (row)
                     (append (mapcar #'cdr row)
                             (list (evaluate input row))))
                   (generate-value-combinations (extract-variables input))))
((NIL NIL NIL NIL) (NIL NIL T NIL) (NIL T NIL NIL) (NIL T T NIL)
 (T NIL NIL NIL) (T NIL T T) (T T NIL T) (T T T T))

在每个子列表中，前三个值是变量的值（因为我们的测试输入中有三个值）。最后一个值是使用这些变量值评估的表达式的值。

现在让我们编写函数来检查表达式是否可满足/等。这与 Coredumps 的答案几乎相同。主要区别在于，在此版本中，真值表存储为列表，而不是数组。

(defun interpret (truth-table)
  (loop for (value) in (mapcar #'last truth-table)
        for valid = value then (and valid value)
        for satisfiable = value then (or satisfiable value)
        finally (return (cond (valid :valid)
                              (satisfiable :satisfiable)
                              (t :unsatisfiable)))))

最后让我们连接一切：

(defun logic-start ()
  (format *query-io* "~&Enter A Logical Expression: ")
  (finish-output *query-io*)
  (let* ((input (read *query-io*))
         (variables (extract-variables input))
         (value-combinations (generate-value-combinations variables))
         ;; Gather all sub-expressions.
         (columns (labels ((collect-sub-expressions (expression)
                             (append (when (and (listp expression)
                                                (not (and (eql (first expression)
                                                               'not)
                                                          (atom (second expression)))))
                                       (loop for arg in (rest expression)
                                             append (collect-sub-expressions arg)))
                                     (list expression))))
                    (remove-duplicates (collect-sub-expressions input)
                                       :from-end t)))
         ;; Widths of the columns in the table.
         (column-widths (loop for column in columns
                              collect (max 3 (length (princ-to-string column)))))
         (truth-table (mapcar (lambda (variables)
                                (loop for col in columns
                                      for width in column-widths
                                      collect width
                                      ;; This is a bit wasteful, since
                                      ;; it evaluates every sub-expression
                                      ;; separately, as well as evaluating
                                      ;; the full expression.
                                      collect (evaluate col variables)))
                              value-combinations)))
    (format t "~&~{ ~{~v<~a~;~>~}~^ |~}~%~{-~v,,,'-<-~>-~^+~}~%"
            (mapcar #'list column-widths columns) column-widths)
    (format t "~&~{~{ ~v<~a~;~> ~^|~}~%~}" truth-table)
    (format t "~&This expression is ~a.~%"
            (case (interpret truth-table)
              (:valid "a Tautology")
              (:satisfiable "Satisfiable")
              (:unsatisfiable "Unsatisfiable")))))

并测试一下：

CL-USER> (logic-start)
Enter A Logical Expression: (and a (not a))

 A   | (NOT A) | (AND A (NOT A))
-----+---------+-----------------
 NIL | T       | NIL             
 T   | NIL     | NIL             
This expression is Unsatisfiable.

NIL
CL-USER> (logic-start)
Enter A Logical Expression: (or a (not a))

 A   | (NOT A) | (OR A (NOT A))
-----+---------+----------------
 NIL | T       | T              
 T   | NIL     | T              
This expression is a Tautology.

NIL
CL-USER> (logic-start)
Enter A Logical Expression: (and a (or b c) (not d))

 A   | B   | C   | (OR B C) | (NOT D) | (AND A (OR B C) (NOT D))
-----+-----+-----+----------+---------+--------------------------
 NIL | NIL | NIL | NIL      | T       | NIL                      
 NIL | NIL | NIL | NIL      | NIL     | NIL                      
 NIL | NIL | T   | T        | T       | NIL                      
 NIL | NIL | T   | T        | NIL     | NIL                      
 NIL | T   | NIL | T        | T       | NIL                      
 NIL | T   | NIL | T        | NIL     | NIL                      
 NIL | T   | T   | T        | T       | NIL                      
 NIL | T   | T   | T        | NIL     | NIL                      
 T   | NIL | NIL | NIL      | T       | NIL                      
 T   | NIL | NIL | NIL      | NIL     | NIL                      
 T   | NIL | T   | T        | T       | T                        
 T   | NIL | T   | T        | NIL     | NIL                      
 T   | T   | NIL | T        | T       | T                        
 T   | T   | NIL | T        | NIL     | NIL                      
 T   | T   | T   | T        | T       | T                        
 T   | T   | T   | T        | NIL     | NIL                      
This expression is Satisfiable.

解析输入

处理输入的最简单方法是(a and b > q)将其解析为常规的 Lisp 语法。这是一个快速编写的解析器：

(defun find-and-split (item list)
  (let ((position (position item list :from-end t)))
    (when position
      (list (subseq list 0 position)
            item
            (subseq list (1+ position))))))

(defparameter *operator-precedence* '(- > or and))

(defun parse-input (input)
  (typecase input
    (atom input)
    (list (cond
            ((> (length input) 2)
             (dolist (op *operator-precedence* input)
               (let ((split (find-and-split op input)))
                 (when split
                   (destructuring-bind (left operator right) split
                     (return-from parse-input
                       (list operator
                             (parse-input left)
                             (parse-input right))))))))
            ((= (length input) 2) (mapcar #'parse-input input))
            (t (parse-input (first input)))))))

测试：

CL-USER> (parse-input '(a and b > q))
(> (AND A B) Q)
CL-USER> (parse-input '((not q) or p and x))
(OR (NOT Q) (AND P X))
CL-USER> (parse-input '(q > p or y))
(> Q (OR P Y))

要将其添加到程序中，只需将(READ *QUERY-IO*)in更改LOGIC-START为(PARSE-INPUT (READ *QUERY-IO*)).

避免出现问题-并>作为变量名的一部分被读取

READ您可以使用READ-LINE将其作为字符串读取，然后在任何-and周围插入空格>，然后才使用READ-FROM-STRING将其转换为列表，而不是直接使用 读取输入。

(defun insert-spaces (input-str)
  (with-output-to-string (str)
    (loop for char across input-str
          ;; Add a space before - or >
          when (or (char= char #\-)
                   (char= char #\>)) do (write-char #\space str)
          ;; Write the character itself.
          do (write-char char str)
             ;; Add a space after - or >
          when (or (char= char #\-)
                   (char= char #\>)) do (write-char #\space str))))

测试：

CL-USER> (insert-spaces "((p and q)-r)")
"((p and q) - r)"

然后更改(PARSE-INPUT (READ *QUERY-IO*))为(parse-input (read-from-string (insert-spaces (read-line *query-io*))))

于 2016-05-24T18:13:28.427 回答
0

您在 Common Lisp 中使用 C 中的习语，其中有太多SETQ表达式会改变全局变量：（i）SETQ未绑定标识符具有未定义的行为；(ii) 全局变量使您的代码不可重入且非线程安全。此外，您创建二维数组的方式看起来就像在 C 中的完成方式一样。 MAKE-ARRAY 接受多维列表：

 (make-array (list row column) :initial-element nil)

但是，让我们暂时保留您的版本。您必须遍历最后一列。由于您将列存储在数组中，因此您可以按如下方式检索最后一列：

(aref table (1- (length table)))

然后，您可以通过迭代其每个元素来解释最后一列：

(defun interpret (table)
  (let ((last-column 
         (aref table (1- (length table)))))
    (loop
       for value across last-column
       for valid = value then (and valid value)
       for satisfiable = value then (or satisfiable value) 
       finally
         (return
           (cond
             (valid       :valid)
             (satisfiable :satisfiable)
             (t           :unsatisfiable))))))

所以在这里我只是在计算两个谓词时遍历所有值：

  • valid当所有值都为真时为真；
  • satisfiable只要一个值为真，就为真。

在上面的函数中，我不打印任何东西，而是更喜欢返回符号来表示不同的情况。如果你需要打印一些东西，你可以在另一个函数中进行。

于 2016-05-24T15:13:39.330 回答