6.Учебные демонстрационные примеры

Клабораторной работе № 1. Знакомство с системой

"Turbo-prolog".

Программа начального знакомства с языком, которая должна выдавать на экран текст приветствия.

PREDICATES do

r(string) GOAL do.

CLAUSES

do :- write("Введите ваше имя "), readln(X), nl, r(X). r("Вася") :- write("Счастлив видеть").

r("Оля") :- write("Большой привет"). r("Коля") :- write("Очень рад").

К лабораторной работе № 2. Установление родственных связей.

При разработке программы использованы предикаты типа: родитель; мужчина; женщина.

PREDICATES p(string,string) w(string) m(string) mot(string,string) fat(string,string) s(string,string) CLAUSES

p("Вася","Коля"). p("Оля","Коля"). p("Вася","Соня"). p("Оля","Соня").p("Вася","Митя"). p("Дуня","Митя"). p("Валя","Лена"). p("Олег","Лена"). p("Коля","Миша"). p("Лена","Миша"). p("Коля","Поля"). p("Лена","Поля"). p("Поля","Игорь"). p("Сергей","Игорь").

m("Вася"). m("Коля"). m("Митя"). m("Олег").

46

m("Миша"). m("Сергей"). m("Игорь"). w("Оля"). w("Соня"). w("Дуня"). w("Валя"). w("Лена"). w("Поля").

mot(X,Y) :- p(X,Y), w(X). fat(X,Y) :- p(X,Y), m(X).

s(X,Y) :- w(X), mot(Z,X), mot(Z,Y), fat(W,X), fat(W,Y).

К лабораторной работе № 3. Организация циклов.

Вводить целое число до тех пор, пока не будет введено число 0. PREDICATES

do r

GOAL do. CLAUSES

do :- r, write("\nВведите число "), readln(X), X="0". r.

r :- r.

К лабораторной работе № 4. Работа с текстами.

Организовать ввод слова и буквы, удалить из слова все вхождения данной буквы.

PREDICATES do

pr(string,char,string) GOAL

do. CLAUSES

do :- write("\nВведите слово "), readln(X), write("\nВведите букву "), readchar(C), pr(X,C,S), write("\nПолучилось ",S). pr("",_,"").

pr(X,C,S) :- frontchar(X,C,Y), pr(Y,C,S). pr(X,C,S) :- frontchar(X,A,Y), A<>C, pr(Y,C,T), frontchar(S,A,T).

47

К лабораторной работе № 5. Работа со списками.

Ввести список строк, реверсировать его. DOMAINS

sl = string* PREDICATES do vv(string,sl) r(sl,sl,sl) GOAL

do. CLAUSES

do :- nl, vv(" ",S), r(S,[],[_|T]), nl, write(T). vv("",[]).

vv(_,[X|T]) :- write("\nВведите слово (пустое-выход) "), readln(X), vv(X,T).

r([],T,T).

r([H|X],S,T) :- r(X,[H|S],T).

К лабораторной работе № 6. Основы декларативного программирования.

/* РОДСТВО */ PREDICATES parent(string,string) women(string) man(string) child(string,string) sister(string,string) mather(string,string) father(string,string) grandmather(string,string) grandfather(string,string) grandchild (string,string) aunt(string,string)

CLAUSES

parent(nam,bob). parent(tom,bob). parent(tom,liz). parent(bob,ann). parent(bob,pat). parent(pat,jim).

48

К лабораторной работе № 8. Изучение операций с файлами на внешних носителях.

/* ИСКЛЮЧЕНИЕ */ PREDICATES belong(string,string) del(string,string,string)

go CLAUSES

belong(Str,S):- concat(S,_,Str),!. belong(Str,S):- frontchar(Str,_,Str1), belong(Str1,S). del("",_,""). del(Str,S,St):- concat(S,T,Str), del(T,S,St),!. del(Str,S,St):- frontchar(Str,H,T), del(T,S,T1), frontchar(St,H,T1). go :-

