Программа на Visual Prolog 7

Формулировка задачи:

Подскажите, можно ли на прологе сделать такую последовательность: 1. Есть 4 направления в ВУЗе. Для каждого направления создать счетчик для ответов yes 2. Вывести 20 вопросов подряд и потребовать ответить yes/no (каждому направлению будет принадлежать по 5 вопросов) 3. Если на вопрос будет ответ yes, то необходимо увеличить счетчик соответствующего направления на единицу 4. Проверить, какой из счетчиков больше всего, и вывести соответствующее ему направление в конце
Решение задачи: «Программа на Visual Prolog 7»

textual
                            Листинг программы 
                        

                            %Экспертная системы для диагностики 
implement main
    open core, console
domains
 
class facts
    %высказывания: №      текст   К_критерий1, К_критерий2, К_критерий3
    question:        (integer,string,          integer,         integer,            integer). %
 
    %ответ для записи в базу данных
    %                  №, К_критерий1, К_критерий2, К_критерий3
    answer:(integer N, integer К_критерий1, integer К_критерий2,  integer К_критерий3).
 
    %Счётчики (факт-переменная) для суммирования показателей
    с_критерий1 : integer :=0.
    с_критерий2 : integer :=0.
    с_критерий3 : integer := 0.
class predicates
    repeat: () multi.  %вспомогательный предикат для организации цикла
    explanation:().  %пояснение о шкале ответов
    poll:() .              %опрос
    check:(integer[in]) determ.   %проверка ответа
    ask:(integer,string,integer) determ (i,i,o).  %задать вопрос и получить ответ
    analysis:(integer,integer,integer) procedure (o,o,o) . %подсчет суммарных показателей
    countsum:(). %суммирование  показателей из базы данных
    grade:(integer,symbol) procedure (i,i). %словесная оценка покателей
    todo:(symbol [in]) determ. %вывод показателя для словесной оценки
    write_result:(integer,integer,integer) procedure (i,i,i). %вывод результатов диагностики
    title:() procedure. %вывод заставки с описанием
clauses
    %для повторения до получения нужного условия
    repeat().
    repeat():-  repeat().
 
%список высказываний
%         №    текст      , К_критерий1, К_критерий2,  К_критерий3
question(1, "вопрос1",0,1,0).
question(2, "вопрос2",1,0,0).
question(3, "вопрос3",0,0,1).
question(4, "вопрос4",0,1,0).
question(5, "вопрос5",1,0,0).
question(6, "вопрос6",0,1,0).
question(7, "вопрос7",0,0,1).
question(8, "вопрос8",0,1,0).
question(9, "вопрос9",1,0,0).
question(10, "вопрос10",0,0,1).
question(11, "вопрос11",0,1,0).
question(12, "вопрос12",1,0,0).
question(13, "вопрос13",0,0,1).
question(14, "вопрос14",1,0,0).
question(15, "вопрос15",0,1,0).
question(16, "вопрос16",0,0,1).
question(17, "вопрос17",0,0,1).
question(18, "вопрос18",1,0,0).
question(19, "вопрос19",0,1,0).
question(20, "вопрос20",1,0,0).
question(21, "вопрос21",0,0,1).
 
%описание шкалы ответов
explanation() :- write("Каждое высказывание оценивайте по 4-бальной шкале:"), nl,
                        write("1 - описание1;"), nl,
                        write("2 - описание2;"), nl,
                        write("3 - описание3;"), nl,
                        write("4 - описание4."), nl,nl.
 
 
%опрос (сбор информации)
    poll ():- question(N,Вопрос,К_критерий1,К_критерий2,К_критерий3), %найти вопрос
          ask(N,Вопрос,Ответ), %спросить "N.Вопрос", получить Ответ
          %записать ответ в базу данных
          assert(  answer(N, Ответ*К_критерий1, Ответ*К_критерий2, Ответ*К_критерий3)),
          fail. %принудительный неуспех для перебора всех вопросов
    poll():-!. %чтобы опрос закончился успешно
 
 
    %задать вопрос и получить ответ. повторять пока не введут число в пределах 1-4
    ask(N,Вопрос,Ответ):-   repeat(), write(N,". ",Вопрос),nl,
                                        write("Оцените высказывание по шкале 1-4 (0-подсказка о шкале):"),
                    Ответ=read(), check(Ответ),!.
 
    %проверка, что ответ в пределах 1-4, иначе вывод подсказки
    check(Ответ) :- Ответ >=1, Ответ<=4,!.
    check(_) :-  explanation,fail.
 
    %анализ результатов опроса
    analysis(критерий1,критерий2,критерий3):-countsum, %подсчитать суммарные показатели
                                                                                    критерий1= с_критерий1,
                                                                                    критерий2 = с_критерий2,
                                                                                    критерий3 = с_критерий3, !.
 
    %подсчитать сумму всех показателей
    countsum():- answer(_,К_критерий1,К_критерий2,К_критерий3), %взять очередной ответ
                        с_критерий1 := с_критерий1+К_критерий1,                      %учесть его в сумме
                        с_критерий2 := с_критерий2+К_критерий2,                 %соответсвующего показателя
                        с_критерий3 := с_критерий3+К_критерий3,
                        fail.     %принудительный неуспех для перебора всех ответов
    countsum():- !.    %чтобы суммирование закончилось успешно
 
    %словесная оценка показателя
   grade(К,Показатель):- К>=0,К<=10,write("Реакция1 на "), todo(Показатель),
                                                          write(" Пояснение1."),!.
   grade(К,Показатель):- К>=11,К<=20,write("Реакция2 на "),todo(Показатель),
                                                            write(" Пояснение2."),!.
   grade(К,Показатель):- К>=21,К<=25,write("Реакция3 на "), todo(Показатель),write(" Пояснение3."), !.
   grade(К,Показатель):- К>=26,К<=28,write("Реакция4 на "), todo(Показатель),write(" Пояснение4."), !.
   grade(_,_):-!.
 
   todo("критерий1"):-write("расшифровка критерий1.").
   todo("критерий2"):-write("расшифровка критерий2.").
   todo("критерий3"):-write("расшифровка критерий3.").
 
    %вывод результатов диагностики
    write_result(критерий1,критерий2,критерий3):-nl,write("РЕЗУЛЬТАТ ДИАГНОСТИКИ:"),nl,
                        write("Показатель1=", критерий1,"."), grade(критерий1,"критерий1"),nl,
                                        write("Показатель2=", критерий2,"."), grade(критерий2,"критерий2"),nl,
                                        write("Показатель3=", критерий3,"."), grade(критерий3,"критерий3"),nl,!.
   %вывод заставки с описанием
   title():-   write("ЭКСПЕРТНАЯ СИСТЕМА ДЛЯ ДИАГНОСТИКИ"), nl,
                write("...того-то и того-то..."), nl,
                write("===Название системы==="), nl,
                write("Вам будет предложено несколько высказываний, которые следует оценить."),nl,
                explanation.
 
   run() :-  title, %вводная инструкция
                poll, %опрос
                analysis(критерий1,критерий2,критерий3), %анализ ответов
                write_result(критерий1,критерий2,критерий3), %вывод результата
                clearInput,  _ = readLine(). %пауза
 
end implement main
 
goal
    console::run(main::run).
                        