/*Программа выводит все цепочки взаимозачетов предприятий,
производит зачет по выбранной цепочке*/
domains
list_str=string*
list_list=list_str*
database - cep
cep(list_str,integer)
database - db
db_dan(string,integer,string)
predicates
dolg(string,integer,list_str)
prinad(string,list_str)
min(integer,integer,integer)
vivod(list_str)
run
wr(list_list,integer)
analis
el_num_in_list(integer,list_list,list_str)
zachet(list_str,integer)
goal run.
clauses
run:-makewindow(1,23,23,"",0,0,25,80),
makewindow(2,33,44,"ВЗАИМОЗАЧЕТЫ ПРЕДПРИЯТИЙ",3,5,20,70),
write("Составить цепочки взаимозачетов."),nl,
write("Введите первого должника: "),
readln(X), /*правило, управляющее работой */
write("Введите сумму: "), /* программы */
readint(Sum),nl,
write("Цепочки должников:"),nl,
consult("db.txt",db),
not(dolg(X,Sum,[X])),nl,
analis,nl,
retractall(cep(_,_)),
write("Для завершения работы нажмите любую клавишу."),
readchar(_),
removewindow,removewindow.
dolg(X,Sum,Z):-db_dan(X,Sum1,Y), /*правило осуществляет поиск цепочки */
min(Sum,Sum1,Sum2), /*должников*/
not(prinad(Y,Z)),
dolg(Y,Sum2,[Y|Z]).
dolg(X,Sum,L):-not(db_dan(X,_,_)),
not(L=[X]),not(cep(L,_)),
asserta(cep(L,Sum)),
fail.
prinad(X,[X|_]):-!. /* правило определяет принадлежность */
prinad(X,[_|Y]):-prinad(X,Y). /* элемента списку */
min(S,S1,S):-S<S1,!. /* правило определяет минимальный */
min(_,S1,S1). /* из двух элеметов */
vivod([]):-!. /* правило осуществляет вывод элементов */
vivod([H|List]):-write(H),nl, /* списка (одной цепочки должников) */
vivod(List).
wr([],_):-!.
wr([H|L],N):-write("Цепочка номер ",N,":"),nl, /* правило выводит */
vivod(H),cep(H,S),write("Сумма зачета: ",S),nl, /* все цепочки */
readchar(_),nl,N1=N+1,
wr(L,N1).
analis:-findall(L,cep(L,_),List),not(List=[]), /* правило производит зачет */
wr(List,1), /* по заданному номеру цепочки*/
write("Введите номер цепочки: "),
readint(N),
el_num_in_list(N,List,NL),
cep(NL,S),
write("Сумма зачета: ",S),nl,
zachet(NL,S),
write("Зачет произведен."),
save("db.txt",db),!.
analis:-write("Должников нет!").
el_num_in_list(1,[H|_],H):-!. /* правило находит в списке элемент */
el_num_in_list(N,[_|List],NL):-N1=N-1, /* по заданному номеру */
el_num_in_list(N1,List,NL).
zachet([_],_):-!. /* правило производит изменения */
zachet([H|[H1|NL]],S):-zachet([H1|NL],S), /* в базе данных (зачет) */
db_dan(H1,S1,H),
S2=S1-S,
retract(db_dan(H1,S1,H)),
asserta(db_dan(H1,S2,H)).