write("Предложение:"),nl, readln(Sent), write("Образец:"),nl, readln(Strs), del(Sent,Strs,St), write("Результат: ",St),nl, readchar(_).

К лабораторной работе № 9. Формирование строк и списков в экспертной оболочке "Turbo-prolog".

/* ВВОД TEKCTA В ФАЙЛ */ DOMAINS

file = datafile

50

PREDICATES vvod readin(char)

/* GOAL vvod*/

CLAUSES vvod :-

write("Полное имя файла:"),nl, readln(Filename),

write("Ввод строк, конец - #:"),nl, openwrite(datafile,Filename), writedevice(datafile),

readchar(C),

readin(C),

closefile(datafile), write("Записано"),nl. readin('#') :- !.

readin('\13') :- write("\13\10"), writedevice(screen), write("\13\10"), readchar(C), writedevice(datafile), readin(C).

readin(C) :- write(C), writedevice(screen), write(C), readchar(C1), writedevice(datafile), readin(C1).

К лабораторной работе № 10. Создание базы данных.

Организовать интерфейс работы с базой данных студентов, предусматривающий три режима - просмотр всей базы данных, добавление записи и удаление записи.

51

DATABASE st(string,string,integer) PREDICATES

do r

o(integer)

INCLUDE "tdoms.pro"

INCLUDE "tpreds.pro"

INCLUDE "menu.pro" GOAL

do. CLAUSES

do :- makewindow(1,48,0,"",0,0,24,80), consult("d.dat"), r, clearwindow, menu(7,35,33,66,["Просмотр", "Добавление","Удаление","Выход"]," Выбор ",0,N), o(N).

r.

r :- r.

o(4) :- save("d.dat").

o(3) :- write("\nВведите фамилию отчисляемого студента: "), readln(X), retractall(st(X,_,_)), !, fail.

o(2) :- write("\nВведите новую запись\n\nФамилия: "), readln(X), write("\nФакультет: "), readln(F), write("\nГруппа: "), readint(N), assert(st(X,F,N)),

!, fail.

o(1) :- st(X,F,N), writef("%30%10-%2",X,F,N), nl, fail. o(_) :- readln(_), !, fail.

К лабораторной работе № 11. Организация экспертной системы.

На базе результатов работы № 10 создать интерфейс экспертной системы, предусматривающий обработку запросов.

DATABASE st(string,string,integer) PREDICATES

do r

52

o(integer)

INCLUDE "tdoms.pro"

INCLUDE "tpreds.pro"

INCLUDE "menu.pro" GOAL

do. CLAUSES

do :- makewindow(1,48,0,"",0,0,24,80), consult("d.dat"), r, clearwindow, menu(7,32,33,66,["Студенты группы", "Группы факультета","Выход"]," Запрос ",0,N), o(N). r.

r :- r. o(3).

o(2) :- write("\nВведите название факультета: "), readln(F), st(_,F,N), nl, write(N), fail.

o(1) :- write("\nВведите номер группы: "), readint(N), st(X,_,N), nl, write(X), fail.

o(_) :- readln(_), !, fail.

К лабораторной работе № 13. Создание динамических баз данных в оперативной памяти и на внешних носителях в Турбо-прологе.

/* БАЗА ЗНАНИЙ */ INCLUDE "menu.pro" DATABASE dinform(string, string, string)

PREDICATES inform(string,string,string) invite

spis repeat2 repeat3

switch1(integer)

checkdate(string) adb

CLAUSES

53

inform("Ельцин"," Борис Николаевич "," 25 марта, Свердловск "). inform("Жириновский"," Владимир Вольфович "," 21 апреля, Стамбул"). inform("Явлинский"," Григорий Алексеевич "," 2 апреля, Яблонево "). inform("Зюганов"," Геннадий Андреевич "," 27 сентября, Город-сад "). inform("Власов"," Владимир Юрьевич "," 26 ноября, Закачайск "). inform("Лебедь"," Упал Отжался "," 23 февраля, Армейск "). inform("Федоров"," Святослав Федорович "," 25 июля, Глазнинск"). inform("Горбачев"," Михаил Сергеевич "," 4 декабря, Ставрополье "). inform("Брынцалов"," Шалы Бабай-оглы "," 15 сентября, Москва "). inform("Тулеев"," Аман-Гельды "," 5 марта, Чукотск ").

