3.8. Пример реализации экспертной системы на языке Пролог

В завершение раздела приведем полный листинг программы на языке Пролог, которая выводит все цепочки взаимозачетов предприятий, имеющихся в базе знаний, и производит зачет по выбранной цепочке.

/* Экспертная система «Взаимозачет» */

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)).

/* конец листинга программы */