Программа CLISP для определения таблицы истинности является непоследовательной, действительной или недействительной

Question

У меня есть небольшая проблема в цикле, которая усваивает условие на сгенерированной таблице истинности. Таким образом, вы вводите логическое выражение, а затем превращаете его в таблицу истинности, он также интерпретирует, является ли он действительным или недействительным или непоследовательным. Пока это часть программы, которая интерпретирует ее, но она только ломается недействительной или действительной ... можете ли вы, пожалуйста, направить меня на это? Благодаря

* редактировать // Так что это, как программа работает:

******* Добро пожаловать ********

Тип (LogicStart) в начать или (выйти), чтобы выйти в любое время.

;; Загруженный файл MyLogic.lisp

T [2]> (LogicStart) Введите логическое выражение или формулу: "(р^(~ р))"

р (~ р) (р^(р ~))
Т NIL NIL

NIL NIL Т

формула Недопустимый

Таким образом, вход только логическое выражение, то выходной сигнал представляет собой таблицу истинности для этого выражения .... и может als о его интерпретировать, но мой код имеет только два intepretations: недействительная или действительная (тавтология), так как в приведенном выше примере должно быть непоследовательными/невыполнимо (поскольку все интерпретации формулы/выражение ложно)

конца редактировать

(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)) 
) 

// редактировать 3 Таким образом, для (ИЛИ (НЕ)), таблица не хватает "а не" in @ jkiiski

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

Другой пример ссылки разностная: В то время как Р означает 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 
-------------------------------------------- 

Так что в (р> д)^г она показывает р, д, г, (р> д) и, наконец, (р> д)^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))) 

Answer 1

Вы используете идиомы из C в Common Lisp, слишком много SETQ выражения мутирует глобальные переменные: (I) SETQ с несвязанными идентификаторами имеет неопределенное поведение; (ii) глобальные переменные делают ваш код невозвратным и не потокобезопасным. Кроме того, как вы создаете свой двумерный массив выглядит, как это делается в С. 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 истинно, как только одно значение истинно.

В приведенной выше функции я ничего не печатаю, но предпочитаю возвращать символы для представления различных случаев. Если вам нужно что-то напечатать, вы можете сделать это в другой функции.

Answer 2

Coredump уже дал ответ, и я использовал его решение как часть этого (с незначительными изменениями), но поскольку ваш код не очень ленивый, я решил, что покажу другое решение для учебных целей. Это довольно быстро написано, поэтому не стесняйтесь указывать на все глупые ошибки ...

В этом коде я предполагаю, что вы хотите, чтобы логическое выражение было задано с использованием обычного синтаксиса Lisp (например, (and a (or b c))).

Начнем с функции, чтобы извлечь все переменные, используемые в выражении. Я предполагаю, что все, что не является логическим оператором (AND, OR, > или NOT) является переменной. Это принимает список как аргумент и использует рекурсивную функцию (EXTRACT), чтобы пройти по ней, собирая все атомы, которые не являются операторами в списке (VARIABLES). Список, наконец, обратный и возвращается.

(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, и когда достигнут конец списка переменных, накопленный список ассоциаций будет pushe до COMBINATIONS. Крен сторнируется поддерживать тот же порядок переменных приведены в Мы можем проверить это сейчас:.

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

Далее нам понадобится функция, чтобы вычислить выражение, используя значения переменных в одной из этой alists. Мы можем сделать это легко с рекурсивным:

(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)) 

В в каждом из подписок первые три значения являются значениями переменных (так как мы имеем три значения в нашем тестовом вводе). Последним значением является значение выражения, оцененного с этими значениями переменных.

Теперь давайте напишем функцию, чтобы проверить, выполняется ли выражение/etc. Это почти то же самое, что и в ответе 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*) в LOGIC-START к (PARSE-INPUT (READ *QUERY-IO*)).

Избежание проблем с - и > читается как часть имени переменной

Вместо того, чтобы читать ввод непосредственно с READ, вы можете использовать READ-LINE, чтобы прочитать его в виде строки, а затем вставить пробелы вокруг любого - и >, и только затем используйте 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*))))