DOMAINS
toch=string
km,ml=real
Int=integer
slist=string*
sslist=slist*
rlist=real*
/* Основные и служебные базы данных */
DATABASE - sosed
sosed(toch,toch,km,ml)
DATABASE - lists
lists(slist)
DATABASE - sum
sum(real)
PREDICATES
connect(toch,toch,km,ml,slist,slist)
wopros
start
autoload
working(Int)
main_menu
par(toch,toch,Int)
repeat
find(string,slist)
add(slist,string,slist)
result(slist,slist,slist)
adds(slist)
writelist(slist)
min(rlist,real,integer,integer,real,integer)
createSum(real,real)
summa(slist,real,real,real,real)
dcon(toch,toch,real,real)
createListR(rlist,rlist)
addr(rlist,real,rlist)
createListS(sslist,sslist)
addss(sslist,slist,sslist)
first(rlist,real)
writeN(sslist,integer)
writeall(sslist)
GOAL start.
CLAUSES
writelist([]).
writelist([X|L]):-write(" ",X), writelist(L).
dcon(X,Y,M,N) :- sosed(X,Y,M,N);sosed(Y,X,M,N).
summa([_],N,S,_,_) :- S=N.
summa([X,Y|L],N,S,Км,Бензин) :-bound(Км),dcon(X,Y,M,_), K=M+N, summa([Y|L],K,S,Км,Бензин);
bound(Бензин), dcon(X,Y,_,M), K=M+N, summa([Y|L],K,S,Км,Бензин).
add(L1,S,[S|L1]).
adds(X) :- lists(X), !.
adds(X) :- assertz(lists(X)).
createSum(Км,Бензин) :- lists(X), summa(X,0,Suma,Км,Бензин),
assertz(sum(Suma)), fail.
createSum(_,_).
addr(L1,R,[R|L1]).
createListR(R,L) :- not (sum(_)), R=L.
createListR(R,L) :- sum(X),
addr(L,X,M),retract(sum(X)),createListR(R,M).
addss(L1,R,[R|L1]).
createListS(R,L) :- not (lists(_)), R=L.
createListS(R,L) :- lists(X), addss(L,X,M), retract(lists(X)),
createListS(R,M).
first([X|_],N) :- N=X.
min([],Tmp,Cnt,_,Min,N) :- Min=Tmp, N=Cnt.
min([X|L],Tmp,Cnt,K,Min,N) :- Tmp>X, C=K, KK=K+1, MM=X,
min(L,MM,C,KK,Min,N);
KK=K+1, min(L,Tmp,Cnt,KK,Min,N).
writeN([L|_],0) :- writelist(L).
writeN([_|L],N) :- M=N-1, writeN(L,M).
find(R,[R|_]).
find(R,[_|T]) :- find(R,T).
result([_],L,R) :- R=L.
result([X|L],M,R) :- add(M,X,L1), result(L,L1,R).
writeall([]).
writeall([X|L]) :- writelist(X), nl, writeall(L).
/* Основная процедура start */
start:-
autoload,
main_menu.
% Процедура connect
connect(X,Y,_,_,M,R) :-
sosed(X,Y,AA,BB), R=M;
sosed(Y,X,AA,BB), R=M.
connect(X,Y,Км,Бензин,L,R) :-
sosed(X,Z,_,_),
not (find(Z,L)), add(L,Z,M), connect(Z,Y,Км,Бензин,M,R);
sosed(Z,X,_,_),
not (find(Z,L)), add(L,Z,M),
connect(Z,Y,Км,Бензин,M,R).
par(X,Y,'1'):-removewindow(15,1),L=[X,Y],connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M), fail.
par(_,_,'1'):- not(lists(_)), write("НЕТ ПУТИ").
par(_,_,'1'):-createSum(0,_), createListR(L1,[]), first(L1,Z),
min(L1,Z,0,0,M,N), write("Минимальное расстояние = ",M,"км."),createListS(R,[]),
nl,write("Траектория пути - "),writeN(R,N).
par(X,Y,'2'):- removewindow(15,1),L=[X,Y],connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M), fail.
par(_,_,'2'):- not(lists(_)), write("НЕТ ПУТИ").
par(_,_,'2'):-createSum(_,0), createListR(L1,[]), first(L1,Z),
min(L1,Z,0,0,M,N), write("Минимальный расход бензина = ",M," мл."),
createListS(R,[]),nl, write(" Траектория пути - "),writeN(R,N).
par(X,Y,'3'):- removewindow(15,1),L=[X,Y], connect(X,Y,_,_,L,R),
result(R,[Y],M), adds(M),fail.
par(_,_,'3'):- not(lists(_)),write("НЕТ РЕШЕНИЙ").
par(_,_,'3'):- write("Все маршруты :"),nl,createListS(R,[]),writeall(R).
% Процедура wopros
wopros :-
retractall(_,lists),
retractall(_,sum),
write("Ищем путь с параметрами"),nl,
write("От"),nl,readln(X),write("До"),nl,readln(Y),
makewindow(15,$1E,$2F," ВВОД ПАРАМЕТРОВ ",6,18,9,40),
write(" 1 - Расстояние"),nl,
write(" 2 - Расход бензина"),nl,
write(" 3 - Все пути"),nl,
write(" ->"),
readchar(N),
clearwindow,
par(X,Y,N),
removewindow(15,0).
wopros :- removewindow(15,0).
/* Процедура автоматической загрузки баз данных */
autoload:-
retractall(_,sosed),
consult("pal.ddd",sosed).
autoload:-
makewindow(2,74,79,"ОШИБКА",6,18,8,40),
cursor(2,10),
write("Нет базы на диске"),
sound(70,294),
removewindow,
!.
/* Главное меню */
main_menu:-
repeat,
makewindow(1,$1E,$2F,"ТРАЕКТОРИЯ ПУТИ РАЗНОСЧИКА ПИЦЦЫ",0,0,25,80),cursor(7,0),
write(" 1 - Сохранение базы"),nl,
write(" 2 - Добавление пункта доставки"),nl,
write(" 3 - Удаление пункта доставки"),nl,
write(" 4 - Просмотр базы"),nl,
write(" 5 - Решение задачи"),nl,
write(" 6 - Выход из программы"),nl,
write(" ->"),
readint(C),
clearwindow,
working(C),
clearwindow,
C = 6,
retractall(_),
removewindow(1,0).
/* Процедура сохранения базы данных */
working(1):-
makewindow(5,$5F,$5F," СОХРАНЕНИЕ БАЗЫ ",8,20,9,40),
sound(5,220),
repeat,
save("pal.ddd",sosed),nl,nl,
write(" База сохранена"),nl,nl,nl,
write(" Нажмите любую клавишу..."),nl,
readchar(_),
clearwindow,
!,
removewindow.
/* Процедура Добавления связей */
working(2):-
makewindow(6,$1E,$2F," ДОБАВЛЕНИЕ ПУНКТА ДОСТАВКИ ",0,0,25,80),
sound(5,220),
cursor(9,0),
write(" введите имя 1 пункта ->"),readln(P1),
write(" введите имя 2 пункта ->"),readln(P2),
write(" введите расстояние (в км.) ->"),readreal(Км),
write(" введите расход бензина (в мл.) ->"),readint(Бензин),
assertz(sosed(P1,P2,Км,Бензин)),
clearwindow,!,
removewindow(6,0).
/* Процедура Удаление связей */
working(3):-
makewindow(7,26,$4F," УДАЛЕНИЕ ПУНКТА ДОСТАВКИ ",0,0,25,80),
sound(5,220),
cursor(9,0),
write(" Bведите имя 1 пункта ->"),nl,
readln(P1),
write(" Bведите имя 2 пункта ->"),nl,readln(P2),
retract(sosed(P1,P2,_,_)),
clearwindow,
!,removewindow.
/* Процедуры просмотра баз данных */
working(4):-
makewindow(9,$1E,$2F," ПРОСМОТР БАЗЫ ДАННЫХ ",0,0,25,80),nl,
write(" г==============================================================¬"),nl,
write(" ¦ База данных ¦"),nl,
write(" ¦==============T=============T============T====================¦"),nl,
write(" ¦ Пункт #1 ¦ Пункт #2 ¦ Расстояние ¦ Расход бензина ¦"),nl,
write(" ¦ ¦ ¦ ¦ ¦"),nl,
write(" ¦==============+=============+============+====================¦"),nl,
sosed(P1,P2,Км,Бензин),cursor(Z,_),
cursor(Z,0),write(" ¦ ",P1),
cursor(Z,15),write(" ¦ ",P2),
cursor(Z,29),write(" ¦ ",Км),
cursor(Z,42),write(" ¦ ",Бензин),
cursor(Z,63),write(" ¦"),nl,fail.
working(4):-
write(" L==============¦=============¦============¦====================-"),
nl,cursor(22,26),
write("Нажмите на любую клавишу"),
readchar(_),
removewindow,!.
% Процедура решения задачи
working(5) if
makewindow(10,26,48,"Решение задачи",0,0,25,80),
nl,nl,
sound (5,220),wopros,sound(5,220),
cursor(22,26),
write("Нажмите на любую клавишу"),
readchar(_),
removewindow(10,1),!.
/* Процедура выхода из программы */
working(6):- removewindow(1,1).
working(_):-
makewindow(11,$4E,$4F,"ОШИБКА ВВОДА",6,18,8,40),
nl,
write(" Введите число от 0 до 6,"),nl,
write(" соответствующее выбранному пункту"),nl,nl,nl,
write(" Нажмите на любую клавишу"),
sound(20,494),
sound(30,392),
readchar(_),
removewindow(11,1).
/* Процедура repeat */
repeat.
repeat:- repeat.
