Задание № 3.
Реализовать базу знаний для родственных отношений. Должны отслеживаться отношения: отец, мать, сын, дочь, бабушка, дедушка, муж, жена, внук, внучка, теща, свекровь. Предусмотреть автоматическую корректировку всех родственных связей при занесении единичной информации о новом человеке.
Реализация на frl
Обзор функций
(PASSERTQ ADD () ...)
Добавление единичной информации в сеть фреймов с указанием имени, фамилии, возраста, пола, имени матери и отца, имени мужа (жены) персонажа. Предусмотрена автоматическая корректировка всех родственных связей. Если какое-либо из полей пусто, необходимо ввести символ *.
(PASSERTQ GETFATHEROF (person) ...)
Определение имени отца персонажа person.
(PASSERTQ GETMOTHEROF (person) ...)
Определение имени матери персонажа person.
(PASSERTQ GETSONOF (person) ...)
Определение имён всех сыновей персонажа person.
(PASSERTQ GETDAUGHTEROF (person) ...)
Определение имён всех дочерей персонажа person.
(PASSERTQ GETCHILDRENOF (person) ...)
Определение имён всех детей персонажа person.
(PASSERTQ GETGRANDFATHEROF (person) ...)
Определение имён всех дедушек персонажа person.
(PASSERTQ GETGRANDMOTHEROF (person) ...)
Определение имён всех бабушек персонажа person.
(PASSERTQ GETGRANDPERENTSOF (person) ...)
Определение имён всех прародителей персонажа person.
(PASSERTQ GETWIFEOF (person) ...)
Определение имени жены персонажа person.
(PASSERTQ GETHASBANDOF (person) ...)
Определение имени мужа персонажа person.
(PASSERTQ GETGRANDSONOF (person) ...)
Определение имён всех внуков (муж) персонажа person.
(PASSERTQ GETGRANDDAUGHTEROF (person) ...)
Определение имён всех внучек персонажа person.
(PASSERTQ GETGRANDCHILDRENOF (person) ...)
Определение имён всех внуков персонажа person.
(PASSERTQ GETTESHAOF (person) ...)
Определение имёни тёщи персонажа person.
(PASSERTQ GETSVEKROVOF (person) ...)
Определение имёни свекрови персонажа person.
Исходный код
(passertq add ()
; Блок ввода информации о человеке
(PRINC "PNAME: ") (setq NAME (READ INPUT))
(FINSTANTIATE FAMILY NAME)
(fput name pname $value name)
(PRINC "PSERNAME: ") (setq SERNAME (READ INPUT))
(fput name psername $value sername)
(PRINC "AGE: ") (setq AGE (READ INPUT))
(fput name page $value age)
(PRINC "POL (M/F): ") (setq POL (READ INPUT))
(fput name ppol $value pol)
(PRINC "FATHER: ") (setq FATHER (READ INPUT))
; Добавляем в отцовский фрейм информацию о ребёнке
(cond ((not (equal FATHER '*))
(
(fput name pfather $value FATHER)
(fput father pchildren $value NAME)
))
)
(PRINC "MOTHER: ") (setq MOTHER (READ INPUT))
; Добавляем в материнский фрейм информацию о ребёнке
(cond ((not (equal MOTHER '*))
(
(fput name pmother $value MOTHER)
(fput mother pchildren $value NAME)
))
)
; Добавляем в информацию о муже/жене
(cond ((equal POL 'M)
(
(PRINC "WIFE: ") (setq WIFE (READ INPUT))
; Добавляем во фрейм жены информацию о муже
(cond ((not (equal WIFE '*))
(
(fput name pwife $value WIFE)
(fput wife phasband $value NAME)
))
)
)
)
(T
(
(PRINC "HASBAND: ") (setq HASBAND (READ INPUT))
; Добавляем во фрейм мужа информацию о жене
(cond ((not (equal HASBAND '*))
(
(fput name phasband $value HASBAND)
(fput hasband pwife $value NAME)
))
)
)
)
)
)
(passertq getmotherof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получение имени матери персонажа
(T (car (fget person pmother)))
)
)
(passertq getfatherof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получение имени отца персонажа
(T (car (fget person pfather)))
)
)
(passertq getsonof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение списка всех детей
(setq S (fget person pchildren))
(loop
; Возвращаем результат по достижении конца списка
((null S) (REVERSE R))
; Добавляем в результат только мальчиков
(cond ((equal (car (fget (car S) ppol)) "M")
(setq R (cons (car S) R)))
)
; Получаем остаток списка
(setq S (cdr S))
)
)
)
)
(passertq getdaughterof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение списка всех детей
(setq S (fget person pchildren))
(loop
; Возвращаем результат по достижении конца списка
((null S) (REVERSE R))
; Добавляем в результат только девочек
(cond ((equal (car (fget (car S) ppol)) "F")
(setq R (cons (car S) R)))
)
; Получаем остаток списка
(setq S (cdr S))
)
)
)
)
(passertq getchildrenof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получение списка всех детей
(T (fget person pchildren))
)
)
(passertq getgrandmotherof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение имени бабушки по материнской линии
(setq R (cons (car (fget (car (fget person pmother)) pmother)) R))
; Получение имени бабушки по отцовской линии
(setq R (cons (car (fget (car (fget person pfather)) pmother)) R))
(reverse R)
)
)
)
(passertq getgrandfatherof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение имени дедушки по материнской линии
(setq R (cons (car (fget (car (fget person pmother)) pfather)) R))
; Получение имени дедушки по отцовской линии
(setq R (cons (car (fget (car (fget person pfather)) pfather)) R))
(reverse R)
)
)
)
(passertq getgrandperentsof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение имени бабушки по материнской линии
(setq R (cons (car (fget (car (fget person pmother)) pmother)) R))
; Получение имени дедушки по материнской линии
(setq R (cons (car (fget (car (fget person pmother)) pfather)) R))
; Получение имени бабушки по отцовской линии
(setq R (cons (car (fget (car (fget person pfather)) pmother)) R))
; Получение имени дедушки по отцовской линии
(setq R (cons (car (fget (car (fget person pfather)) pfather)) R))
(reverse R)
)
)
)
(passertq gethasbandof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получение имени мужа
(T (car (fget person phasband)))
)
)
(passertq getwifeof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получение имени жены
(T (car (fget person pwife)))
)
)
(passertq getgrandsonof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение списка всех детей
(setq S (fget person pchildren))
(loop
; Возвращаем результат по достижении конца списка
((null S) (REVERSE R))
; Получение списка всех внуков
(setq S1 (fget (car S) pchildren))
(loop
((null S1) T)
; Добавляем в результат только мальчиков
(cond ((equal (car (fget (car S1) ppol)) "M")
(setq R (cons (car S1) R)))
)
; Получаем остаток списка внуков
(setq S1 (cdr S1))
)
; Получаем остаток списка детей
(setq S (cdr S))
)
)
)
)
(passertq getgranddaughterof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение списка всех детей
(setq S (fget person pchildren))
(loop
; Возвращаем результат по достижении конца списка
((null S) (REVERSE R))
; Получение списка всех внуков
(setq S1 (fget (car S) pchildren))
(loop
((null S1) T)
; Добавляем в результат только девочек
(cond ((equal (car (fget (car S1) ppol)) "F")
(setq R (cons (car S1) R)))
)
; Получаем остаток списка внуков
(setq S1 (cdr S1))
)
; Получаем остаток списка детей
(setq S (cdr S))
)
)
)
)
(passertq getgrandchildrenof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
(T
(setq R '())
; Получение списка всех детей
(setq S (fget person pchildren))
(loop
; Возвращаем результат по достижении конца списка
((null S) (REVERSE R))
; Получение списка всех внуков
(setq S1 (fget (car S) pchildren))
(loop
((null S1) T)
; Добавляем в результат всех
(setq R (cons (car S1) R))
; Получаем остаток списка внуков
(setq S1 (cdr S1))
)
; Получаем остаток списка детей
(setq S (cdr S))
)
)
)
)
(passertq getteshaof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получаем имя тёщи
(T (car (fget (car (fget person pwife)) pmother)))
)
)
(passertq getsvekrovof (person)
(cond
; Проверка существования фрейма
((Null (member person (cdr *FRAMES*)))
Error!_WRONG_PERSON_NAME!)
; Получаем имя свекрови
(T (car (fget (car (fget person phasband)) pmother)))
)
)
Примеры
Опишем исходную систему фреймов вида:
(deframeq IVAN
(pname ($value (IVAN)))
(pseraname ($value (IVANOV)))
(page ($value (75)))
(ppol ($value (M)))
(pwife ($value (MASHA)))
(pchildren ($value (IGOR) (DASHA) (KOLYA)))
)
(deframeq MASHA
(pname ($value (MASHA)))
(pseraname ($value (PETROVA)))
(page ($value (68)))
(ppol ($value (F)))
(Phasband ($value (IVAN)))
(pchildren ($value (IGOR) (DASHA) (KOLYA)))
)
(deframeq PETYA
(pname ($value (PETYA)))
(pseraname ($value (SMIRNOV)))
(page ($value (84)))
(ppol ($value (M)))
(pwife ($value (KATYA)))
(pchildren ($value (OLEG) (VERA)))
)
(deframeq KATYA
(pname ($value (KATYA)))
(pseraname ($value (PUSHKINA)))
(page ($value (86)))
(ppol ($value (F)))
(Phasband ($value (PETYA)))
(pchildren ($value (OLEG) (VERA)))
)
(deframeq IGOR
(pname ($value (IGOR)))
(pseraname ($value (IVANOV)))
(page ($value (51)))
(ppol ($value (M)))
(pmother ($value (MASHA)))
(pfather ($value (IVAN)))
)
(deframeq DASHA
(pname ($value (DASHA)))
(pseraname ($value (IVANOVA)))
(page ($value (48)))
(ppol ($value (F)))
(pmother ($value (MASHA)))
(pfather ($value (IVAN)))
)
(deframeq KOLYA
(pname ($value (KOLYA)))
(pseraname ($value (IVANOV)))
(page ($value (46)))
(ppol ($value (M)))
(pmother ($value (MASHA)))
(pfather ($value (IVAN)))
(pwife ($value (VERA)))
(pchildren ($value (JENYA) (OLYA)))
)
(deframeq VERA
(pname ($value (VERA)))
(pseraname ($value (SMIRNOVA)))
(page ($value (44)))
(ppol ($value (F)))
(pmother ($value (KATYA)))
(pfather ($value (PETYA)))
(Phasband ($value (KOLYA)))
(pchildren ($value (JENYA) (OLYA)))
)
(deframeq OLEG
(pname ($value (OLEG)))
(pseraname ($value (PUSHKIN)))
(page ($value (48)))
(ppol ($value (M)))
(pmother ($value (KATYA)))
(pfather ($value (PETYA)))
)
(deframeq JENYA
(pname ($value (JENYA)))
(pseraname ($value (SMIRNOV)))
(page ($value (20)))
(ppol ($value (M)))
(pmother ($value (VERA)))
(pfather ($value (KOLYA)))
)
(deframeq OLYA
(pname ($value (OLYA)))
(pseraname ($value (SMIRNOVA)))
(page ($value (14)))
(ppol ($value (F)))
(pmother ($value (VERA)))
(pfather ($value (KOLYA)))
)
Сделаем несколько запросов к исходной системе фреймов:
Мама Веры: (getMOTHERof VERA) —> KaTya
Папа Олега: (getFATHERof OLEG) —> PETYA
Сыновья Ивана: (getSONof IVAN) —> (IGOR KOLYA)
Дочери Кати: (getDAUGHTERof KATYA) —> (VERA)
Дети Маши: (getCHILDRENof MASHA) —> (IGOR DASHA KOLYA)
Сыновья Жени: (getSONof JENYA) —> NIL
Бабушки Жени: (getGRANDMOTHERof JENYA) —> (KATYA MASHA)
Дедушки Оли: (getGRANDFATHERof OLYA) —> (PETYA IVAN)
Прародители Оли: (getGRANDPERENTSof OLYA) —> (KATYA PETYA MASHA IVAN)
Жена Ивана: (getWIFEof IVAN) —> MASHA
Муж Маши: (getHASBANDof MASHA) —> IVAN
Внук Пети: (getGRANDSONof PETYA) —> (JENYA)
Внучка Пети: (getGRANDDAUGHTERof PETYA) —> (OLYA)
Внуки (все) Пети: (getGRANDCHILDRENof PETYA) —> (JENYA OLYA)
Тёща Коли: (getTESHAof KOLYA) —> KATYA
Свекровь Веры: (getSVEKROVof VERA) —> MASHA
Добавим членов семьи:
(add)
NAME: ILYA
SERNAME: SMIRNOV
AGE: 22
POL (M/F): M
FATHER: KOLYA
MOTHER: VERA
WIFE: *
(add)
NAME: DASHA
SERNAME: SIDOROVA
AGE: 23
POL (M/F): F
FATHER: *
MOTHER: *
HASBAND: ILYA
Комбинируя запросы, можем получать ответы на сложные вопросы.
Например, определим возраст тёщи отца Оли:
(fget (getTESHAof (getFATHERof OLYA)) page) —> (86)