Основы программирования на языке Turbo Prolog

assert_database :-

   member_party(Name,Age,Pay,Flag),

   assertz(dmember_party(Name,Age,Pay,Flag)),

   fail.

assert_database :-!.  

 

/* Очистка  динамической БД */

clear_database :-

   retractall(dmember_party(_,_,_,_)).

          

/* Удаление  фактов статической БД из динамической  */

del_statbase :-

   member_party(N,_,_,_),  

   retract(dmember_party(N,_,_,_)),

   fail.

del_statbase :- !.

 

/* Диалог  с этой БД осуществляется по  принципу меню. При этом используются оконнные средства Турбо-Пролога. Основываясь на запросе пользователя, СУБД активизирует соответствующие процессы для удовлетворения этого запроса. Меню можно расширить за счет включения новых функций. */

 

do_mbase :-

   assert_database,

   makewindow(1,23,7," PRO PARTY DATABASE ",

              0,0,25,80),

   menu,

   clear_database.

 

menu :-

repeat,

clearwindow,

write("* * * * * * * * * * * * * * * * * * * * *"), nl,

write("* 1.Load database                       *"), 
       nl,

write("* 2.Add a member_party to database      *"), 
       nl,

write("* 3.Delete a member_party from database *"), 
       nl,

write("* 4.View a member_party from database   *"), 
       nl,

write("* 5. Save database                      *"), 
       nl,

write("* 6. Quit from this program             *"), 
       nl,

write("* * * * * * * * * * * * * * * * * * * * *"), 
        nl,

write("Please enter your choice — 1,2,3,4,5 or 6:"),

readint(Choice),nl,

process(Choice),

Choice = 7,

!.

             

/* Загрузка  базы данных из файла */            

process(1) :-

   consult("party.dba"), !.

          

/* Добавление  информации о новом члене в  БД */

process(2) :-

   makewindow(2,23,7," Add member to DATABASE ",

              2,20,18,58),

   shiftwindow(2),

   write("Enter member_party name: "),

   readln(Name),

   write("Enter member_party age: "),

   readint(Age),

   write("Enter party dues: "),

   readint(Rub),

   write("Enter answer 'y' or 'n' about payment: "),

   readln(Answer),

   assertz(dmember_party(Name,Age,Rub,Answer)), 

   write(Name," has been added to the database."),

   nl,

   write("Press space bar. "),

   readchar(_),

   removewindow.

 

/* Удаление  информации о члене партии  из БД */

process(3) :-

   makewindow(3,23,7," Delete member from DATABASE ",  
              10,30,7,40),

   shiftwindow(3),

   write("Enter name to DELETE: "),

   readln(Name),

   retract(dmember_party(Name,_,_,_)),

   write(Name," has been deleted from the database."),

   nl, !,

   write("Press space bar."),

   readchar(_),

   removewindow.

 

/* Просмотр  информации о члене партии */

process(4) :-

   makewindow(4,23,7," View Window ",

              7,30,16,47),

   shiftwindow(4),

   write("Enter name to view: "),

   readln(Name),

   dmember_party(Name,Age,Rub,Pay),   

   nl, write("  PARTY MEMBER "),nl,

   nl, write(" Party Name : ",Name),

   nl, write(" Age : ",Age),

   nl, write(" Rubel : ",Rub),

   nl, write(" Payment : ",Pay),

   nl, nl, !,

   nl, write("Press space bar"),

   readchar(_),

   removewindow.

 

process(4) :-

   makewindow(5,23,7," No Luck ",14,7,5,60),

   shiftwindow(5),

   write( 
"Can't find that member of party in the database."),

   nl, write("Sorry, bye!"),

   nl, !,

   write("Press space bar."),

   readchar(_),

   removewindow,

   shiftwindow(1).

 

/* Сохранение  динамической БД в файле "party.dba" */

process(5) :-

   write("Are you want to save database (y/n)"),

   readln(Answer),

   frontchar(Answer,'y',_),

   del_statbase,

   save("party.dba"), !.

 

/* Выход  из программы */

process(6) :-

   write("Are you sure want to quit (y/n)"),

   readln(Answer),

   upper_lower(Answer),

   frontchar(Answer,'y',_), !.

 

