Элементарные экспертные системы. Разработка экспертной системы для тестирования знаний по теме «Списки и рекурсия»., страница 2

% объединяет списки, исключая повторения

combine_lists([],L,L).

combine_lists([H|T1],L,[H|T2]):not(is_member(H,L)),

combine_lists(T1,L,T2),!.

combine_lists([_|T1],L,L2):combine_lists(T1,L,L2).

% подсчитывает очки

countScores(K,M,S):K <= M,

result(K,R1),

getScores(K,R1,R),

K1 = K+1,

countScores(K1,M,S1),

S = R+S1,!;

K <= M,

K1 = K+1,

countScores(K1,M,S),!;

S = 0,!.

% вычисляет оценку

evaluateBall(S,B):q_num(N),

B = S*4 div N + 1,

!.

% получить индекс следующего вопроса; если его нет, то fail

getNextQuestion(K,K1,N):K < N,

K2 = K+1,

K1 = K2,!;

K < N,

K2 = K+1,

getNextQuestion(K2,K1,N),!.

% число очков для данного ответа

getScores(Q,A,S):right(Q,Ar),

A = Ar, S = 1,!;

S = 0.

% проверяет, входит ли элемент в список

is_member(_,[]):- fail.

is_member(H,[H|_]):- !.

is_member(K,[_|T]):is_member(K,T).

% читает базу данных из файла

readConfig:existfile(cfg_name),           % файл конфигурации существует?

retractall(q_num(_)),

retractall(question(_,_)),           % очищаем базу данных в памяти

retractall(answer(_,_,_)),

retractall(links(_,_)),

retractall(right(_,_)),

consult(cfg_name, expert),!;   % читаем базу данных из файла

dlg_Note("Внимание!", "Файл конфигурации не существует. База данных пуста."),

assert(q_num(0)),              % формируем базу данных по умолчанию

save(cfg_name, expert),        % сохраняем ее в config file

retractall(_).

% заменяет '\' на '\n'

treatCR("","",_):- !.

treatCR(S1,S2,L):L1 = L-1,

substring(S1,2,L1,St),

treatCR(St,S3,L1),

subchar(S1,1,C),

treatCR(C,C1),

str_char(S,C1),

concat(S,S3,S2).

treatCR(C,C1):C = '\\',

C1 = '\n',!;

C1 = C.

%BEGIN_WIN Task Window

/***************************************************************************

Предикаты для работы с окнами и элементами управления

***************************************************************************/

predicates

do_inquiry(WINDOW)               % задает очередной вопрос

explainResults(integer,integer,integer)   % объяснить результат

getExplanation(integer,integer,string)    % вырабатывает строку объяснения

printResults(WINDOW)             % печатает результаты теста

clauses

% задает очередной вопрос

do_inquiry(_Win):win_Invalidate(_Win),

cur_question(K),

answer(K,1,A1), answer(K,2,A2), answer(K,3,A3),

format(AA1, "а) %s", A1),

format(AA2, "б) %s", A2), format(AA3, "в) %s", A3),

Lbox = win_GetCtlHandle(_Win, listbox1),

lbox_Clear(Lbox),

lbox_add(Lbox,[AA1,AA2,AA3]),!.

% объясняет результат

explainResults(1,Sc,B):q_num(N),

getExplanation(1,N,St),

format(S1,"N\tВаш ответ\tВерный\t\tБаллы\n%s\n",St),

format(S2,"%s\nИтого баллов: %d. Оценка ",S1,Sc),

format(S3,"%sM = R * 4 div N + 1 = %d * 4 div %d + 1 = %d, ",S2,Sc,N,B),

format(S, "%sгде R = %d - число верных ответов, N = %d - общее число вопросов.",

S3,Sc,N),

dlg_Note("Объяснение",S),!.

% вырабатывает строку объяснения

getExplanation(K,M,S):K <= M,

result(K,R1),

right(K,R2),

getScores(K,R1,R),

K1 = K+1,

getExplanation(K1,M,S1),

format(S, "\n%d\t%d\t\t%d\t\t%d%s",K,R1,R2,R,S1),!;

K <= M,

K1 = K+1,

getExplanation(K1,M,S),!;

S = "",!.

% печатает результаты теста

printResults(_Win):cur_question(M),               % число заданных вопросов

M <> 0,

countScores(1,M,S),

evaluateBall(S,B),

q_num(N),

E = N-S,

format(S1, "Общее число вопросов: %d. Число неправильных ответов: %d. ", N, E),

format(Str,"%s  Оценка по пятибалльной системе: %d. Объяснить результат?",S1,B),

R = dlg_MessageBox("Поздравляю!", Str, mesbox_iconQuestion, mesbox_buttonsYesNo,