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

%--------------------- Обработчик по умолчанию ----------------------
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
).

%---------------------------------------------------------------------
% Преобразование указанного поля указанной таблицы в список
%---------------------------------------------------------------------
field_to_list(Key,Pos,L):-
ifthenelse(key(Key, Ref),
ifthenelse(nref(Ref, Nref),
f_lst(Nref,Pos,L),
true
),
true
).
f_lst(Ref,Pos,[F|L]):-
instance(Ref, Term),
arg(Pos,Term,F),
ifthenelse(nref(Ref,Nref),
f_lst(Nref,Pos,L),
L=[]
).

%---------------------------------------------------------------------
% Подсчет количества записей в указанной таблице
%---------------------------------------------------------------------
recno(Key,Rn):-
ifthenelse(key(Key, Ref),
ifthenelse(nref(Ref, Nref),
r_count(Nref,Rn),
Rn is 0
),
Rn is 0
).
r_count(Ref,Rn):-
ifthenelse(nref(Ref,Nref),
(r_count(Nref,Trn),
Rn is Trn+1
),
Rn is 1
).

%---------------------------------------------------------------------
% Предикаты работы со списками
%---------------------------------------------------------------------

%---------------------------- Вывод списка ---------------------------
%write_list([H|T]):- % использовался при отладке
% write(H),
% write(' '),
% write_list(T).
%write_list([]).

%-------------------- Конкатенация списков ---------------------------
%append([N|L1],L2,[N|L3]):- % использовался при отладке
% append(L1,L2,L3).
%append([],L,L).

%----------------- Поиск элемента списка по номеру -------------------
find_n(N,[H|T],V):-
N1 is N-1,
N1 > 0,
find_n(N1,T,V).
find_n(_,[H|_],H).

%----------- Определение факта присутствия элемента в списке ---------
%find_it(_,[],0). % использовался при отладке
%find_it(H,[H|_],1).
%find_it(H,[_|T],X):-
% find_it(H,T,X).

%------------ Определение номера элемента в списке -------------------
find_ind(_,[],0).
find_ind(H,[H|_],1).
find_ind(H,[_|T],X):-
find_ind(H,T,X1),
ifthenelse(X1 =\= 0,
X is X1+1,
X is 0
).

%--- Определение номера элемента в списке по частичному совпадению ---
%------------------------- с образцом --------------------------------
find_pat(_,[],0).
find_pat(P,[H|T],X):-
atom_string(H,S),
atom_string(P,F),
ifthenelse(string_search(F,S,_),
X is 1,
(find_pat(P,T,X1),
ifthenelse(X1 =\= 0,
X is X1+1,
X is 0
))
).

%---------------------------------------------------------------------
% Предикаты для организации цикла
%---------------------------------------------------------------------
for(I, I, I) :- !.
for(I, _, I).
for(I, J, K) :- inc(I, I1), for(I1, J, K).

Файл utils.ari, урезанный (DIALOG BOX EDITOR v1.0 – UTILITIES).
:- module( utils ).

:- public
repos_window/2:far,
erecord/2:far,
erecorded/2:far,
recorded_one/3:far.

:- mode repos_window(+,+).
:- mode erecord(+,+).
:- mode erecorded(+,?/+).
:- mode recorded_one(+,-/+,-/+).

%-----------------------------------------------------------------
% Изменение размера и перемещение текущего окна
%-----------------------------------------------------------------
repos_window((Row1,Col1),(Row2,Col2)) :-
Row1 >= 0,
Row2 > Row1,
Row2 =< 24,
Col1 >= 0,
Col2 > Col1,
Col2 =< 79,
window_info(_,_,(X1,Y1),(X2,Y2),_),
MvXDir is Row1 - X1,
MvYDir is Col1 - Y1,
ResXDir is (Row2 - Row1) - (X2 - X1),
ResYDir is (Col2 - Col1) - (Y2 - Y1),
!,
repos_aux( MvXDir, MvYDir, ResXDir, ResYDir ).

