Разработка алгоритмического и программного обеспечения ситуационного управления безопасностью магистральных газопроводов

unit MainUnit;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Spin, ComCtrls;

const

word_max=100;

line_max=255;

colon=': ';

period='. ';

comma=',';

spase='';

equals='=';

nextrow=#13#10;

definite=100;

type

TMainForm = class (TForm)

Memo_Report: TMemo;

LE_Crash_Name: TLabeledEdit;

Bevel1: TBevel;

Bevel2: TBevel;

Bevel3: TBevel;

Bevel4: TBevel;

Bevel5: TBevel;

Bevel6: TBevel;

Bevel7: TBevel;

Label1: TLabel;

Label2: TLabel;

Bevel9: TBevel;

B_AddFact: TButton;

LE_AddFact_Frime: TLabeledEdit;

LE_AddFact_Value: TLabeledEdit;

LE_AddFact_Cf: TLabeledEdit;

B_TestFact: TButton;

LE_TestFact_Frime: TLabeledEdit;

LE_TestFact_Value: TLabeledEdit;

B_SeeFacts: TButton;

B_MakeFrimeMultivalid: TButton;

LE_MakeMulti_Frime: TLabeledEdit;

B_MakeLegal: TButton;

LE_MakeLegal_Frime: TLabeledEdit;

B_AddQuestion: TButton;

LE_AddQuestion_Frime: TLabeledEdit;

B_Answer: TButton;

LE_Answer_Frime: TLabeledEdit;

B_GetQuestion: TButton;

SE_Answer: TSpinEdit;

LE_Answer_Value: TLabeledEdit;

B_Answer_GetNumVals: TButton;

M_MakeLegal_Value: TMemo;

LE_AddQuestion_Value: TLabeledEdit;

LE_GetQuestion: TLabeledEdit;

B_GetTarget: TButton;

LE_GetTarget: TLabeledEdit;

Button1: TButton;

Bevel8: TBevel;

Button2: TButton;

Label3: TLabel;

procedure FormCreate (Sender: TObject);

procedure B_AddFactClick (Sender: TObject);

procedure B_TestFactClick (Sender: TObject);

procedure B_SeeFactsClick (Sender: TObject);

procedure B_MakeFrimeMultivalidClick (Sender: TObject);

procedure B_MakeLegalClick (Sender: TObject);

procedure B_AddQuestionClick (Sender: TObject);

procedure B_AnswerClick (Sender: TObject);

procedure B_GetQuestionClick (Sender: TObject);

procedure B_Answer_GetNumValsClick (Sender: TObject);

procedure LE_OnExit (Sender: TObject);

procedure M_MakeLegal_ValueExit (Sender: TObject);

procedure B_GetTargetClick (Sender: TObject);

procedure Button1Click (Sender: TObject);

