Реализация модельной экспертной системы на языке Плэнер

Модельная экспертная система решает задачу распознавания вида животного (тигр) на основе группы взаимосвязанных признаков:

млекопитающее

хищник

рыжевато-кор

темные-полосы

питается-мясом

острокон-зубы

когти

глаза-спереди

ТИГР

Система работает с базой данных, в которой хранятся утверждения следующих типов:

(<имя> = <вид>) → ОБСН: <обоснование>  ​  ( )
(<имя> - <класс>) → ОБСН: <обоснование>  ​  ( )
(<имя> имеет <свойство>) → ОТВ: ДА  ​  НЕТ
(<имя> питается <пища>)

Для определения вида животного используется аппарат теорем. Часть информации, необходимой для решения задачи представлена в виде утверждений базы данных, часть запрашивается у пользователя. В списках свойств утверждений представлены ответы пользователя и обоснование решения системы.
[define  main  (lambda  ( )
	[prog (ОТВ  ИМЯ  КЛАСС  ОБ)
     [while  T
		[print  ‘Работает эксперт по распознаванию животных‘]
		[print  ‘У Вас есть задача на распознавание?‘]
		[pset  ОТВ [yes-no]]
		[cond ([eq  .ОТВ  НЕТ]  [exit  main  main])]
		[print  ‘Введите имя распознаваемого объекта‘]
		[pset  ИМЯ  [read]]
		[if  ([perm  [goal  (.ИМЯ  =  *КЛАСС)]]
		      [pset  ОБ  [geta  (.ИМЯ   =  *КЛАСС)  ОБСН]]
		      [output  .ИМЯ  .КЛАСС  .ОБ] )
		     (T [mprint  Кем является .ИМЯ я не знаю ])]
		[cleardb]  ] ])]

[define  Тигр?  (conseq  (ИМЯ  ОБ  ОБ1  ОБ2)
		(*ИМЯ  =  ТИГР)
[goal (.ИМЯ  - млекопитающее)]
[goal (.ИМЯ  - хищник)]
[goal (.ИМЯ  имеет рыжевато-кор) (test  ОТВ  ДА)]
[goal (.ИМЯ  имеет темные-полосы) (test  ОТВ  ДА)]
	[pset  ОБ1 [geta  (.ИМЯ  - млекопитающее) ОБСН]]
	[pset  ОБ2 [geta  (.ИМЯ  - хищник) ОБСН]]
	[pset  ОБ ( ( (.ИМЯ  = ТИГР) так как (.ИМЯ – млекопитающее)
    (.ИМЯ – хищник)								    	       (.ИМЯ имеет рыжевато-коричневую окраску)
				    	       (.ИМЯ имеет темные полосы)) !.ОБ1  !.ОБ2)]
	[passert  (.ИМЯ  = ТИГР)  (with  ОБСН  .ОБ)]   )]

[define  Окраска?  (conseq  (ИМЯ  ОТВ)
	(*ИМЯ имеет рыжевато-кор)
[if  ([search1 (.ИМЯ имеет рыжевато-кор)  (test  ОТВ  *ОТВ)])
     (T  [mprint  .ИМЯ имеет рыжевато-коричневую окраску?]
           [pset  ОТВ  [yes-no]]
           [passert  (.ИМЯ имеет рыжевато-кор)  (with  ОТВ  .ОТВ)])]
[cond ([eq  .ОТВ  НЕТ]  [fail])] )]

[define  Полосы?  (conseq  (ИМЯ  ОТВ)
	(*ИМЯ имеет темные-полосы)
[if  ([search1 (.ИМЯ имеет темные-полосы)  (test  ОТВ  *ОТВ)])
     (T  [mprint  .ИМЯ имеет темные полосы?]
           [pset    [yes-no]]
           [passert  (.ИМЯ имеет темные-полосы )  (with  ОТВ  .ОТВ)])]
[cond ([eq  .ОТВ  НЕТ]  [fail])] )]

[define  Хищник1?  (conseq  (ИМЯ  ОБ)
		(*ИМЯ  -  хищник)
[goal (.ИМЯ  питается  мясом)]
	[pset  ОБ  ( ( (.ИМЯ - хищник) так как (питается мясом)))]
	[passert  (.ИМЯ - хищник)  (with  ОБСН  .ОБ)]   )]

[define  Хищник2?  (conseq  (ИМЯ  ОБ)
	(*ИМЯ  -  хищник)
[goal (.ИМЯ  имеет  острокон-зубы)]
[goal (.ИМЯ  имеет  когти)]
[goal (.ИМЯ  имеет  глаза-спереди)]
	[pset  ОБ  ( ( (.ИМЯ - хищник) так как   (.ИМЯ имеет  остроконечные зубы)								            (.ИМЯ имеет когти)
			            (.ИМЯ имеет глаза спереди)))]
	[passert  (.ИМЯ - хищник)  (with  ОБСН  .ОБ)]   )]
[define  yes-no  (lambda  ( ) [read])]
[define  output  (lambda  (x y z ) [prog ( ) [print .x] [print.y] [print .z]])]

[assert (Муся  питается  мясом)]
[assert (Муся - млекопитающее)]
[assert (Муся  имеет темные-полосы) (with ОТВ ДА)]
[assert (Муся  имеет рыжевато-кор) (with ОТВ ДА)]