/* Неправильное  обращение к БД */

process(Choice) :-

   Choice < 1,

   error.

process(Choice) :-

   Choice > 6,

   error.

 

error :-

   write("Please enter a number from 1 to 6."),

   write("(Press the space bar to continue)"),

   readchar(_).

 

/*           конец программы            */

Упражнение 9.1.

Дополнить меню новой функцией, осуществляющей просмотр всех членов партии.

ГЛАВА 10. ГЛОБАЛЬНЫЕ ПЕРЕМЕННЫЕ В TURBO PROLOG

1. МОДИФИКАЦИЯ БАЗЫ ДАННЫХ

Пролог — программы, работающие с динамической базой данных, позволяют пользователю вносить в эту базу изменения. Для этого используются предикаты asserta, assertz, retract и retractall.

При этом возникает опасность некорректного изменения программы. Ведь добавляя и удаляя предложения, мы фактически изменяем программу. Поэтому в разные моменты времени ответы на одни и те же вопросы будут различными. В результате поведение программы может стать необъснимым, и вряд ли можно будет ей доверять. Особенно «опасен» в этом смысле предикат retract, который способен передоказываться при возвратах.

Указанный риск можно уменьшить. Для этого используются следующие способы:

четкое разделение утверждений программы на данные и правила их обработки;

разделение этапов сбора данных и их обработки (только после успешного завершения этапа сбора данных начинается этап их обработки).

Но есть и такое приложение динамической базы данных, когда и этап сбора данных, и этап их обработки должны заканчиваться одновременно. Таковым является использование динамической бд в качестве глобальной переменной. Оно позволяет существенно повысить эффективность программ за счет запоминания промежуточных результатов вычислений. При грамотном программировании опасности некорректного изменения программы можно избежать, но декларативный смысл программы будет в значительной степени утерян.

2. НАКОПЛЕНИЕ РЕЗУЛЬТАТОВ С ПОМОЩЬЮ  ВЫНУЖДАЕМОГО ВОЗВРАТА

Как мы уже знаем, правило возврата после неудачи позволяет получить все возможные варианты согласования цели (недетерминированного предиката). Но при этом механизм возврата уничтожает все сделанные ранее подстановки переменных. Поэтому в каждый момент времени мы знаем только текуший результат, а все ранее сгенерированные результаты будут потеряны навсегда.

Для того, чтобы решить проблему накопления результатов, мы использовали вместо возврата после неудачи восходящую рекурсию, где результаты накапливались в аргументах цели верхнего уровня. Но рекурсия в общем случае требует больше памяти при выполнении программы.

Кроме того, если результат возвращается через аргумент, и имеется длинная серия рекурсивно вызываемых подцелей, то каждая подцель должна нести этот возвращаемый аргумент.

В этих случаях более эффективно запоминать результат, записывая его в динамическую базу. Другими словами, любая процедура может записать в динамическую БД свой результат, и он будет «виден» любой другой процедуре, какая бы ни была между ними дистанция при их последовательных вызовах.

Чтобы с программой при этом не случилось ничего дурного, предикаты, модифицирующие базу, должны быть спрятаны на уровень ниже вызывающей их процедуры и снабжены отсечением. Рассмотрим технику работы с глобальными переменными на примерах.

3. ПОДСЧЕТ ЧЛЕНОВ ПАРТОРГАНИЗАЦИИ

Пусть от нашей программы 9.1 «Партийная жизнь» из главы 9 требутся не только показать всех членов партии, но и подсчитать их количество.

Процедура просмотра информации динамической БД, представляющая собой утверждения предиката:

dmember_party служит

 

show_database :-

   dmember_party(Name,Age,Pay,Payment),

   write(Name), nl,

   fail.

show_database :- !.

Первое правило с помощью возврата после неудачи перебирает и печатает всех членов партии, второе обеспечивает успешное завершение цели.

Изменим эту процедуру так, чтобы одновременно вести подсчет членов. Заведем для этой цели счетчик dculc. В программе может возникнуть необходимость подсчитывать еще что-нибудь, например, сумму сданных членских взносов.

