a_value: =a_value. next;
end;
a_Legal: =a_frime^. Legal_list;
write (f,'разрешён'+colon,a_frime^. name,equals);
while a_Legal<>nil do begin
write (f,a_legal^. name,comma);
a_legal: =a_legal. next;
end;
writeln (f);
writeln (f,'вопрос'+colon+a_frime^. name+equals+a_frime^. question);
a_frime: =a_frime^. next;
end;
a_rule: =top_rule;
while a_rule<>nil do begin
writeln (f,'правило'+a_rule^. name);
a_prem: =a_rule^. prem;
while a_prem<>nil do begin
writeln (f,a_prem^. frime+equals+a_prem^. value);
a_prem: =a_prem^. next;
end;
writeln (f,'ВВ');
a_con: =a_rule^. con;
while a_con<>nil do begin
writeln (f,a_con^. frime+equals+a_con^. value+comma+'Кд=',a_con^. cert);
a_con: =a_con^. next;
if a_prem=nil
then writeln (f,'. ');
end;
a_rule: =a_rule^. next;
end;
CloseFile (f);
end;
function find_rule (fri: word_string; curr_rule: rule_ptr): rule_ptr;
var
found: boolean;
curr_con: con_ptr;
begin
found: =false;
find_rule: =nil;
while (curr_rule<>nil) and (not found) do begin
curr_con: =curr_rule^. con;
while curr_con<>nil do begin
if curr_con^. frime=fri
then begin
found: =true;
find_rule: =curr_rule;
end;
curr_con: =curr_con^. next;
end;
curr_rule: =curr_rule^. next;
end;
end;
procedure conclude (curr_rule: rule_ptr; prem_cert: integer);
var
curr_con: con_ptr;
cert: integer;
begin
curr_con: =curr_rule^. con;
while curr_con<>nil do begin
add_frime (curr_con^. frime,curr_con^. value);
cert: = (prem_cert*curr_con^. cert) div 100;
add_cf (curr_con^. frime,curr_con^. value,cert);
curr_con: =curr_con^. next;
end;
end;
procedure pursue;
var
f_value: word_string;
curr_frime: frime_ptr;
curr_value: value_ptr;
curr_rule: rule_ptr;
curr_prem: prem_ptr;
bad: boolean;
solved: boolean;
lowest: integer;
begin
curr_frime: =find_frime (f_frime);
if curr_frime=nil
then begin
make_node (curr_frime);
curr_frime^. name: =f_frime;
end;
solved: =false;
if not curr_frime^. sought then begin
solved: =false;
curr_frime^. sought: =true;
curr_rule: =find_rule (f_frime,top_rule);
while (curr_rule<>nil) and (ok_add (f_frime,definite)) do begin
curr_prem: =curr_rule^. prem;
bad: =false;
lowest: =definite;
while (curr_prem<>nil) and (not bad) do begin
pursue (curr_prem^. frime);
curr_value: =test (curr_prem^. frime,curr_prem^. value);
if curr_value=nil
then
bad: =true
else
if curr_value^. cert<lowest
then
lowest: =curr_value^. cert;
curr_prem: =curr_prem^. next;
end;
if not bad
then begin
if explain
then
conclude (curr_rule,lowest);
solved: =true;
end;
curr_rule: =find_rule (f_frime,curr_rule^. next);
end;
if not solved
then begin
if explain
then
ask (f_frime,f_value);
add_frime (f_frime,f_value);
add_cf (f_frime,f_value,definite);
end;
end;
end;
procedure q_result (f_frime: word_string);
var
curr_frime: frime_ptr;
begin
MainForm. Memo_Report. Lines. Add ('Результат консультации: ');
curr_frime: =find_frime (f_frime);
see_vals (curr_frime,true);
MainForm. Memo_Report. Lines. Add ('Конец консультации');
end;
procedure explain_how (curr_rule: rule_ptr);
var
curr_prem: prem_ptr;
curr_con: con_ptr;
begin
MainForm. Memo_Report. Lines. Add ('');
MainForm. Memo_Report. Lines. Add ('Tак как: ');
curr_prem: =curr_rule^. prem;
while curr_prem<>nil do begin
MainForm. Memo_Report. Lines. Add (curr_prem^. frime+'='+curr_prem^. value);
curr_prem: =curr_prem^. next;
if curr_prem<>nil
then
MainForm. Memo_Report. Lines. Add (' ')
else
MainForm. Memo_Report. Lines. Add ('');
end;
MainForm. Memo_Report. Lines. Add ('Можно сделать вывод, что ');
curr_con: =curr_rule^. con;
while curr_con<>nil do begin
MainForm. Memo_Report. Lines. Add (curr_con^. frime+'='+curr_con^. value+', Кд='+IntToStr (curr_con^. cert));
curr_con: =curr_con^. next;
if curr_con<>nil
then
MainForm. Memo_Report. Lines. Add (' ')
else
MainForm. Memo_Report. Lines. Add ('');
end;
end;
procedure explain_why (f_frime: word_string);
begin
MainForm. Memo_Report. Lines. Add ('')
end;
procedure TMainForm. FormCreate (Sender: TObject);
begin
last_try: =nil;
top_fact: =nil;
LoadFormFile;
explain: =true;
end;
procedure TMainForm. B_AddFactClick (Sender: TObject);
var
s_frime,
s_value: word_string;
s_cf: integer;
begin
s_cf: =StrToInt (LE_AddFact_Cf. Text);
s_frime: =LE_AddFact_Frime. Text;
s_value: =LE_AddFact_Value. Text;
if ok_add (s_frime,s_cf)
then begin
add_frime (s_frime,s_value);
add_cf (s_frime,s_value,s_cf);
MainForm. Memo_Report. Lines. Add ('Факт добавлен');
end
else
MainForm. Memo_Report. Lines. Add ('Добавление не разрешено (Объект '+s_frime+' нe объявлен многозначным) ! ');
end;
procedure TMainForm. B_TestFactClick (Sender: TObject);
var
s_frime,
s_value: word_string;
begin
s_frime: =LE_TestFact_Frime. Text;
s_value: =LE_TestFact_Value. Text;
if test (s_frime,s_value) =nil
then
MainForm. Memo_Report. Lines. Add ('Факт неверен')
else
MainForm. Memo_Report. Lines. Add ('Факт верен');
end;
procedure TMainForm. B_SeeFactsClick (Sender: TObject);
begin
see_frimes (true);
end;
procedure TMainForm. B_MakeFrimeMultivalidClick (Sender: TObject);
begin
make_multi (LE_MakeMulti_Frime. Text);
end;
procedure TMainForm. B_MakeLegalClick (Sender: TObject);
begin
make_legals_from_form (LE_MakeLegal_Frime. Text);
end;
procedure TMainForm. B_AddQuestionClick (Sender: TObject);
var
s_frime,
s_value: word_string;
begin
s_frime: =LE_AddQuestion_Frime. Text;
s_value: =LE_AddQuestion_Value. Text;
add_question (s_frime,s_value);
end;
procedure TMainForm. B_GetQuestionClick (Sender: TObject);
var
s_frime: word_string;
begin
s_frime: =LE_Answer_Frime. Text;
LE_GetQuestion. Text: =p_question (s_frime);
end;
procedure TMainForm. B_Answer_GetNumValsClick (Sender: TObject);
begin
B_Answer_GetNumVals. Tag: =1;
end;
procedure TMainForm. B_AnswerClick (Sender: TObject);
var
s_frime,
s_value: word_string;
begin
s_frime: =LE_Answer_Frime. Text;
ask (s_frime,s_value);
add_frime (s_frime,s_value);
add_cf (s_frime,s_value,definite);
end;
procedure TMainForm. LE_OnExit (Sender: TObject);
begin
TLabeledEdit (Sender). Text: =AnsiLowerCase (trim (TLabeledEdit (Sender). Text));
end;
procedure TMainForm. M_MakeLegal_ValueExit (Sender: TObject);
var i: integer;
begin
with M_MakeLegal_Value do
If Lines. Count>0 then
for i: =Lines. Count-1 downto 0 do begin
Lines [i]: =AnsiLowerCase (trim (Lines [i]));
If Lines [i] ='' then Lines. Delete (i);
end;
end;
procedure TMainForm. B_GetTargetClick (Sender: TObject);
var
s_frime: word_string;
begin
s_frime: =LE_GetTarget. Text;
if s_frime<>''
then begin
pursue (s_frime);
q_result (s_frime);
end
else
MainForm. Memo_Report. Lines. Add ('Ошибка! Объект не указан! ');
end;
procedure TMainForm. Button1Click (Sender: TObject);
begin
SaveToFile;
end;
procedure TMainForm. Button2Click (Sender: TObject);
begin
qmport;
end;
end.