repos_aux( MX, MY, RX, RY ) :-
MX < 0,
!,
move_window( MX, 0 ),
repos_aux( 0, MY, RX, RY ).
repos_aux( MX, MY, RX, RY ) :-
MY < 0,
!,
move_window( 0, MY ),
repos_aux( MX, 0, RX, RY ).
repos_aux( MX, MY, RX, RY ) :-
RX < 0,
ifthen( resize_window( RX, 0 ), true ),
repos_aux( MX, MY, 0, RY ).
repos_aux( MX, MY, RX, RY ) :-
RY < 0,
ifthen(resize_window( 0, RY ), true ),
repos_aux( MX, MY, RX, 0 ).
repos_aux( MX, MY, RX, RY ) :-
ifthen(resize_window( RX, RY ), true),
move_window( MX, MY ).

%---------------------------------------------------------------------
% Удаляем все термы по ключу и записываем по нему новый терм
%---------------------------------------------------------------------
erecord( Key, Term ) :-
eraseall( Key ),
recordz( Key, Term, _ ).

%---------------------------------------------------------------------
% Возвращаем терм, записанный по ключу и удаляем его
%---------------------------------------------------------------------
erecorded( Key, Term ) :-
recorded_one( Key, Term, Ref ),
hard_erase( Ref ),
!.

%---------------------------------------------------------------------
% Возвращаем терм, записанный по ключу
%---------------------------------------------------------------------
recorded_one( Key, Term, Ref ) :-
key( Key, KeyRef ),
nref( KeyRef, Ref ),
instance( Ref, Term ).

Файл getkey.ari (DIALOG BOX EDITOR v1.0 -- GET KEY), включен в проект полностью без модификации.
%%% DIALOG BOX EDITOR v1.0 -- GET KEY
%%%
%%% Copyright (C) 1988 Arity Corporation
%%%
%%% 3/12/88 JBG
%%%

:- module( getkey ).

:- segment( dlgseg ).

:- public
get_key/1:far.

:- mode get_key( -/+ ).
:- mode key_val( +, +, -/+ ).
:- mode key0_val( +, -/+ ).
:- mode function( +, -/+ ).
:- mode shft_function( +, -/+ ).
:- mode ctrl_function( +, -/+ ).
:- mode alt_function( +, -/+ ).

%%%
%%% get_key( -/+Key )
%%%
%%% Get a key from the user in special format
%%%

get_key( Key ) :-
keyb( Ascii, Scan ),
!,
key_val( Ascii, Scan, Key ).


%%%
%%% key_val( +Asci, +Scan, -/+Formatted )
%%%
%%% Take the Ascii value and Scan code of the key pressed and convert it
%%% to the special Formatted return value.
%%%

key_val( 0, Scan, Formatted ) :- !, key0_val(Scan, Formatted).
key_val( 13, 28, enter ) :- !.
key_val( 27, 1, esc ) :- !.
key_val( 255, 1, alt ) :- !.
key_val( 9, 15, tab ) :- !.
key_val( 48, 82, shft_insert ) :- !.
key_val( 46, 83, shft_delete ) :- !.
key_val( 32, 57, space ) :- !.
key_val( 8, 14, back ) :- !.
key_val( 55, 71, shft_numeric( upleft ) ) :- !.
key_val( 56, 72, shft_numeric( up ) ) :- !.
key_val( 57, 73, shft_numeric( upright ) ) :- !.
key_val( 52, 75, shft_numeric( left ) ) :- !.
key_val( 54, 77, shft_numeric( right ) ) :- !.
key_val( 49, 79, shft_numeric( downleft ) ) :- !.
key_val( 50, 80, shft_numeric( down ) ) :- !.
key_val( 51, 81, shft_numeric( downright )) :- !.
key_val( A, S, keyb(A,S)) :- !.

