Система "Посредник"
nl,
best2(N,Np,_,_),
поставщик(Np,Firm,_,_,_,_,_,_),nl,
write("Наиболее предпочтительный"),nl,
write("контракт с фирмой: ",Firm),nl,
cursor(22,26),
write("Нажмите на любую клавишу"),
readchar(_),
clearwindow,!.
/* Проверяет, есть ли контракты */
checkcontr(N):-contract(N,_).
/* Процедура формирования наиболее предпочтительного контракта */
form_best(N,Np,S,Srok):- Na=N,
best(Na,Np1,S1,Srok1),S=S1,
assertz(best(Na,Np,S,Srok)),!.
form_best(N,Np,S,Srok):- Na=N,
best(Na,Np1,S1,Srok1),S>S1,fb1(Na,Np,S,Srok),
assertz(best(Na,Np,S,Srok)),!.
form_best(_,_,_,_).
fb1(N,_,_,_):-
retract(best(N,_,_,_)),fail.
fb1(_,_,_,_).
form_best2(N):-
best(N,Np,S,Srok),f_b2(N,Np,S,Srok),fail.
form_best2(_).
f_b2(N,Np,S,Srok):- Na=N,
best2(Na,Np1,_,Srok1),Srok1>Srok,
fb2(Na,Np,S,Srok),
assertz(best2(Na,Np,S,Srok)),!.
f_b2(_,_,_,_).
fb2(N,_,_,_):- retract(best2(N,_,_,_)),fail.
fb2(_,_,_,_).
/* Процедуры заключения договоров в интерактивном режиме */
interact(1):-
makewindow(9,26,48,"Поиск поставщика",0,0,25,80),
nl,
write(" Введите название фирмы : "),readln(F),
write(" Введите название товара : "),readln(T),
write(" Введите производителя : "),readln(P),
write(" Введите необходимую партию : "),readInt(M),
write(" Введите цену за единицу товара : "),readreal(Pr),
write(" Введите сроки поставки : "),readInt(S),nl,
N=0,
Firm=F,Tov=T,Proizv=P,
Part=M,
Price=Pr,Srok=S,
assertz(покупатель(N,Firm,Tov,Proizv,Part,Price,Srok)),
removewindow,
поставщик(N1,_,Tov,Proizv1,Min1,Kol1,Price1,Srok1),
cmp_name(Proizv,Proizv1),
Part>=Min1,Part=Price1,Srok>=Srok1,
assert(flag(2)),
assertz(contract(N,N1)),
assert(best(N,0,0,0)),
fail.
interact(1):-flag(2),print_contract,
retract(покупатель(0,Firm,Tov,Proizv,Part,Price,Srok)),
retract(flag(2)),!.
interact(1):-
warning(N),
покупатель(0,Firm,Tov,Proizv,Part,Price,Srok),
assertz(покупатель(N,Firm,Tov,Proizv,Part,Price,Srok)),
ins_sup(Proizv),
retract(покупатель(0,Firm,Tov,Proizv,Part,Price,Srok)),
assert(flag(1)),
!.
interact(1):- retract(покупатель(0,Firm,Tov,Proizv,Part,Price,Srok)),!.
interact(2):-
makewindow(9,26,48,"Поиск покупателя",0,0,25,80),
nl,
write(" Введите название фирмы : "),readln(F),
write(" Введите название товара : "),readln(T),
write(" Введите производителя : "),readln(P),
write(" Введите минимальную партию : "),readInt(M),
write(" Введите имеющуюся партию : "),readInt(I),
write(" Введите цену за единицу товара : "),readreal(Pr),
write(" Введите сроки поставки : "),readInt(S),nl,
N=0,
Firm=F,Tov=T,Proizv=P,Min=M,
Kol=I,
Price=Pr,Srok=S,
assertz(поставщик(N,Firm,Tov,Proizv,Min,Kol,Price,Srok)),
removewindow,
покупатель(N1,_,Tov,Proizv1,Part1,Price1,Srok1),
cmp_name(Proizv1,Proizv),
Part1>=Min,Part1=Price,Srok1>=Srok,
assert(flag(2)),
assertz(contract(N1,N)),
assert(best(N1,0,0,0)),
fail.
interact(2):-flag(2),print_contract,
retract(поставщик(0,Firm,Tov,Proizv,Min,Kol,Price,Srok)),
retract(flag(2)),!.
interact(2):-
warning(N),
поставщик(0,Firm,Tov,Proizv,Min,Kol,Price,Srok),
assertz(поставщик(N,Firm,Tov,Proizv,Min,Kol,Price,Srok)),
ins_sup(Proizv),
retract(поставщик(0,Firm,Tov,Proizv,Min,Kol,Price,Srok)),
assert(flag(1)),
!.
interact(2):- retract(поставщик(0,Firm,Tov,Proizv,Min,Kol,Price,Srok)),!.
interact(_).
/* Вывод предупреждения о невозможности заключения договора */
warning(N):-makewindow(7,49,113,"Предупреждение",5,10,12,60),
sound(5,220),nl,nl,
write(" На данный момент заключение контракта невозможно"),nl,
write(" Поместить данные в базу данных"),nl,
write(" для последующей обработки?"),nl,nl,
write(" [Д]а/[Н]ет"),nl,
readchar(Ch),
removewindow,
Ch='Д',
write(" Введите порядковый номер фирмы : "),readInt(N),nl,
!.
/* Удаление элемента из классифицирующей сети */
% В середине цепочки
del_sup(S):- sup(S,X), del_sup(X),fail.
% В конце цепочки
del_sup(S):- sup(_,S), retract(sup(_,S)),fail.
del_sup(_).
/* Определение необходимости добавления и добавление */
/* элемента в классифицирующую сеть */
ins_sup(S):-sup(_,S),!.
ins_sup(S):-sup("производитель",S),!.
ins_sup(S):-
write("Введите региональную принадлежность объекта _ ",S,"_ :"),
readln(M),nl,
assertz(sup(M,S)),assert(flag(1)),ins_sup(M),!.
/* Вывод на печать связей в классифицирующей сети */
view_sup(S):-
sup(S,M),write(S," -> ",M),write("; "),
view_sup(M),nl,fail.
view_sup(_):- readchar(_).