Разработка базы знаний "Результаты сессии" на языке Пролог.

Содержание
1. Задание на проектирование
2. Декларативная парадигма и язык PROLOG
3. Выбор средств разработки программы
4. Краткая характеристика программы
5. Описание базы данных фактов
6. Описание предикатов
7. Инструкция пользователя по работе с программой
8. Текст программы
9. Система тестов
Список литературы

Разработка базы знаний "Результаты сессии" на языке Пролог.

send_menu_msg(ungrey('$#session',studs),_),
send_menu_msg(grey('$#session',works),_),
send_menu_msg(ungrey('$#session',find),_),
update_bottom.
marks:-
erecord('$table',$Оценки$),
send_menu_msg(check('$#session',marks),_),
send_menu_msg(uncheck('$#session',studs),_),
send_menu_msg(uncheck('$#session',works),_),
send_menu_msg(grey('$#session',marks),_),
send_menu_msg(ungrey('$#session',studs),_),
send_menu_msg(ungrey('$#session',works),_),
send_menu_msg(grey('$#session',find),_),
update_bottom.
%---------------------------------------------------------------------
% Работа с существующей записью таблицы
%---------------------------------------------------------------------
existr:-
( recorded_one( '$table',Table,_) ; Table = $$ ),
case([
Table == $Студенты$ ->
(
recno(student,Scount),
ifthenelse(Scount =\= 0,
(
key(student, Ref),
nref(Ref, Nref),
erecord('$current',Nref),
dialog_run('$studs',ex_get_msg)
),
msg_box($Таблица "Студенты" пуста$)
)
),
Table == $Предметы$ ->
(
recno(work,Wcount),
ifthenelse(Wcount =\= 0,
(
key(work, Ref),
nref(Ref, Nref),
erecord('$current',Nref),
dialog_run('$works',ex_get_msg)
),
msg_box($Таблица "Предметы" пуста$)
)
),
Table == $Оценки$ ->
(
recno(mark,Mcount),
ifthenelse(Mcount =\= 0,
(
key(mark, Ref),
nref(Ref, Nref),
erecord('$current',Nref),
dialog_run('$marks',ex_get_msg)
),
msg_box($Таблица "Оценки" пуста$)
)
)
]).
%------------------- Обработчик сигнала обновления ------------------
ex_get_msg(update_ctrls,Key):-
[!
recorded_one( '$current',Ref,_),
instance(Ref, Term),
case([
Key == '$studs' ->
fill_stud(Term),
Key == '$works' ->
fill_work(Term),
Key == '$marks' ->
fill_mark(Term)
])
!],
fail.
%--------------------- Обработчик кнопки "вперед" -------------------
ex_get_msg(command(_,next),Key):-!,
recorded_one( '$current',Ref,_),
ifthenelse(nref(Ref, Nref),
(
instance(Nref, Term),
erecord('$current',Nref),
send_dialog_msg(ex_get_msg,update_ctrls,Key)
),
msg_box($Последняя запись$)
).
%--------------------- Обработчик кнопки "назад" --------------------
ex_get_msg(command(_,prev),Key):-!,
recorded_one( '$current',Ref,_),
ifthenelse(pref(Ref, Nref),
(
instance(Nref, Term),
erecord('$current',Nref),
send_dialog_msg(ex_get_msg,update_ctrls,Key)
),
msg_box($Первая запись$)
).
%--------------------- Обработчик кнопки "сохранить" ----------------
ex_get_msg(command(_,update),Key):-!,
recorded_one( '$current',Ref,_),
instance(Ref, Term),
arg(1,Term,Nid),
case([
Key == '$studs' ->
(
send_control_msg(ef_set_text(BookN,$$),3,Key),
atom_string(ABookN,BookN),
send_control_msg(ef_set_text(Fam,$$),5,Key),
atom_string(AFam,Fam),
send_control_msg(ef_set_text(Year,$$),7,Key),
atom_string(AYear,Year),
replace(Ref,student(Nid,ABookN,AFam,AYear)),
erecord( '$changed', `1 )
),
Key == '$works' ->
(
send_control_msg(ef_set_text(Work,$$),3,Key),
atom_string(AWork,Work),
replace(Ref,work(Nid,AWork)),
erecord( '$changed', `1 )
),
Key == '$marks' ->
(
field_to_list(student,1,L1),
field_to_list(work,1,L2),
send_control_msg(lb_set_index(Sidx,1),3,Key),
find_n(Sidx,L1,Sid),
send_control_msg(lb_set_index(Widx,1),5,Key),
find_n(Widx,L2,Wid),
send_control_msg(lb_set_index(Mid,1),7,Key),
Mark is 6-Mid,
replace(Ref,mark(Nid,Sid,Wid,Mark)),
erecord( '$changed', `1 )
)
]),
send_dialog_msg(ex_get_msg,update_ctrls,Key),
msg_box($Изменения сохранены$).
%--------------------- Обработчик кнопки "удалить" ------------------
ex_get_msg(command(_,erase),Key):-
recorded_one( '$current',Ref,_),
instance(Ref, Term),
arg(1,Term,Nid),
case([
Key == '$studs' ->
(
field_to_list(mark,2,L1),
find_ind(Nid,L1,Ret)
),
Key == '$works' ->
(
field_to_list(mark,3,L1),
find_ind(Nid,L1,Ret)
),
Key == '$marks' ->
Ret is 0
]),
ifthenelse(Ret =:= 0,
(ifthenelse(nref(Ref, Nref),
(erecord('$current',Nref),erase(Ref)),
ifthenelse(pref(Ref, Nref),
(erecord('$current',Nref),erase(Ref)),
(eraseall('$current'),erase(Ref),
msg_box($Запись удалена$),
!,exit_dbox(Key))
)
),
send_dialog_msg(ex_get_msg,update_ctrls,Key),
msg_box($Запись удалена$)
),
msg_box($Запись связана оценкой$)
).
%--------------------- Обработчик по умолчанию ----------------------
ex_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%--------------------- Заполнение формы студента --------------------
fill_stud(Term):-
arg(2,Term,ABookN),
atom_string(ABookN,BookN),
send_control_msg(ef_set_text(_,BookN),3,'$studs'),
arg(3,Term,AFam),
atom_string(AFam,Fam),
send_control_msg(ef_set_text(_,Fam),5,'$studs'),
arg(4,Term,AYear),
atom_string(AYear,Year),
send_control_msg(ef_set_text(_,Year),7,'$studs').
%--------------------- Заполнение формы предмета --------------------
fill_work(Term):-
arg(2,Term,AWork),
atom_string(AWork,Work),
send_control_msg(ef_set_text(_,Work),3,'$works').
%--------------------- Заполнение формы оценки ----------------------
fill_mark(Term):-
arg(2,Term,Sid),
send_control_msg(lb_clear,3,'$marks'),
field_to_list(student,3,L1),
field_to_list(student,1,L3),
find_ind(Sid,L3,N1),
lb_add_list(L1,3,'$marks'),
send_control_msg(lb_set_index(_,N1),3,'$marks'),
arg(3,Term,Wid),
send_control_msg(lb_clear,5,'$marks'),
field_to_list(work,2,L2),
field_to_list(work,1,L4),
find_ind(Wid,L4,N2),
lb_add_list(L2,5,'$marks'),
send_control_msg(lb_set_index(_,N2),5,'$marks'),
arg(4,Term,Mark),
N3 is 6-Mark,
send_control_msg(lb_set_index(_,N3),7,'$marks').
%---------------------------------------------------------------------
% Работа с новой записью таблицы
%---------------------------------------------------------------------
newr:-
( recorded_one( '$table',Table,_) ; Table = $$ ),
ifthenelse(Table == $Студенты$,
dialog_run('$studs_n',nw_get_msg),
ifthenelse(Table == $Предметы$,
dialog_run('$works_n',nw_get_msg),
ifthen(Table == $Оценки$,
(recno(student,Scount),
recno(work,Wcount),
ifthenelse(Scount =\= 0,
ifthenelse(Wcount =\= 0,
dialog_run('$marks_n',nw_get_msg),
msg_box($Таблица "Предметы" не заполнена$)
),
msg_box($Таблица "Студенты" не заполнена$)
))
)
)
).
%------------------- Обработчик сигнала обновления ------------------
nw_get_msg(update_ctrls,Key):-
[!
ifthen(Key == '$marks_n',
(
send_control_msg(lb_clear,3,Key),
field_to_list(student,3,L1),
lb_add_list(L1,3,Key),
send_control_msg(lb_clear,5,Key),
field_to_list(work,2,L2),
lb_add_list(L2,5,Key)
)
)
!],
fail.
%------------------ Заполнение listbox по списку --------------------
lb_add_list([H|T],Pos,Key):-
send_control_msg(lb_add_string(H),Pos,Key),
lb_add_list(T,Pos,Key).
lb_add_list([],Pos,Key).
%--------------------- Обработчик кнопки "сохранить" ----------------
nw_get_msg(command(_,insert),Key):-
case([
Key == '$studs_n' ->
insert_st_rec(Key),
Key == '$works_n' ->
insert_wr_rec(Key),
Key == '$marks_n' ->
insert_mr_rec(Key)
]),
!,
exit_dbox(Key).
%--------------------- Обработчик по умолчанию ----------------------
nw_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%--------------------- Добавление записи студента -------------------
insert_st_rec(Key):-
( recorded_one( '$studid',Id,_) ; Id is 0 ),
send_control_msg(ef_set_text(BookN,$$),3,Key),
atom_string(ABookN,BookN),
send_control_msg(ef_set_text(Fam,$$),5,Key),
atom_string(AFam,Fam),
send_control_msg(ef_set_text(Year,$$),7,Key),
atom_string(AYear,Year),
inc(Id,Nid), erecord('$studid',Nid),
recordz(student,student(Nid,ABookN,AFam,AYear),_),
erecord( '$changed', `1 ).
%--------------------- Добавление записи предмета -------------------
insert_wr_rec(Key):-
( recorded_one( '$workid',Id,_) ; Id is 0 ),
send_control_msg(ef_set_text(Work,$$),3,Key),
atom_string(Awork,Work),
inc(Id,Nid), erecord('$workid',Nid),
recordz(work,work(Nid,Awork),_),
erecord( '$changed', `1 ).
%---------------------- Добавление записи оценки --------------------
insert_mr_rec(Key):-
( recorded_one( '$markid',Id,_) ; Id is 0 ),
field_to_list(student,1,L1),
field_to_list(work,1,L2),
send_control_msg(lb_set_index(Sidx,1),3,Key),
find_n(Sidx,L1,Sid),
send_control_msg(lb_set_index(Widx,1),5,Key),
find_n(Widx,L2,Wid),
send_control_msg(lb_set_index(Mid,1),7,Key),
Mark is 6-Mid,
inc(Id,Nid), erecord('$markid',Nid),
recordz(mark,mark(Nid,Sid,Wid,Mark),_),
erecord( '$changed', `1 ).
%---------------------------------------------------------------------
% Поиск
%---------------------------------------------------------------------
find:-
dialog_run('$find',fn_get_msg).
%--------------------- Обработчик кнопки "начать" --------------------
fn_get_msg(command(_,findrec),Key):-
( recorded_one( '$table',Table,_) ; Table = $$ ),
send_control_msg(ef_set_text(Pattern,$$),3,Key),
atom_string(APattern,Pattern),
send_control_msg(cb_set_val(Mode,unchecked),4,Key),
erecord('$found',$no$),
case([
Table == $Студенты$ ->
(
for(2,4,I),
field_to_list(student,I,L),
ifthenelse(Mode = checked,
find_pat(APattern,L,Ret),
find_ind(APattern,L,Ret)
),
ifthen(Ret =\= 0,
(
nth_ref(student,Ret,Ref),
erecord('$current',Ref),
erecord('$found',$yes$),
dialog_run('$studs',ex_get_msg),
fail
)
),
fail; true
),
Table == $Предметы$ ->
(
field_to_list(work,2,L),
ifthenelse(Mode = checked,
find_pat(APattern,L,Ret),
find_ind(APattern,L,Ret)
),
ifthen(Ret =\= 0,
(
nth_ref(work,Ret,Ref),
erecord('$current',Ref),
erecord('$found',$yes$),
dialog_run('$works',ex_get_msg)
)
)
)
]),
(recorded_one( '$found',Found,_) ; Found = $no$ ),
ifthen(Found == $no$,msg_box($Образец не найден$)),
!,
exit_dbox(Key).
%--------------------- Обработчик по умолчанию ----------------------
fn_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%---------------------------------------------------------------------
% Выполнение запросов
%---------------------------------------------------------------------
%req0:- % запрос использовался на стадии отладки
% dialog_run('$req0',rq_get_msg).
req1:-
dialog_run('$req1',rq_get_msg).
req2:-
dialog_run('$req2',rq_get_msg).
req3:-
dialog_run('$req3',rq_get_msg).
req4:-
dialog_run('$req4',rq_get_msg).
%------------------- Обработчик сигнала обновления ------------------
rq_get_msg(update_ctrls,Key):-
[!
ifthen(Key == '$req2',
(
send_control_msg(lb_clear,5,Key),
field_to_list(work,2,L1),
lb_add_list(L1,5,Key)
)
)
!],
fail.
%------------------- Обработчик кнопки "Выполнить" ------------------
rq_get_msg(command(_,doit),Key):-
case([
% Key == '$req0' -> % запрос использовался на стадии отладки
% (
% eraseall('$res_text'),
% recno(student,Rn1),
% int_text(Rn1,Srn1),
% concat($Записей в таблице "Студенты": $,Srn1,Line),
% recordz('$res_text',Line,_),
% recorded(student, X, _),
% string_term(Line1,X),
% recordz('$res_text',Line1,_),
% fail; true,
% recordz('$res_text',$$,_),
% recno(work,Rn2),
% int_text(Rn2,Srn2),
% concat($Записей в таблице "Предметы": $,Srn2,Line),
% recordz('$res_text',Line,_),
% recorded(work, X, _),
% string_term(Line1,X),
% recordz('$res_text',Line1,_),
% fail; true,
% recordz('$res_text',$$,_),
% recno(mark,Rn3),
% int_text(Rn3,Srn3),
% concat($Записей в таблице "Оценки": $,Srn3,Line),
% recordz('$res_text',Line,_),
% recorded(mark, X, _),
% string_term(Line1,X),
% recordz('$res_text',Line1,_),
% fail; true,
% tmove(0,0),
% dialog_run( '$dres', def_dialog_fn )
% ),
Key == '$req1' ->
(
send_control_msg(ef_set_text(Year,$$),5,Key),
int_text(IYear,Year),
eraseall('$res_text'),
recordz('$res_text',$Список студентов, поступивших в университет не ранее,$,_),
concat($чем в $,Year,Line),
concat(Line,$ году.$,Line1),
recordz('$res_text',Line1,_),
recordz('$res_text',$$,_),
recordz('$res_text',$Номер зачетки Фамилия И.О. Год поступления$,_),
recorded(student, X, _),
arg(4,X,Yr),
atom_string(Yr,Syr),
int_text(Iyr,Syr),
Iyr >= IYear,
arg(2,X,Nr),
atom_string(Nr,Snr),
arg(3,X,Fam),
atom_string(Fam,Sfam),
concat(Snr,$ $,Line2),
concat(Line2,Sfam,Line3),
concat(Line3,$ $,Line4),
concat(Line4,Syr,Line5),
recordz('$res_text',Line5,_),
fail; true,
tmove(0,0),
dialog_run( '$dres', def_dialog_fn )
),
Key == '$req2' ->
(
send_control_msg(lb_set_index(Widx,1),5,Key),
send_control_msg(lb_set_index(Midx,1),7,Key),
Mark is 6-Midx,
field_to_list(work,1,L1),
field_to_list(work,2,L2),
[!
find_n(Widx,L1,Wid),
find_n(Widx,L2,Work)
!],
atom_string(Work,Swork),
int_text(Mark,Smark),
eraseall('$res_text'),
concat($Список студентов, имеющих по $,Swork,Line1),
concat($оценку не ниже $,Smark,Line2),
recordz('$res_text',Line1,_),
recordz('$res_text',Line2,_),
recordz('$res_text',$$,_),
recorded(student,X,_),
arg(1,X,IdS),
arg(3,X,Fa),
atom_string(Fa,Sfa),
get_mark(IdS,Wid,Mr),
ifthen(Mr >= Mark,
recordz('$res_text',Sfa,_)
),
fail;true,
tmove(0,0),
dialog_run( '$dres', def_dialog_fn )
),
Key == '$req3' ->
(
eraseall('$res_text'),
recordz('$res_text',$Список студентов, имеющих не менее двух пятерок.$,_),
recordz('$res_text',$$,_),
recorded(student,X,_),
arg(1,X,Id),
arg(3,X,Fa),
atom_string(Fa,Sfa),
count_marks1(Id,Num),
ifthen(Num > 1, % здесь установлено количество оценок
recordz('$res_text',Sfa,_)
),
fail;true,
tmove(0,0),
dialog_run( '$dres', def_dialog_fn )
),
Key == '$req4' ->
(
eraseall('$res_text'),
recordz('$res_text',$Средний балл студентов по предметам.$,_),
recordz('$res_text',$$,_),
recorded(work,X,_),
arg(1,X,Id),
arg(2,X,Wr),
atom_string(Wr,Swr),
count_marks2(Id,Num,Total),
concat(Swr,$ $,Line1),
ifthenelse(Num \= 0,
(Sr is Total/Num,
float_text(Sr,Ssr,fixed(2)),
concat(Line1,Ssr,Line2)),
concat(Line1,$$,Line2)
),
recordz('$res_text',Line2,_),
fail;true,
tmove(0,0),
dialog_run( '$dres', def_dialog_fn )
)
]),
!,exit_dbox(Key).
%--------------------- Обработчик по умолчанию ----------------------
rq_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%-------------- Подсчет количества оценок по студенту ---------------
count_marks1(Id,Num):-
ifthenelse(key(mark, Ref),
ifthenelse(nref(Ref, Nref),
c_m1(Nref,Id,Num),
(Num is 0,true)
),
(Num is 0,true)
).
c_m1(Ref,Id,N):-
instance(Ref, Term),
arg(2,Term,Idx),
arg(4,Term,Mr),
ifthenelse(nref(Ref,Nref),
c_m1(Nref,Id,N1),
N1 is 0
),
ifthenelse((Idx == Id,Mr > 4), % здесь установлено, что это пятерки
N is N1+1,
N is N1
).
%---------- Подсчет количества и суммы оценок по предмету -----------
count_marks2(Id,Num,Total):-
ifthenelse(key(mark, Ref),
ifthenelse(nref(Ref, Nref),
c_m2(Nref,Id,Num,Total),
(Num is 0,Total is 0,true)
),
(Num is 0,Total is 0,true)
).
c_m2(Ref,Id,N,T):-
instance(Ref, Term),
arg(3,Term,Idx),
arg(4,Term,Mr),
ifthenelse(nref(Ref,Nref),
c_m2(Nref,Id,N1,T1),
(N1 is 0, T1 is 0)
),
ifthenelse(Idx == Id,
(N is N1+1,T is T1+Mr),
(N is N1,T is T1)
).
%----- Запрос оценки заданного студента по заданному предмету -------
get_mark(IdS,IdW,Mark):-
ifthenelse(key(mark, Ref),
ifthenelse(nref(Ref, Nref),
g_m(Nref,IdS,IdW,Mark),
(Mark is 0,true)
),
(Mark is 0,true)
).
g_m(Ref,IdS,IdW,M):-
instance(Ref, Term),
arg(2,Term,IdxS),
arg(3,Term,IdxW),
arg(4,Term,Mr),
ifthenelse((IdxS == IdS,IdxW == IdW),
M is Mr,
ifthenelse(nref(Ref,Nref),
(g_m(Nref,IdS,IdW,M1),M is M1),
M is 0
)
).
%---------------------------------------------------------------------
% Запрашиваем пользователя о необходимости сохранения текущей базы
%---------------------------------------------------------------------
save_before( Name ) :-
( recorded_one( '$changed',Changed, _) ; Changed = `0 ),
ifthen(Changed =\= `0,
dialog_run('$file_req',sv_get_msg)
).
%------------------- Обработчик сигнала обновления ------------------
sv_get_msg(update_ctrls,Key):-
[!
(recorded_one('$file',FileName,_);FileName=$$),
send_control_msg(text_set(_,FileName),1,Key)
!],
fail.
%----------------------- Обработчик кнопки "ОК" ---------------------
sv_get_msg(command(_,yes),Key):-
save_fileas,
!,exit_dbox(Key).
%--------------------- Обработчик по умолчанию ----------------------
sv_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%---------------------------------------------------------------------
% Обновляем статусную строку
%---------------------------------------------------------------------
update_bottom :-
( recorded_one( '$file', FileName, _) ; FileName = $$ ),
( recorded_one( '$changed',Changed, _) ; Changed = `0 ),
( recorded_one( '$table',Table, _) ; Table = $$ ),
current_window( Curr, dbottom ),
nl,
write( $База данных: $),
write( FileName ),
ifthen(Changed =\= `0,
write($:*$)
),
tab( 5 ),
write( $ Таблица: $) ,
write( Table ),
current_window( _, Curr ),
!.
%---------------------------------------------------------------------
% Диалог вывода сообщения
%---------------------------------------------------------------------
msg_box(String):-
recorda( '$msg', String, _ ),
dialog_run('$msg_box',ms_get_msg).
%------------------- Обработчик сигнала обновления ------------------
ms_get_msg(update_ctrls,Key):-
[!
recorded_tro( '$msg', String, _ ),
eraseall( '$msg' ),
send_control_msg(text_set(_,String),1,Key)
!],
fail.
%--------------------- Обработчик по умолчанию ----------------------
ms_get_msg(Msg,Key):-def_dialog_fn(Msg,Key).
%---------------------------------------------------------------------
% Вывод строк указанной таблицы в указанный файл
%---------------------------------------------------------------------
list_recs(H,Key):-
ifthenelse(key(Key, Ref),
ifthenelse(nref(Ref, Nref),
lst_r(H,Nref),
true
),
true
).
lst_r(H,Ref):-
instance(Ref, Term),
writeq(H,Term), nl(H),
ifthenelse(nref(Ref,Nref),
lst_r(H,Nref),
true
).
%---------------------------------------------------------------------