spis:- dinform(G,_,_),write(" ",G),nl,fail.

repeat2. repeat2:-repeat2.

repeat3. repeat3:-repeat3.

invite:- adb,

makewindow(1,14,11," Кандидаты в президенты ",0,0,25,80),nl,nl, repeat3,

cursorform(1,0),

menu(8,20,113,112,[" Просмотр всех кандидатов ", " Просмотр информации о кандидате ",

switch1(Choiser),

Choiser=5,!.

switch1(1):-

makewindow(4,30,31," Кандидаты ",4,20,18,40), cursor(1,4),

write(" В базе знаний присутствуют"), cursor(2,6),

write(" следующие кандидаты :"),nl,nl,

54

attribute(31),

not(spis),

cursorform(1,0),

cursor(15,12),

attribute(158),

write(" Нажмите <ESC>."), readchar(_), cursorform(13,14), removewindow.

write("Место и дата рождения: "),attribute(31), write(Z),attribute(30),

cursorform(1,0),

cursor(10,21),

attribute(158), write("Нажмите <ESC>."), readchar(_), cursorform(13,14), shiftwindow(5), removewindow.

55

switch1(3):- cursorform(13,14),

makewindow(5,30,31,"",5,10,15,60),

write(" Введите фамилию нового кандидата: "), readln(Fam),

write(" Введите имя и отчество : "), readln(Nam),

write(" Введите место, дата рождения : "), readln(Gam), assertz(dinform(Fam,Nam,Gam)), write("Нажмите <ESC>."),

readchar(_), cursorform(13,14), removewindow.

switch1(4):-

makewindow(6,30,31," About ",4,14,12,46),nl,

write(" Данная информационная база позволяет"),nl, write(" получить информацию о кандидатах в "),nl, write(" президенты России, узнать дату и место"),nl, write(" рождения каждого, а также ввести нового"),nl, write(" кандидата."),nl,nl,

attribute(31),

attribute(31),

cursorform(1,0),

cursor(9,12),

attribute(158),

write(" Нажмите <ESC>."), readchar(_), cursorform(13,14), removewindow.

switch1(5):-!, cursorform(13,14), makewindow(1,7,0,"",0,0,25,80), exit.

56

checkdate(D):- dinform(D,_,_),!;

makewindow(3,78,79,"",10,26,4,29),

cursorform(1,0),

beep,

write(" Такого кандидата нет."),nl, write(" Нажмите < ESC > . "), readchar(_),

cursorform(13,14),

shiftwindow(3), removewindow, fail.

adb:- inform(Fam,Nam,Gam),

assertz(dinform(Fam,Nam,Gam)), fail. adb:-!.

GOAL invite.

К лабораторной работе № 14. Создание экспертной системы, базирующейся на правилах.

/* Экспертная система АДВОКАТУРА */ DOMAINS

s=symbol DATABASE xpositive(s,s) xnegative(s,s) PREDICATES do_expertiza do_consulting ask(s,s) advokat(s) positive(s,s) negative(s,s) remember(s,s,s) clear_facts

57

CLAUSES

/* Система пользовательского интерфейса */ do_expertiza:-

makewindow(1,7,6,"ЭКСПЕРТНАЯ СИСТЕМА",1,18,22,58), nl,write("****************************************************** **"),

nl,write("Нужен адвокат "), nl,write("Отвечайте только <да> или <нет>"), nl,

do_consulting. do_expertiza:-nl,

write("На выход - ENTER"),nl, readln(_),

removewindow,

exit. do_consulting:- advokat(X),!,nl,

write("Фамилия адвоката для Вас ",X," ."),nl, clear_facts.

do_consulting:-

nl,write("Жаль, не могу Вам помочь!"), clear_facts.

ask(X,Y):-

write("Кандидат ",X,Y," ? "), readln(R), remember(X,Y,R).

/* Механизм вывода */ positive(X,Y):- xpositive(X,Y),!.

positive(X,Y):- not(negative(X,Y)),!,ask(X,Y). negative(X,Y):- xnegative(X,Y),!.

remember(X,Y,"да"):- asserta(xpositive(X,Y)). remember(X,Y,"нет"):- asserta(xnegative(X,Y)),fail. clear_facts:- retract(xpositive(_,_)),fail. clear_facts:- retract(xnegative(_,_)),fail.

58

/*ПРОДУКЦИОННЫЕ ПРАВИЛА */ advokat("Федоров"):-

positive("берет ","до 50$"), positive("имеет стаж ","более 4-х лет"),!. advokat("Соколов"):-

positive("берет " ,"от 50$ до 100$"), positive("имеет стаж ","менее 2-х лет"),!. advokat("Иванов"):-

positive("берет ","от 100$ до 200$"), positive("имеет стаж ","5 лет"),!. advokat("Петров"):-

positive("берет ","от 200$"), positive("имеет стаж ","более 3-х лет"),!. advokat("Федорчук"):-

positive("берет ","до 50$"), positive("имеет стаж ","менее 4-х лет"),!. advokat("Сокол"):-

positive("берет " ,"от 50$ до 100$"), positive("имеет стаж ","4 года"),!. advokat("Иванченков"):- positive("берет ","от 100$ до 200$"),

positive("имеет стаж ","менее 3-х лет"),!. advokat("Петровский"):-

positive("берет ","от 200$"), positive("имеет стаж ","более 4-х лет"),!. GOAL

do_expertiza.

К лабораторной работе № 15. Разработка обучающейся экспертной системы для САПР, базирующейся на логике, в Турбо-прологе.

/* Экспертная система СОСЕДИ, базирующаяся на логике */ INCLUDE "menu.pro"

INCLUDE "status.pro"

DOMAINS object = string

59

DATABASE male(object) female(object) wife(object,object) husband(object,object) child(object,object) syster(object,object) brother(object,object)

PREDICATES init

/* clear*/ add_male(object) add_female(object) add_marid(object,object) add_child(object,object) add_bs(object,object)

get_sup(object,object,object) /* x, H,W*/ add_brother_or_syster(object,object) show_tree(object,integer)

colon(integer)

cur(integer) case

end menu0(integer) smenu1(integer) smenu2(integer) smenu3(integer) show_child(object) print_child(object) show_syster(object)

show_brother(object) showall show_par(object) show_sup(object)

60

CLAUSES show_sup(X):- get_sup(X,H,W),

write(H," и ",W," супруги"),nl. show_sup(X).

show_par(X):- child(X,Y), get_sup(Y,H,W),

write(H," и ",W," родители ",X). show_par(X).

showall:- male(X),

write("Мужчина ",X),nl, retract(male(X)),

fail. showall:- female(X),

write("Женщина ",X),nl, retract(female(X)),

fail.

showall.

print_child(X):- male(X), write("сын ",X),nl. print_child(X):- female(X), write("дочь ",X),nl.

show_child(X):- child(Z,X), male(Z), print_child(Z), fail. show_child(X):- child(Z,X), female(Z), print_child(Z), fail. show_child(X).

61

show_syster(X):- syster(Z,X), write(Z),nl,

fail. show_syster(X).

show_brother(X):- brother(Z,X), write(Z),nl,

fail. show_brother(X).

colon(X):- X<>0, write(" ¦"), Y=X-1, colon(Y). colon(0).

init:-

/* clear,*/ consult("work7.bds").

/* clear:- retract(male(_)), retract(female(_)), retract(wife(_,_)), retract(child(_,_)), retract(syster(_,_)), retract(brother(_,_)), retract(husband(_,_)), fail.

clear:- !.*/

add_male(X):- not(female(X)), not(male(X)), assertz(male(X)),

write("мужчина ",X," добавлен в базу данных"),nl. add_male(X):-write("Противоречит правилам в базе данных").

62

add_female(X):- not(male(X)), not(female(X)), assertz(female(X)),

write("женщина ",X," добавлена в базу данных"),nl. add_female(X):-write("Противоречит правилам в базе данных").

add_marid(X,Y):- male(X), female(Y), not(husband(X,_)), not(wife(Y,_)),

assertz(husband(X,Y)),

assertz(wife(Y,X)),

write(X," и ",Y," супруги"),nl. add_marid(X,Y):-

female(X),

male(Y), not(wife(X,_)), not(husband(Y,_)), assertz(wife(X,Y)), assertz(husband(Y,X)),

write(Y," и ",X," супруги"),nl. add_marid(X,Y):-write("Противоречит правилам в базе данных"),nl.

add_brother_or_syster(X,Z):- child(X,Z),

child(Y,Z),

X<>Y, add_bs(X,Y), fail.

add_bs(X,Y):- male(X), male(Y),

assertz(brother(X,Y)),

assertz(brother(Y,X)), write(X," и ",Y," братья"),nl.

63

add_bs(X,Y):- male(X), female(Y),

assertz(brother(X,Y)),

assertz(syster(Y,X)),

write(X," и ",Y," брат и сестра"),nl. add_bs(X,Y):-

female(X),

male(Y),

assertz(syster(X,Y)),

assertz(brother(Y,X)),

write(X," и ",Y," сестра и брат"),nl. add_bs(X,Y):-

female(X),

female(Y),

assertz(syster(X,Y)),

assertz(syster(Y,X)), write(X," и ",Y," сестры"),nl.

get_sup(X,H,W):- male(X), husband(X,W), wife(W,H). get_sup(X,H,W):- female(X), wife(X,H), husband(H,W).

add_child(X,Y):- get_sup(Y,H,W), X<>H,X<>W, not(child(X,H)), not(child(X,W)), assertz(child(X,H)), assertz(child(X,W)),

write(X," ребенок ",H," и ",W),nl, not(add_brother_or_syster(X,Y)).

add_child(X,Y):-write("Противоречит правилам в базе данных"),nl.

64

show_tree(X,C):- colon(C), C1=C+1,

write(" +",X),nl, child(X,Y), get_sup(Y,H,W), male(H), female(W), show_tree(H,C1), show_tree(W,C1),

colon(C),write(" ¦"),nl,!. show_tree(X,_):- not(child(X,_)).

/** Интерфейс пользователя **/ cur(0):-cursorform(1,0). cur(1):-cursorform(13,14).

case:-

menu(0,70,126,127,["Добавить имя... ", "Добавить факт... ", "Просмотреть факты... ", "Сохранить базу данных", "О программе", "Выход"],

" Что мы умеем ",1,C), menu0(C).

menu0(X):-X<>1,X<>2,X<>3,X<>4,X<>5,X<>6,end.

menu0(1):-

menu(0,70,126,127,["Мужчина","Женщина"]," Добавить имя... ",1,C), smenu1(C),

case.

menu0(2):-

menu(0,70,126,127,["Поженить","Усыновить"]," Добавить факт... ",1,C), smenu2(C),

case.

65

menu0(3):-

menu(0,70,126,127,["Дерево","Показать детей","Показать супругов","Показать сестер","Показать братьев","Показать родителей","Показать все лица"]," Просмотреть факты... ",1,C), smenu3(C),

case.

menu0(4):-save("work7.bds"), case.

menu0(5):-

makewindow(1,10,11,"О программе",7,18,9,43), write(" Пример экспертной системы по курсу "),nl, write(" ЭКСПЕРТНЫЕ СИСТЕМЫ В САПР "),nl, write(" реализован в языке Турбо-пролог как "),nl, write(" вариант студенческой курсовой работы "),nl,nl,

write(" МИЭТ Кафедра ПКИМС - 1999 Авдеев Е. В. "), readchar(_),

removewindow,

case.

menu0(6):- end.

smenu1(X):- X<>1,X<>2, case.

smenu1(1):-

makewindow(1,30,31," Добавить мужчину ",6,20,5,40), cur(1),

write("Введите имя: "), readln(X), add_male(X), readchar(_), removewindow,

cur(0),

menu0(1),!.

66

smenu1(2):-

makewindow(1,30,31," Добавить женщину ",6,20,5,40), cur(1),

write("Введите имя: "), readln(X), add_female(X), readchar(_), removewindow,

cur(0), menu0(1).

smenu2(X):- X<>1,X<>2, case.

smenu2(1):- cur(1),

makewindow(1,30,31,"Поженить",6,15,8,50), write("Введите имя невесты: "), readln(X),nl,

write("Введите имя жениха: "), readln(Y),nl,

add_marid(X,Y), readchar(_), removewindow, cur(0), menu0(2).

smenu2(2):- cur(1),

makewindow(1,30,31,"Усыновить",6,15,8,50), write("Введите имя ребенка: "), readln(X),nl,

write("Введите имя одного из родителей: "), readln(Y),nl,

add_child(X,Y), readchar(_), removewindow, cur(0), menu0(2).

67

smenu3(X):-X<>1,X<>2,X<>3,X<>4,X<>5,X<>6,X<>7,case.

smenu3(1):- cur(1),

makewindow(1,30,31,"Генеалогическое дерево",6,5,3,60), write("Введите интересующее Вас имя: "),

readln(X),

removewindow,

makewindow(1,126,127,"Генеалогическое дерево ",1,1,20,70), show_tree(X,0),

readchar(_), removewindow, cur(0), menu0(3).

smenu3(2):- cur(1),

makewindow(1,31,31,"Показать детей",2,2,20,70), write("Введите интересующее Вас имя: "), readln(X),

show_child(X), /* init,*/ readchar(_), removewindow, cur(0), menu0(3).

smenu3(3):- cur(1),

makewindow(1,30,31,"Показать супругов",6,20,10,40), write("Имя одного из супругов: "),

readln(X),nl, show_sup(X), readchar(_), removewindow, cur(0), menu0(3).

68

smenu3(4):- cur(1),

makewindow(1,31,31,"Показать сестер",6,20,10,40), write("Интересующий Вас человек: "),

readln(X), show_syster(X), /* init,*/ readchar(_), removewindow, cur(0), menu0(3).

smenu3(5):- cur(1),

makewindow(1,31,31,"Показать братьев",6,20,10,40), write("Интересующий Вас человек: "),

readln(X), show_brother(X), /* init,*/ readchar(_), removewindow, cur(0), menu0(3).

smenu3(6):- cur(1),

makewindow(1,31,31,"Показать родителей",6,20,10,40), write("Интересующий Вас человек: "),

readln(X),nl, show_par(X), readchar(_), removewindow, cur(0), menu0(3).

smenu3(7):-

makewindow(1,126,127,"Показать все лица",1,1,23,30),

69

showall,

/*init,*/ readchar(_), removewindow, menu0(3).

end:-cursorform(13,14), exit.

GOAL cursorform(1,0),

makewindow(1,30,31,"",10,25,5,40),nl, write(" Подождите..."),

init,

70

write(" Пример экспертной системы. Кафедра ПКИМС МИЭТ-1999. Авдеев Е.В."),

case,

cursorform(13,14),

exit.

/* долговременная база знаний в файле work7.bds*/ male("Петя")

male("Вася") male("Игорь") male("Коля") male("Дима") male("Рома") female("Лена") female("Дуся") female("Аня") female("Ира") female("Оля") wife("Лена","Петя") wife("Аня","Игорь") wife("Дуся","Рома") husband("Петя","Лена") husband("Игорь","Аня") husband("Рома","Дуся") child("Вася","Петя") child("Вася","Лена") child("Оля","Петя") child("Оля","Лена") child("Ира","Петя") child("Ира","Лена") child("Петя","Игорь") child("Петя","Аня")

71