%%%
%%% key0_val( +ScanCode, -/+Formatted
%%%

key0_val( 15, shft_tab ) :- !.
key0_val( 82, insert ) :- !.
key0_val( 83, delete ) :- !.
key0_val( 71, numeric( upleft ) ) :- !.
key0_val( 72, numeric( up ) ) :- !.
key0_val( 73, numeric( upright ) ) :- !.
key0_val( 75, numeric( left ) ) :- !.
key0_val( 77, numeric( right ) ) :- !.
key0_val( 79, numeric( downleft ) ) :- !.
key0_val( 80, numeric( down ) ) :- !.
key0_val( 81, numeric( downright )) :- !.
key0_val( Fn, function( Num ) ) :- function( Fn, Num ), !.
key0_val( Fn, shft_function( Num )) :- shft_function( Fn, Num ), !.
key0_val( Fn, ctrl_function( Num )) :- ctrl_function( Fn, Num ), !.
key0_val( Fn, alt_function( Num ) ) :- alt_function( Fn, Num ), !.
key0_val( S, alt(S) ) :- !.

%%%
%%% function( +Scan, -/+Function )
%%%
%%% Return the Function key number corresponding the Scan code.
%%%

function( 59, 1 ) :- !.
function( 60, 2 ) :- !.
function( 61, 3 ) :- !.
function( 62, 4 ) :- !.
function( 63, 5 ) :- !.
function( 64, 6 ) :- !.
function( 65, 7 ) :- !.
function( 66, 8 ) :- !.
function( 67, 9 ) :- !.
function( 68, 0 ) :- !.

%%%
%%% shft_function( +Scan, -/+Function )
%%%
%%% Return the shifted Function key number corresponding the Scan code.
%%%

shft_function( 84, 1 ) :- !.
shft_function( 85, 2 ) :- !.
shft_function( 86, 3 ) :- !.
shft_function( 87, 4 ) :- !.
shft_function( 88, 5 ) :- !.
shft_function( 89, 6 ) :- !.
shft_function( 90, 7 ) :- !.
shft_function( 91, 8 ) :- !.
shft_function( 92, 9 ) :- !.
shft_function( 93, 0 ) :- !.

%%%
%%% ctrl_function( +Scan, -/+Function )
%%%
%%% Return the controled Function key number corresponding the Scan code.
%%%

ctrl_function( 94, 1 ) :- !.
ctrl_function( 95, 2 ) :- !.
ctrl_function( 96, 3 ) :- !.
ctrl_function( 97, 4 ) :- !.
ctrl_function( 98, 5 ) :- !.
ctrl_function( 99, 6 ) :- !.
ctrl_function( 100, 7 ) :- !.
ctrl_function( 101, 8 ) :- !.
ctrl_function( 102, 9 ) :- !.
ctrl_function( 103, 0 ) :- !.


%%%
%%% alt_function( +Scan, -/+Function )
%%%
%%% Return the alternate Function key number corresponding the Scan code.
%%%

alt_function( 104, 1 ) :- !.
alt_function( 105, 2 ) :- !.
alt_function( 106, 3 ) :- !.
alt_function( 107, 4 ) :- !.
alt_function( 108, 5 ) :- !.
alt_function( 109, 6 ) :- !.
alt_function( 110, 7 ) :- !.
alt_function( 111, 8 ) :- !.
alt_function( 112, 9 ) :- !.
alt_function( 113, 0 ) :- !.

%%%
%%% END OF DIALOG BOX EDITOR -- GETKEY
%%%

Файл getfile.ari (GET FILENAME 1/26/88 JBG), включен в проект полностью; доработан, добавлена возможность задавать начальное имя файла при вызове файлового диалога.
%%%
%%% GET FILENAME
%%% 1/26/88 JBG
%%%

:- segment(dlgseg).

:- public
getfile/4:far.

:- visible fname_dfn/2.

:- extrn
sortkey/1:far,
fileparse/5:evalpost,
string_lower/2:evalpost,
string_upper/2:evalpost.


:- mode get_filename( +, +, - ).
:- mode fname_dfn( +, + ).
:- mode change_dir( + ).
:- mode do_file( +, +, ? ).
:- mode fill( +, + ).
:- mode precorded( + ).
:- mode get_pathname( -/+ ).

%%%
%%% getfile( +Message, +DirSpec, +InitFileName, -FileName )
%%%
% Дополнено параметром +InitFileName чтобы можно было задавать
% некоторое начальное имя для диалога "Сохранить как...
getfile( Command, DirSpec, InitFileName, File ) :-
eraseall( '$dirspec' ),
recorda( '$dirspec', DirSpec, _ ),
recorda( '$temp', Command, _ ),
recorda( '$tmpfn', InitFileName, _ ), % добавлено
disk( OldDisk ),
chdir( OldDir ),

fileerrors( Old, off ),

dialog_run( '$!filename', fname_dfn ),

fileerrors( off, Old ),

chdir( OldDir ),
disk( OldDisk ),

recorded_tro( '$temp', File, Ref ),
hard_erase( Ref ),
!.

%%%
%%% fname_dfn( +Msg, +Key )
%%%

fname_dfn( update_ctrls, _ ) :-
[!
recorded_tro( '$temp', Command, _ ),
eraseall( '$temp' ),
% добавлено ------------------------------------------------------
recorded_tro( '$tmpfn', InitFileName, _ ), %
eraseall( '$tmpfn' ), %
send_control_msg( ef_set_text(_,InitFileName), 3, '$!filename' ),%
% добавлено ------------------------------------------------------
send_control_msg( text_set(_,Command), 1, '$!filename' ),
recorded_tro( '$dirspec', DirSpec, Ref ),
hard_erase( Ref ),
change_dir( DirSpec ),
get_pathname( Pathname ),
send_control_msg( text_set(_,Pathname), 4, '$!filename' ),
send_control_msg( lb_set_index(_,1), 5, '$!filename' )
!],
fail.
fname_dfn( command(_,cancel), _ ) :-
send_control_msg( ef_set_text(_,$$), 3,'$!filename' ),
eraseall( '$temp' ),
fail.
fname_dfn( command(_,ok), _ ) :-
send_control_msg( ef_set_text(Text,$$), 3, '$!filename' ),
change_dir( Text ),
get_pathname( Pathname ),
send_control_msg( text_set(_,Pathname), 4, '$!filename' ),
send_control_msg( lb_set_index(_,1), 5, '$!filename' ),
send_control_msg( update, 3, '$!filename' ),
send_control_msg( update, 4, '$!filename' ),
send_control_msg( update, 5, '$!filename' ),
!.
fname_dfn( lb_nt(_,_,Text,_), _ ) :-
[!
send_control_msg( ef_set_text(_,Text), 3, '$!filename' ),
send_control_msg( update, 3, '$!filename' )
!],
fail.
fname_dfn( Msg, Key ) :-
def_dialog_fn( Msg, Key ).

%%%
%%% change_dir( +Input )
%%%

change_dir( $$ ) :- !.
change_dir( $.$ ) :- !.
change_dir( Input ) :-
string_upper( Input, Input1 ),
eraseall( '$temp' ),
eraseall( '$temp1' ),
fileparse( Input1, Disk, Path, File, Ext ),
ifthenelse( Disk = 0,
true,
disk( Disk )
),
case([
Path = $$ -> true,
Path = $\$ -> chdir( $\$ )
|
(
string_length( Path, Len ),
dec( Len, Len1 ),
substring( Path, 0, Len1, NwPath ),
chdir( NwPath )
)
]),
chdir( X ),
do_file( File, Ext, X ).

%%%
%%% do_file( +File, +Ext, +Path )
%%%

do_file( $$, $$, _ ) :-
!,
recorded_tro( '$dirspec', FILE/EXT, _ ),
fill( FILE,EXT ).
do_file( $$, $ $, _ ) :-
!,
do_file( $$,$$,$$).
do_file( $$, $.$, _ ) :-
!,
ifthen( chdir( $..$ ), true ),
do_file( $$,$$,$$).
do_file( $*$, EXT, _ ) :-
!,
fill( $*$,EXT ).
do_file( FILE, $*$, _ ) :-
!,
fill( FILE, $*$ ).
do_file( File, $$, Path ) :-
directory( $*.$, File, 16, _,_,_ ),
!,
ifthen( chdir( File ), true ),
recorded_tro( '$dirspec', FILE/EXT, _ ),
fill( FILE,EXT ).
do_file( File, Ext, Path ) :-
string_length( Path, Len ),
recorded_tro( '$dirspec', _/EXT, _ ),
ifthenelse( Ext = $$,
Ext1 = EXT,
Ext1 = Ext
),
dec( Len, Len1),
ifthenelse( nth_char( Len1, Path, `\ ),
concat( [Path, File, `., Ext1], Filename ),
concat( [Path, `\, File, `., Ext1], Filename )
),
string_upper( Filename, UFilename ),
eraseall( '$temp' ),
recordz( '$temp', UFilename, _ ),
!,
fail.

