48530 (588561), страница 8

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 8)

add_con: =new_con

else begin

while (curr_con^. next<>nil) do

curr_con^. next: =new_con;

end;

end;

procedure p_rule (curr_rule: rule_ptr);

var

curr_prem: prem_ptr;

curr_con: con_ptr;

bufStr: string;

begin

bufStr: =curr_rule^. name+' ';

curr_prem: =curr_rule^. prem;

while (curr_prem<>nil) do begin

bufStr: =bufStr+curr_prem^. frime+'=';

bufStr: =bufStr+curr_prem^. value;

curr_prem: =curr_prem^. next;

if curr_prem<>nil

then

bufStr: =bufStr+' '

else

MainForm. Memo_Report. Lines. Add (BufStr);

end;

curr_con: =curr_rule^. con;

while curr_con<>nil do begin

bufStr: =curr_con^. frime+'=';

bufStr: =bufStr+curr_con^. value+', Кд='+IntToStr (curr_con. cert);

curr_con: =curr_con^. next; if curr_con<>nil

then

bufStr: =bufStr+' '

else

MainForm. Memo_Report. Lines. Add (BufStr);

end;

end;

procedure enter_rule (rule_name: word_string);

var

new_rule,

curr_rule: rule_ptr;

line: line_string;

done: boolean;

begin

new (new_rule);

if top_rule<>nil

then begin

curr_rule: =top_rule;

while curr_rule^. next<>nil do

curr_rule: =curr_rule^. next;

curr_rule^. next: =new_rule;

end

else

top_rule: =new_rule;

with new_rule^ do begin

name: =rule_name;

next: =nil;

prem: =nil;

con: =nil;

end;

p_read (line);

done: =false;

while ( (not done) and (not Eof (RulesFile))) do begin

new_rule^. prem: =add_prem (new_rule^. prem,line);

p_read (line);

done: = (pos ('ВВ',line) >0) and (length (line) =2);

end;

p_read (line);

repeat

done: =Eof (RulesFile);

new_rule^. con: =add_con (new_rule^. con,line);

done: =done or (line [length (line)] ='. ');

if not done then p_read (line);

until done;

p_rule (new_rule);

end;

procedure LoadFormFile;

var

command: word_string;

m_line,f_line: line_string;

st_place: integer;

s_frime,s_value: word_string;

begin

MainForm. Memo_Report. Lines. Add ('Чтение файла, содержащего правила');

assign (RulesFile,'rules. txt');

reset (RulesFile);

top_rule: =nil;

command: ='';

while not Eof (RulesFile) do begin

p_read (f_line);

st_place: =pos (' (',f_line);

if st_place=0

then

st_place: =pos (colon,f_line);

if st_place>1

then begin

command: =copy (f_line,1,st_place-1);

m_line: =copy (f_line,st_place+1,length (f_line) - st_place);

if command='многозначный'

then begin

split (m_line,s_frime,s_value);

make_multi (s_frime);

add_frime (s_frime,s_value);

add_cf (s_frime,s_value,get_cf (m_line));

end else

if command='вопрос'

then begin

split (m_line,s_frime,s_value);

add_question (s_frime,s_value);

end else

if command='разрешён'

then begin

make_legals (m_line);

end else

if command='правило'

then begin

split (m_line,s_frime,s_value);

enter_rule (s_frime);

end;

end;

end;

end;

procedure SaveToFile;

var

a_frime: frime_ptr;

a_legal: legal_ptr;

a_value: value_ptr;

a_rule: rule_ptr;

a_con: con_ptr;

a_prem: prem_ptr;

f: TextFile;

begin

AssignFile (f,'rules. txt');

Rewrite (f);

a_frime: =top_fact;

while a_frime<>nil do begin

a_value: =a_frime^. value_list;

while a_value<>nil do begin

writeln (f,'многозначный'+colon+a_frime^. name+equals+a_value^. name+comma+'Кд=',a_value^. cert);

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

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.

Характеристики

Список файлов ВКР