Интерпретатор продукций

В функциях proof и elproof, представленных ниже, используются свободные переменные:

• rules – переменная, содержащая правила, в том виде, как их сформировала функция analyse,

• facts – переменная, содержащая факты.

Машина вывода-функция proof (ее параметром является список, представляющий гипотезу в виде списка списков, подобно набору фактов, например – « ((животное жвачное) (животное полосатое) (животное зебра)) ») выполняет следующее:

1. Гипотеза доказана, если все факты (элементы списка) гипотезы содержатся в базе фактов. По ходу сравнения формируется список тех элементов, для которых нет идентичных им элементов в базе фактов. Если такой список пуст, то гипотеза доказана и функция возвращает в качестве результата значение t.

2. Если список не пуст, то для каждого элемента гипотезы выполняется следующее:

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

   2. для сформированной гипотезы рекурсивно вызывается функция proof,

   3. если функция возвращает значение t, то соответствующий элемент вычеркивается из гипотезы и продолжается выполнение шага 2, иначе выполняется выход из цикла выполнения функции со значением nil – гипотеза не доказана

3. Функция возвращает в качестве результата атом t, т.к. для всех элементов гипотезы получено доказательство.

(defun proof (hph)

(prog (x)

(setq x (mapcan #¢(lambda (el)

(if (member el facts :test ¢equal) nil (list el) )) hph)

(if (null x) (return t) nil)

(setq x (mapcar ¢elproof x))

(if (member nil x :test ¢eq) (return nil) (return t))

)

)

Вспомогательная функция elproof формирует гипотезу из правил для элемента исходной гипотезы и вызывает для ее доказательства функцию proof:

(defun elproof (el)

(prog (x y) ;; начальные значения переменных равны nil

(setq x rules)

m (setq y (if (member el (rule-concl (car x)) :test ¢equal)

(rule-cond (car x)) nil))

(if (not (null y)) (setq y (proof y)) nil)

(if (eq y t)(return t) (setq x (cdr x)))

(if (null x) (return nil) (go m))

)

)

В функциях, представленных выше, используется функционалmapcan. Он выполняется так же как mapcar, но не объединяет частичные результаты в список, а рассматривает результаты как списки и снимает окружающие список скобки (т.е. выполняет операцию десегментации списков).

Пример

(mapcar ¢numberp ¢(1 2 true 3)) -> (t t nil t)

(mapcan ¢(lambda (x) (if (numberp x) ¢(t) nil)) ¢(1 2 true 3)) -> (t t t)

В программе для проверки идентичности элементов используется функция eq, а для сравнения списков – equal. В функции proof функционал mapcar формирует список в следующем виде (t t .. t nil t …t). Наличие хотя бы одного атома nil в списке означает, что для соответствующего элемента гипотезы доказательство не получено.

В реальных экспертных системах машина вывода должна включать блок объяснения вывода и для этого необходимо сформировать дополнительно последовательность имен примененных правил. Кроме того, если вывод не получен, то должен формироваться запрос на ввод дополнительных фактов или на изменение гипотезы.