Не будем всякий раз заводить новый счетчик, пусть первым аргументом предиката dculc будет уникальное имя счетчика, представляющее собой символическое имя. Именем нашего счетчика будет константа num(или «число членов»). Вторым аргументом будет значение счетчика — величина типа integer.

Поскольку все наши счетчики будут подчиняться одним правилам, начальное значение счетчика и его приращение будут передаваться в качестве параметров. Описание будет выглядеть так:

database

   dmember_party(name,age,pay,payment)

   dculc(symbol,integer)

Запишем последовательнность действий при подсчете членов.

1. Записываем  в БД начальное значение dculc(num,0).

2. При  считывании нового члена старое  значение dculc(num,Old) удаляется и записывается новое значение dculc(num,New), где New = Old+1.

3. После  завершения перебора всех членов  печатается окончательное значение счетчика Total, а утверждение dculc(num,Total) удаляется из базы.

culc_database :-

   init_culc(num,0),

   dmember_party(Name,_,_,_),

   write(Name), nl,

   inc_culc(num,1),

   fail.

culc_database :-

   del_culc(num,Total),

   write(”число членов ”,Total),

   nl,!.

К описанию предикатов добавятся:

predicates

   init_culc(symbol,integer)

   inc_culc(symbol,integer)

   del_culc(symbol,integer)

Первым аргументом каждого правила является имя счетчика. Второй аргумент

для init_culc — начальное значение счетчика,

для inc_culc — приращение счетчика,

для del_culc — окончательное значение счетчика.

В раздел clauses будут добавлены следующие правила:

clauses

 

init_culc(Name,C0):-

   retractall(dculc(Name,_)),

   assert(dculc(Name,C0)).

 

inc_culc(Name,Delta):-

   retract(dculc(Name,Old)),

   New = Old + Delta,   assert(dculc(Name,New)),!.

 

del_culc(Name,Total):-

   retract(dculc(Name,Total)),!.

Обсудим теперь структуру правил и их расположение внутри процедуры culc_database. Сразу заметно, что правила inc_culc и del_culc снабжены отсечениями, которого нет у правила init_culc.

Ни retractall, ни assert не передоказываются при возвратах, поэтому выделение действий установки счетчика в отдельное правило — лишь вопрос стиля. На самом деле, первое правило culc_database могло выглядеть так:

culc_database :-

   retractall(dculc(num,_)),

   assert(dculc(num,0)),

   dmember_party(Name,_,_,_),

   write(Name), nl,

   inc_culc(num,1),

   fail.

Оставшиеся два правила содержат внутри себя предикат retract, который передоказывается при возвратах.

Попробуем не выделять увеличение счетчика в отдельное правило, а вставить на уровень тела правила culc_database.

culc_database :-

   <.............>,

   dmember_party(Name,_,_,_),

   retract(dculc(num,Old)),

   New = Old + 1,

   assert(dculc(num,New)),

   fail.

Для первого члена в базу будет записано значение счетчика 1. Затем от неудачи произойдет возврат к retract(не доходя до dmember_party), 1 будет стерта, записана 2, при следующем возврате к retract 2 будет стерта, записана 3, и т.д. Образуется бесконечный цикл.

Чтобы избежать этих неприятностей, ПРАВИЛА, МОДИФИЦИРУЮЩИЕ БАЗУ ДАННЫХ, ВЫДЕЛЯЮТСЯ В ОТДЕЛЬНУЮ ПРОЦЕДУРУ, ОПУСКАЮТСЯ НА УРОВЕНЬ НИЖЕ ВЫЗЫВАЮЩЕГО ИХ ПРАВИЛА И СНАБЖАЮТСЯ ОТСЕЧЕНИЕМ.

Упражнение 10.1.

Добавьте к программе 9.1 из главы 9 («Партийная жизнь») еще одну опцию меню для показа суммы сданных членских взносов.

4. ПОИСК ПУТИ МИНИМАЛЬНОЙ СТОИМОСТИ  ОТ A ДО Z

Вспомним задачу из главы 8 о поиске пути минимальной стоимости. Пути мы получали за счет возвратов, а глобальной переменной, чтобы запоминать текущий минимум, у нас не было.

Для хранения текущего минимального пути заведем предикат динамической БД min_way, первым аргументом которого будет текущий минимальный путь, вторым — его стоимость.