procedure Button2Click (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

word_string=string [word_max] ;

line_string=string [line_max] ;

value_ptr=^value;

legal_ptr=^legal_value;

frime_ptr=^frime;

value=record // значение

name: word_string; // Имя

cert: integer; // коэффициент доверия

next: value_ptr; // указатель на след. значение

end;

legal_value=record // Допустимое значение

name: word_string; // Имя

next: legal_ptr; // Указатель на следующее допуст. значение

end;

frime=record // Фрейм

name: word_string; // имя

question: line_string; // атрибут ("вопрос")

question: line_string; // атрибут ("вопрос")

multivald: boolean; // флаг многозначности

legal_list: legal_ptr; // указатель на 1ый элемент списка допустимых значений

sought: boolean; // флаг "найденности"

value_list: value_ptr; // указатель на 1ый элемент списка значений ("ответ (ы)")

next: frime_ptr // указатель на следующий фрейм

end;

prem_ptr=^prem;

con_ptr=^con;

rule_ptr=^rule;

prem=record // Предпосылка

frime: word_string; // имя фрейма

value: word_string; // имя значение

next: prem_ptr; // указатель на следующую

end;

con=record // заключение

frime: word_string; // имя фрейма

value: word_string; // имя значения

cert: integer; // коэффициент доверия

next: con_ptr; // указатель на следующее

end;

rule=record // правило

name: word_string; // имя

prem: prem_ptr; // указатель на предпосылку

con: con_ptr; // указатель на заключение

next: rule_ptr; // указатель на следующее

end;

var

MainForm: TMainForm;

last_try, // результат последнего поиска

top_fact: frime_ptr; // указатель на начало списка фреймов-объктов

top_rule: rule_ptr; // указатель на начало списка правил

rulesFile: TextFile;

explain: boolean;

procedure make_node (var curr_frime: frime_ptr);

function find_frime (f_frime: word_string): frime_ptr;

procedure split (f_line: line_string; var f_frime,f_value: word_string);

function test (f_frime,f_value: word_string): value_ptr;

procedure add_frime (f_frime,f_value: word_string);

procedure see_vals (curr_frime: frime_ptr; cf_on: boolean);

procedure see_frimes (cf_on: boolean);

function get_cf (f_line: line_string): integer;

function blend (cf1,cf2: integer): integer;

procedure add_cf (f_frime,f_value: word_string; cf2: integer);

function ok_add (f_frime: word_string; cf: integer): boolean;

procedure make_multi (f_frime: word_string);

function find_word (f_line: line_string; n: integer; var _word: word_string): boolean;

procedure add_legal (f_legal: word_string; curr_frime: frime_ptr);

function find_legal (f_frime: word_string; n: integer; var _word: word_string): boolean;

procedure make_legals (m_line: word_string);

procedure make_legals_from_form (f_frime: word_string);

procedure add_question (f_frime,s_value: word_string);

function p_question (f_frime: word_string): line_string;

procedure ask (f_frime: word_string; var f_value: word_string);

procedure p_read (var oline: line_string);

function add_prem (curr_prem: prem_ptr; f_line: line_string): prem_ptr;

function add_con (curr_con: con_ptr; f_line: line_string): con_ptr;

procedure p_rule (curr_rule: rule_ptr);

procedure enter_rule (rule_name: word_string);

procedure LoadFormFile;

procedure SaveToFile;

function find_rule (fri: word_string; curr_rule: rule_ptr): rule_ptr;

procedure pursue (f_frime: word_string);

procedure q_result (f_frime: word_string);

procedure explain_how (curr_rule: rule_ptr);

procedure explain_why (f_frime: word_string);

implementation

{$R *. dfm}

procedure make_node;

var

head: frime_ptr;

begin

new (curr_frime);

head: =top_fact;

top_fact: =curr_frime;

with curr_frime^ do begin

next: =head;

value_list: =nil;

question: ='';

legal_list: =nil;

multivald: =false;

sought: =false;

end;

end;

function find_frime;

var

curr_frime: frime_ptr;

begin

if (last_try<>nil) and (last_try^. name=f_frime)

then begin

Result: =last_try;

exit;

end

else begin

curr_frime: =top_fact;

last_try: =nil;

Result: =nil;

while (curr_frime<>nil) and (Result=nil) do begin

if (curr_frime^. name=f_frime)

then begin

Result: =curr_frime;

Last_try: =curr_frime;

exit;

end;

curr_frime: =curr_frime^. next;

end;

end;

end;

procedure split;

var

st_left,

st_right: integer;

begin

st_right: =pos (period,f_line);

if st_right=length (f_line) then f_line: =copy (f_line,1,st_right-1);

st_left: =pos (equals,f_line);

st_right: =pos (comma,f_line);

if ( (st_left=0) and (st_right=0)) then f_frime: =f_line;

if (st_right=0) then st_right: =length (f_line) +1;

if st_left>0

then begin

f_frime: =copy (f_line,1,st_left-1);

if pos (') ',f_frime) =0

then f_value: =copy (f_line,st_left+1,st_right-st_left-1);

end;

st_right: =pos (') ',f_frime);

Приложение А (продолжение)

if st_right>0 then f_frime: =copy (f_line,1,st_right-1);

end;

function test (f_frime,f_value: word_string): value_ptr;

var

curr_frime: frime_ptr;

curr_value: value_ptr;

begin

curr_frime: =find_frime (f_frime);

Result: =nil;

if curr_frime<>nil

then begin

curr_value: =curr_frime^. value_list;

while (curr_value<>nil) do begin

if curr_value^. name= f_value

then Result: =curr_value;

curr_value: =curr_value^. next;

end;

end;

end;

procedure add_frime (f_frime,f_value: word_string);

var

curr_frime: frime_ptr;

value_list,head: value_ptr;

begin

curr_frime: =find_frime (f_frime);

if curr_frime=nil

then begin

make_node (curr_frime);

curr_frime^. name: =f_frime;

end;

curr_frime^. sought: = true;

value_list: =test (f_frime, f_value);

if value_list=nil

then begin

head: =curr_frime^. value_list;

new (value_list);

with value_list^ do begin

next: =head;

cert: =0;

name: =f_value;

end;

curr_frime^. value_list: =value_list;

end;

end;

procedure see_vals;

var

curr_value: value_ptr;

cf: integer;

bufStr: string;

begin

curr_value: =curr_frime^. value_list;

bufStr: =curr_frime^. name+equals;

if curr_value=nil

then bufStr: =bufStr+' He определено';

while (curr_value<>nil) do begin

bufStr: =bufStr+curr_value^. name;

if (cf_on=true)

then begin

cf: =curr_value^. cert;

bufStr: =BufStr+' (Кд='+IntToStr (cf) +') ';

end;

curr_value: =curr_value^. next;

if curr_value<>nil then bufStr: =BufStr+','+NextRow;

end;

MainForm. Memo_Report. Lines. Add (BufStr);

end;

procedure see_frimes (cf_on: boolean);

var

curr_frime: frime_ptr;

begin

MainForm. Memo_Report. Lines. Add ('');

MainForm. Memo_Report. Lines. Add ('Просмотр фактов базы знаний: ');

curr_frime: =top_fact;

while (curr_frime<>nil) do begin

see_vals (curr_frime,cf_on);

curr_frime: =curr_frime^. next;

MainForm. Memo_Report. Lines. Add ('');

end;

end;

function get_cf;

var

resultat,

st_right: integer;

trim: line_string;

begin

Result: =definite;

st_right: =pos (period,f_line);

if st_right=length (f_line)

then f_line: =copy (f_line, 1,st_right-1);

st_right: =pos ('Кд',f_line);

if (st_right>0) and (st_right+3<line_max)

then begin

trim: =copy (f_line,st_right+3,length (f_line) - st_right-2);

val (trim,Result,resultat);

if result>0 then Result: =definite;

if pos ('Плохой',trim) >0

then Result: =25;

if pos ('Средний',trim) >0

then Result: =50;

if pos ('Хороший',trim) >0

then Result: =75;

if pos ('Абсолютный',trim) >0

then Result: =definite;

end;

end;

function blend;

begin

blend: = (100* (cf1+cf2) - (cf1*cf2)) div 100;

end;

procedure add_cf (f_frime,f_value: word_string; cf2: integer);

var

cf1: integer;

curr_value: value_ptr;

begin

curr_value: =test (f_frime,f_value);

cf1: =curr_value^. cert;

curr_value^. cert: =blend (cf1,cf2);

end;

function ok_add;

var

curr_frime: frime_ptr;

curr_value: value_ptr;

is_100: boolean;

begin

is_100: =false;

curr_frime: =find_frime (f_frime);

if curr_frime<>nil

then begin

curr_value: =curr_frime^. value_list;

while (curr_value<>nil) do begin

if curr_value^. cert=definite

then begin

is_100: =true;

break;

end;

curr_value: =curr_value^. next;

end;

end;

Result: =not ( (cf=definite) and (is_100) and (not (curr_frime^. multivald)));

end;

procedure make_multi;

var

curr_frime: frime_ptr;

begin

curr_frime: =find_frime (f_frime);

if curr_frime=nil

then begin

make_node (curr_frime);

curr_frime^. name: =f_frime;

end;

curr_frime^. multivald: =true;

end;

function find_word;

var

x, com_place: integer;

begin

Result: =false;

_word: ='';

for x: =1 to n do begin

com_place: =pos (comma,f_line);

if com_place=0

then begin

com_place: =length (f_line) +1;

Result: =true;

end;

_word: =copy (f_line,1,com_place-1);

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

end;

end;

procedure add_legal;

var curr_legal,head: legal_ptr;

begin

new (curr_legal);

curr_legal^. next: =nil;

curr_legal^. name: =f_legal;

head: =curr_frime^. legal_list;

if head<>nil

then begin

while (head^. next<>nil) do

head^. next: =curr_legal;

end

else

curr_frime^. legal_list: =curr_legal;

end;

function find_legal;

var

curr_frime: frime_ptr;

curr_legal: legal_ptr;

counter: integer;

begin

curr_frime: =find_frime (f_frime);

Result: =true;

if curr_frime<>nil

then begin

curr_legal: =curr_frime^. legal_list;

_word: =curr_legal^. name;

counter: =1;

if curr_legal=nil

then Result: =false;

while (curr_legal<>nil) and (counter<n) do begin

curr_legal: =curr_legal^. next;

if curr_legal<>nil

then begin

_word: =curr_legal^. name;

inc (counter);

end

else

Result: =False;

end;

end

else

Result: =False;

end;

procedure make_legals;

var

curr_frime: frime_ptr;

counter,

st_place: integer;

new_line: line_string;

_word,

f_frime,

dummy: word_string;

done: boolean;

begin

split (m_line,f_frime,dummy);

curr_frime: =find_frime (f_frime);

if curr_frime=nil

then begin

make_node (curr_frime);

curr_frime^. name: =f_frime;

end;

st_place: =pos (equals,f_frime);

new_line: =copy (f_frime,st_place+1,length (f_frime) - st_place);

counter: =1;

done: =false;

while not done do begin

done: =find_word (new_line,counter,_word);

add_legal (_word,curr_frime);

counter: =counter+1;

end;

end;

procedure make_legals_from_form;

var

curr_frime: frime_ptr;

i: integer;

begin

curr_frime: =find_frime (f_frime);

if curr_frime=nil

then begin

make_node (curr_frime);

curr_frime^. name: =f_frime;

end;

with MainForm. M_MakeLegal_Value do

If Lines. Count>0 then

for i: =0 to Lines. Count-1 do

add_legal (Lines [i],curr_frime);

end;

procedure add_question;

var

curr_frime: frime_ptr;

begin

curr_frime: =find_frime (f_frime);

if curr_frime=nil

then begin

make_node (curr_frime);

curr_frime^. name: =f_frime;

end;

curr_frime^. question: =s_value;

end;

function p_question;

var

curr_frime: frime_ptr;

begin

curr_frime: =find_frime (f_frime);

if curr_frime<>nil

then begin

if curr_frime^. question<>''

then

Result: =curr_frime^. question

else

Result: ='Вопрос объекта пуст';

еnd

else

Result: ='Объект в базе не найден';

end;

procedure ask;

var

pick,

num_vals: integer;

_word: word_string;

begin

if not find_legal (f_frime,1,_word)

then begin

MainForm. Memo_Report. Lines. Add ('Введите значение и нажмите кнопку "Выбрать"');

MainForm. B_Answer_GetNumVals. Enabled: =True;

while MainForm. B_Answer_GetNumVals. Tag=0 do

Application. ProcessMessages;

MainForm. B_Answer_GetNumVals. Tag: =0;

f_value: =MainForm. LE_Answer_Value. Text; // readln (f_value)

end

else begin

num_vals: =1;

with MainForm. Memo_Report. Lines do begin

Add ('Допустимые значения объекта "'+f_frime+'": ');

while find_legal (f_frime,num_vals,_word) do begin

Add (IntToStr (num_vals) +'. '+_word);

inc (num_vals);

end;

end;

MainForm. SE_Answer. MaxValue: =num_vals-1;

MainForm. Memo_Report. Lines. Add ('Выберите номер ответа и нажмите кнопку "Выбрать"');

MainForm. B_Answer_GetNumVals. Enabled: =True;

while MainForm. B_Answer_GetNumVals. Tag=0 do

Application. ProcessMessages;

pick: =MainForm. SE_Answer. Value; // ord (select [1]) - 48;

MainForm. B_Answer_GetNumVals. Tag: =0;

find_legal (f_frime,pick,_word);

f_value: =_word;

end;

end;

procedure p_read;

var

c: char;

len,

counter,

st_place: integer;

supress: boolean;

in_line: line_string;

begin

readln (RulesFile, in_line);

in_line: =AnsiLowerCase (in_line);

oline: ='';

len: =length (in_line);

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

if st_place>0

then len: =st_place;

supress: =false;

for counter: =1 to len do begin

c: =in_line [counter] ;

if (c=equals) and (pos ('вопрос',oline) >0)

then supress: =true;

if ord (c) =9

then c: =' ';

if (c<>'') or (supress=true)

then oline: =concat (oline,c);

end;

end;

function add_prem;

var

new_prem: prem_ptr;

f_frime,f_value: word_string;

begin

split (f_line,f_frime,f_value);

add_prem: =curr_prem;

new (new_prem);

with new_prem^ do begin

frime: =f_frime;

value: =f_value;

next: =nil;

end;

if curr_prem=nil

then

add_prem: =new_prem

else begin

while (curr_prem^. next<>nil) do

curr_prem: =curr_prem^. next;

curr_prem^. next: =new_prem;

end;

end;

function add_con (curr_con: con_ptr; f_line: line_string): con_ptr;

var

new_con: con_ptr;

f_frime,

f_value: word_string;

begin

split (f_line,f_frime,f_value);

add_con: =curr_con;

new (new_con);

with new_con^ do begin

frime: =f_frime;

value: =f_value;

cert: =get_cf (f_line);

next: =nil;

end;

if curr_con=nil

then

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<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.