DOMAINS
l_i=integer*
l_s=string*
i=integer
s=string
c=char
structura=str(i,s) %Структура Порода-Параметры и его список
l_str=structura*
file=myfile
DATABASE
rule(s,l_i)
cond(structura)
PREDICATES
nondeterm repeat %Создание цикла
nondeterm expert %Главный предикат
nondeterm make_menu
nondeterm process(c)
nondeterm load_basa
nondeterm save_basa
nondeterm clear_basa
nondeterm consulting(s,l_str,l_i)
nondeterm transform(c,c) %Преобразование символов
nondeterm add_list(c,i,l_i,l_i) %Добавление элемента к списку
nondeterm find_poroda(s,l_i) %Поиск породы собаки
nondeterm ravno(l_i,l_i) %Проверка равенства списков
nondeterm belong(i,l_i) %Проверка принадлежности элемента списка
nondeterm title %Заголовок экспертной системы
CLAUSES
%Создание меню
expert:- title, load_basa,
make_menu, save_basa, clear_basa.
make_menu:- repeat,
write("***********************************************"),nl,nl,
write("Выберите один из пунктов меню:"),nl,nl,
write("1. Консультация."),nl,
write("2. Просмотр базы знаний."),nl,
write("3. Добавление нового знания."),nl,
write("4. Удаление знаниня."),nl,
write(""),nl,
write(" 0 - Выход."),nl,nl,
write("***********************************************"),nl,nl,
readchar(C), process(C),!.
%Консультция
process('1'):- save_basa, clear_basa, load_basa,
nl,write(""),nl,
findall(Str,cond(Str),List),
consulting(" ",List,Cond),
find_poroda(Poroda,Cond),
nl,write(" ",Poroda),nl,nl,
make_menu.
%Просмотр базы знаний
process('2'):- save_basa, clear_basa, load_basa,
existfile("BasaZnanij.pro"),
file_str("BasaZnanij.pro",Str),
write(Str),nl,
make_menu.
%Добавление нового знания
process('3'):- save_basa, clear_basa, load_basa,
nl,write(" Введите название породы собаки для добавления: "),
readln(Poroda),nl,
findall(Str,cond(Str),List),
consulting(Poroda,List,Cond),
assertz(rule(Poroda,Cond)),nl,nl,
write("Добавление прошло успешно."),nl,nl,
make_menu;
nl,write("Ошибка при вводе!!!"),
make_menu.
%Удаление знания
process('4'):- save_basa, clear_basa, load_basa,
nl,write("Введите название породы собаки для удаления: "),
readln(Poroda),nl,
retract(rule(Poroda,_)),
write("Удаление прошло успешно !"),nl,nl,
make_menu;
nl,write("Ошибка при вводе !!!"),nl,nl,
make_menu.
%Выход
process('0'):-write("Выйти из программы??? (y/n) "),
readln(Ans),
upper_lower(Ans,Ans1),
frontchar(Ans1,'y',_),!.
process(_):-
write("Ошибка при вводе."),nl,!.
repeat.
%Ошибка при загрузке
repeat:-repeat.
load_basa:-consult("BasaZnanij.pro"),!.
load_basa:-write(" Ошибка при загрузке правил из файла!").
save_basa:-save("BasaZnanij.pro").
title:-write("***************ЭКСПЕРТНАЯ СИСТЕМА***************"),nl,
write("**********ОПРЕДЕЛЕНИЕ ПОРОДЫ СОБАК*********"),nl,nl.
clear_basa:- retractall(rule(_,_)),
retractall(cond(_)).
%Консультация
consulting(_,[],[]).
consulting(Poroda,[str(N,Cond)|T1],List1):-
nl,
write(Cond,"? (д/н)"),nl,
readchar(Answer1),
write(Answer1),
transform(Answer1,Answer2),
consulting(Poroda,T1,List2),
add_list(Answer2,N,List2,List1),!.
%Преобразование сомволов
transform('д','y').
transform('Д','y').
transform('Y','y').
transform('y','y').
transform('1','y').
transform(_,'n').
%Поиск породы, сравнение равенства списков
add_list('y',H,T,[H|T]):-!.
add_list(_,_,List,List).
find_poroda(Str,Cond1):-
rule(Poroda,Cond2),
ravno(Cond1,Cond2),
ravno(Cond2,Cond1),
concat(Poroda," является искомой породой собаки.",Str),!.
find_poroda("Извините, но соответствующей параметрам породы не найдено на нашей планете :(",_).
ravno([],_).
%Проверка принадлежности элемента
ravno([H|T],L):- belong(H,L), ravno(T,L).
belong(El,[El|_]).
belong(El,[H|T]):- El<>H,
belong(El,T).
GOAL
expert.