database

   dmin_way(list,integer)

При генерации очередного пути воспользуемся следующим методом: прежде, чем добавлять к пути новое ребро, проверим, не станет ли его стоимость больше либо равна стоимости текущего минимального пути. Если да, то этот путь не нужно генерировать до конца (он уже не будет меньше текущего минимума), а следует переходить к генерации следующего пути.

Поэтому рекурсивное правило процедуры way1 изменится:

way1(Z, [X|Was],SW, Sol,S):-

   sosed1(X,Y,St),

   not(member(Y,Was)),        

   SW1=SW+St,

   dmin_way(_,Stoim),

   % сравнеие с минимумом после  добавления ребра

   Stoim>Sw1,

   way1(Z,[Y,X|Was],SW1,Sol,S).  

Если проверка Stoim>Sw1 не проходит, то происходит возврат к sosed1, которая находит следующую вершину — соседку для продолжения пути.

Перед началом генерации путей запишем в базу начальное значение минимума:

assert(dmin_way([],1000))

Процедура поиска минимального пути будет иметь следующий вид:

find_min(Z, A):-

   % перебор всех путей 

   way1(Z, [A], 0, Sol, MinS),

   % изменение текущего min пути

   change_base(Sol,MinS),

   fail.

find_min(_, _):-

   dmin_way(Sol,St),

   % печать окончательного  минимума

   write(Sol),nl,

   write(St),nl.

Все правила изменения текущего минимума спрятаны на уровень ниже, в процедуре change_base:

change_base(Sol,MinS):-

         dmin_way(_,St),

         St > MinS,      

         retract(dmin_way(_,_)),

         assert(dmin_way(Sol,MinS)),!.

В процедуру передается очередной путь Sol и его стоимость MinS, затем стоимость MinS сравнивается с текущим минимумом St, и, в случае успеха проверки, предикат dmin_way переписывается.

/* Программа 10.1 «Поиск пути от A до Z       */

/* минимальной  стоимости». Назначение:        */

/* демонстрация работы с динамической БД      */

 

domains

   uzl=integer

   list=uzl*

   list1=integer*

 

database

   dmin_way(list,integer)

 

predicates

 

   graph1(list,list1)

   show_min

   find_min(uzl,uzl)

   way1(uzl,list,integer,list,integer)

   change_base(list,integer)

   sosed1(uzl,uzl,integer)  

   member1(uzl,list,list1,integer)

   member(uzl,list)

 

goal

   show_min. % показать минимальный путь

      

clauses

 

% 1-й  список — список соседок,

% 2-й  список — стоимостей соответствующих ребер.

  graph1([1,2,3,4],[3,0,2]).

  graph1([2,1,3,5],[3,4,5]).

  graph1([3,1,2,4],[0,4,0]).

  graph1([4,1,3,5],[2,0,1]).

  graph1([5,2,4],[5,1]).

 

  show_min:-

     write("Начало пути "), readint(A),

     write("Конец пути "), readint(Z),

     assert(dmin_way([],1000)),

     find_min(Z,A),

     save("minway.dba").

  

  find_min(Z, A):-

     % перебор всех путей

    way1(Z, [A], 0, Sol, MinS),

     % изменение текущего min пути

     change_base(Sol,MinS),

     fail.

  find_min(_, _):-

     dmin_way(Sol,St),

     % печать минимума

    write(Sol),nl, 

     write(St),nl.

 

  way1(Z, [Z|Was],S, [Z|Was],S).     

  way1(Z, [X|Was],SW, Sol,S):-

     sosed1(X,Y,St),

     not(member(Y,Was)),        

     SW1=SW+St,

     dmin_way(_,Stoim),

     Stoim>Sw1,

     way1(Z, [Y,X|Was],SW1, Sol,S).  

         

  change_base(Sol,MinS):-

     dmin_way(_,St),

     St > MinS,      

     retract(dmin_way(_,_)),

     assert(dmin_way(Sol,MinS)),!.

         

  sosed1(X, Y, St):-

     graph1([X|T], LS),

     member1(Y, T, LS, St).

          

  member1(H,[H|_],[S|_],S).

  member1(X,[_|T],[_|ST],S):- 

     member1(X,T,ST,S).