%%%
%%% fill( +File, +Ext )
%%%

fill( File, Ext ) :-
concat( [File, `., Ext], DirSpec ),
eraseall( '$dirspec' ),
recordz( '$dirspec', File/Ext, _ ),
add_dir( DirSpec ),
sortkey( '$temp' ),
!,
fill.

%%%
%%% add_dir( Dirspec )
%%%

add_dir( DirSpec ) :-
directory( DirSpec, File, Mode,_,_,_),
ifthenelse( 16 is Mode /\ 16,
true,
(
string_lower( File, String ),
recordz( '$temp', String, _ )
)),
fail.
add_dir( _ ).

%%%
%%% fill
%%%

fill :-
directory( $*.$, Name, 16,_,_,_),
recordz( '$temp1', Name, _ ),
fail.
fill :-
sortkey( '$temp1' ),
nth_ref( '$temp1', -1, Ref ),
precorded( Ref ).
fill :-
ifthenelse( recorded( '$temp', $.$, _ ),
true,
recorda( '$temp', $.$, _ )
).

%%%
%%% precorded( +Ref )
%%%

precorded( Ref ) :-
instance( Ref, Term ),
recorda( '$temp', Term, _),
pref( Ref, PRef ),
!,
precorded( PRef ).

%%%
%%% get_pathname( -/+Pathname )
%%%

get_pathname( Pathname ) :-
recorded_tro( '$dirspec', File/Ext,_ ),
chdir( Path ),
string_length( Path, Len ),
dec( Len, Len1),
ifthenelse( nth_char( Len1, Path, `\ ),
concat( [Path, File, `., Ext], Path1 ),
concat( [Path, `\, File, `., Ext], Path1 )
),
string_upper( Path1, Pathname ),
!.

%%%
%%% END OF GET FILENAME
%%%
Система тестов
В качестве тестового набора для программы использовались данные, приведенные в таблицах 9.1–9.3.
Таблица 9.1. Список студентов
Номер зачетной книжки Фамилия, Имя, Отчество Год поступления в университет 1234 Иванов Иван 2009 7890 Петров Петр 2008 4567 Сидоров Сидор 2009 2345 Мишкин Александр 2007

Таблица 9.2. Список предметов
Наименование предмета Математика Физика Программирование Философия
Таблица 9.3. Список оценок студентов по предметам
Предмет/студент Математи-ка Физика Програм-мирование Филосо-фия Иванов Иван 5 4 5 Петров Петр 4 3 4 Сидоров Сидор 5 5 4 Мишкин Александр 3 Средний балл 4,67 3,75 4,33
Из таблицы 9.1 видно, что при выполнении запроса типа 1 (список студентов, поступивших в университет не раньше, чем в указанном пользователем году) с указанием 2008 года мы должны получить список:
Иванов Иван
Петров Петр
Сидоров Сидор
Из таблицы 9.3 видно, что при выполнении запроса типа 2 (список студентов, имеющих по заданному пользователем предмету оценку не ниже, чем заданная пользователем) с указанием предмета Физика, оценка 4 мы должны получить список:
Иванов Иван
Сидоров Сидор
Из таблицы 9.3 видно, что при выполнении запроса типа 3 (список студентов, имеющих не менее двух пятерок) мы должны получить список:
Иванов Иван
Сидоров Сидор
Из таблицы 9.3 видно, что при выполнении запроса типа 4 (средний балл студентов по каждому из предметов) мы должны получить список:
Математика 4,67
Физика 3,75
Программирование 4,33
Философия
Список литературы

Першиков В.И., Савинков В.М. Толковый словарь по информатике. - М.: Финансы и статистика, 1991. - 543 с.
Информатика и программирование шаг за шагом. Шаг 48. Деларативная (логическая) парадигма. – Кафедра информационных технологий Курганского государственного университета: http://it.kgsu.ru/Lisp/lisp0048.html
Описание языка Arity/Prolog – prolog.cab, prolog2.cab
Wiki-система по системе программирования Visual Prolog http://wikiru.visual-prolog.com
Черри С., Готлоб Г., Танка Л. Логическое программирование и базы данных: Пер. с англ. – М.: Мир, 1992. – 352 с., ил.
Братко И. Программирование на языке Пролог для искусственного интеллекта: Пер. с англ. – М.: Мир, 1990. – 560 с., ил.
Стобо Дж. Язык программирования Пролог: Пер. с англ. – М.: Радио и связь, 1993. – 368 с., ил.
В.В.Терехин TURBO PROLOG: Учебное пособие – Новокузнецк: Кемеровский государственный университет, 2005. – 119 с.
М.В.Бураков Язык логического программирования Пролог: Методические указания к выполнению лабораторных работ – СПб: Санкт-Петербургский государственный университет аэрокосмического приборостроения, 2003. – 37 с.











65