Приложение в

Листинг задачи №2

(defun init ()//Функция осуществляет инициализацию семантическую сеть

(setf (get 'military 'equipment) 'arms)

(setf (get 'surface-ship 'search) 'radar)

(setf (get 'surface-ship 'equipment) 'instruments)

(setf (get 'underwater 'equipment) 'torpedos)

(setf (get 'surface-ship 'equipment) 'instruments)

(setf (get 'underwater 'search) 'sonar)

(setf (get 'citizen-ship 'search) 'radar)

(setf (get 'fisher 'equipment) 'tackles)

(setf (get 'fisher 'engine) 'diesel)

(setf (get 'cruise 'engine) 'diesel)

;(setf (get 'linkor 'engine) 'diesel)

(setf (get 'submarine 'engine) nil)

(setf (get 'batiskaf 'engine) nil)

(setf (get 'cruise 'conditions)'comfort)

(setf (get 'ships 'ako) 'water-means)

(setf (get 'military 'ako) 'ships)

(setf (get 'citizen-ship 'ako) 'ships)

(setf (get 'underwater 'ako) 'military)

(setf (get 'surface-ship 'ako) 'military)

(setf (get 'linkor 'ako) 'surface-ship)

(setf (get 'cruiser 'ako) 'surface-ship)

(setf (get 'submarine 'ako) 'underwater)

(setf (get 'batiskaf 'ako) 'underwater)

(setf (get 'fisher 'ako) 'citizen-ship)

(setf (get 'cruise 'ako) 'citizen-ship)

(setf (get 'tral-ship 'ako) 'fisher)

(setf (get 'whale-ship 'ako) 'fisher)

(setf (get 'river 'ako) 'cruise)

(setf (get 'sea 'ako) 'cruise)

'Ok

)

(defun findproperty (x p z n) //Функция определяет равенство заданного значения свойства и значения, имеющегося на семантической сети

;;; x - object

;;; p - property

;;; z - property's mean

;;; n - searching deapth

(cond ((equal z (get x p)) t)

((zerop n) nil);

(t (or (findproperty (get x 'ako) p z (- n 1))

(findproperty (get x 'is-a) p z (- n 1))

))))

(defun find-answer ()//Функцмя осуществляет поиск ответа на вопрос

(setq flot '(linkor cruiser submarine batiskaf

tral-ship whale-ship river sea))

(init)

(setq ans nil)

(dolist (tmp flot ans)

(if (and

(findproperty tmp 'ako 'military 5))

(setq ans (cons tmp ans)))

))

(defun match (O F) //Функция сопоставления образца p и данных d

(cond

((and (null O) (null F)) t)

((and (null F)

(eq (car O) '$)

(null (cdr O))) t)

((or (null O) (null F)) nil)

((or (equal (car O) '?)

(equal (car O) (car F)))

(match (cdr O) (cdr F)))

((eq (car O) '$)

(cond ((match (cdr O) F) t)

((match O (cdr F)) t))) ))

(defun main ()//Запрос данных, сравнение их с образцом и вывод результатов

(loop

(terpri)

(princ "Enter vopros: ")

(setq fact (read))

(cond ((equal fact '(exit))(return " Good-Bye"))

((or (match '(? $ military ships ) fact))

(setq answ (find-answer))

(if (null answ)

(print "V baze nakih net.")

(vivod answ))

(terpri)

(princ "Ok"))

(t (princ "Neverniy vopros")))))

(defun vivod (S) //вывод результата поиска в случае удачи

(cond ((null s) 'Ok)

(t

(princ (car s))

(princ " - military ships")

(terpri)

(vivod (cdr s)))))

> (main)

Enter vopros: ( Kakie bivaut military ships?)

Underwater, surface-ship - military ships