Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Курсовые проекты / курса не мои / Андрюха / _NEXT_ СПО прога / Unit1
.pasunit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, ComCtrls, Buttons, ExtCtrls ;
type
TForm1 = class(TForm)
Label3: TLabel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
Bevel1: TBevel;
Label2: TLabel;
Edit2: TEdit;
Button2: TButton;
GroupBox1: TGroupBox;
Label4: TLabel;
Label6: TLabel;
Label8: TLabel;
Label9: TLabel;
GroupBox2: TGroupBox;
Label12: TLabel;
Label14: TLabel;
Button5: TButton;
Label1: TLabel;
OpenDialog1: TOpenDialog;
Button6: TButton;
Button3: TButton;
Memo2: TMemo;
Label11: TLabel;
Label13: TLabel;
StringGrid3: TStringGrid;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
Label5: TLabel;
Memo3: TMemo;
TabSheet4: TTabSheet;
TreeView1: TTreeView;
Edit1: TEdit;
Label7: TLabel;
Label10: TLabel;
Label15: TLabel;
StringGrid4: TStringGrid;
Button1: TButton;
Memo1: TMemo;
BitBtn1: TBitBtn;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
procedure Button1Click(Sender: TObject);
procedure vCreat(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
public
procedure TabID();
procedure TabIDlec();
procedure Derevo();
procedure ProstoZ();
end;
var
Form1: TForm1;
ukazatel,knop1,knop,vssrav,nomer,adres,raz,a1:integer;
srsrav,srsrav1,vssrav1:real;
tek_uz,koren:string;
inputString:TStringList;
const
PredMatrix:array [1..26,1..26] of char=
( {pr end. ; if then els enf beg end do wle a := or and not < > = ( ) - + * / !}
{prog} (' ','=','<','<',' ',' ',' ','<',' ',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{end.} (' ',' ','>',' ',' ',' ','>',' ','>',' ',' ','>',' ',' ',' ',' ',' ',' ',' ',' ','>',' ',' ',' ',' ','>'),
{;} (' ','>','>','<',' ',' ',' ','<','>',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{if} (' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' ','<',' ','<','<','<','<','<','<','<',' ','<','<','<','<',' '),
{then} (' ',' ',' ','<',' ','=','=','<',' ',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{else} (' ',' ',' ','<',' ',' ','=','<',' ',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{endif}(' ','>','>',' ',' ','>','>',' ','>','>','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{begin}(' ',' ','<','<',' ',' ',' ','<','=',' ','>','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{end} (' ','>','>',' ',' ','>','>',' ','>',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{do} (' ','>','>','<',' ','>',' ','<','<',' ','<','<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '),
{while}(' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','=',' ',' ',' ',' ',' ',' '),
{a} (' ','>','>',' ','>','>','>',' ','>','>','>',' ','=','>','>','>','>','>','>',' ','>','>','>','>','>',' '),
{:=} (' ','>','>',' ',' ','>','>',' ','>','>',' ','<',' ',' ',' ',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{or} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{and} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{not} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<','<','<','<','<','<','>','<','<','<','<',' '),
{<} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{>} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{=} (' ',' ',' ',' ','>',' ',' ',' ',' ',' ',' ','<',' ','>','<',' ',' ',' ',' ','<','>','<','<','<','<',' '),
{(} (' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','<',' ','<','<','<','<','<','<','<','=','<','<','<','<',' '),
{)} (' ','>','>',' ','>','>','>',' ','>','=','<',' ',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{-} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{+} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{*} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{/} (' ','>','>',' ','>','>','>',' ','>','>','>','<',' ','>','>',' ','>','>','>',' ','>','>','>','>','>',' '),
{!} ('<',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' '));
{Описание правил грамматики}
grammar:array [1..27] of string=
('progEend.','E','E;E','E;','ifEthenEelseEendif','ifEthenEendif','beginEend','while(E)doE','E','a:=E',
'EorE','E','EandE','E','notE','E','E<E','E>E','E=E','(E)','E-E','E+E','E*E','E/E','E','(E)','a');
term:array [1..26] of string=
('prog','end.',';','if','then','else','endif','begin','end','do','while','a',':=','or','and','not','<','>','=','(',')','-','+','*','/','!');
notterm:array [1..27] of char=
('E','E','E','E','E','E','E','E','E','E','B','E','E','E','E','E',
'E','E','E','E','E','E','E','E','E','E','E');
CanonO:array [1..27,1..7] of string=
(('prog','E','end.','','','',''),
('E','','','','','',''),
('E',';','E','','','',''),
('E',';','','','','',''),
('if','E','then','E','else','E','endif'),
('if','E','then','E','endif','',''),
('begin','E','end','','','',''),
('while','(','E',')','do','E',''),
('E','','','','','',''),
('a',':=','E','','','',''),
('E','or','E','','','',''),
('E','','','','','',''),
('E','and','E','','','',''),
('E','','','','','',''),
('not','E','','','','',''),
('E','','','','','',''),
('E','<','E','','','',''),
('E','>','E','','','',''),
('E','=','E','','','',''),
('(','E',')','','','',''),
('E','-','E','','','',''),
('E','+','E','','','',''),
('E','*','E','','','',''),
('E','/','E','','','',''),
('E','','','','','',''),
('(','E',')','','','',''),
('a','','','','','',''));
implementation
function IndMatrix(SymS:String):integer;
var i:integer;
begin
indMatrix:=0;
if term[1]=SymS then IndMatrix:=1;
for i:=1 to 26 do
if term[i]=SymS then IndMatrix:=i;
end;
function inArray(myS:String;A:Array of string;N:integer):boolean;
var i:integer;
begin
inArray:=False;
if myS='prog' then inArray:=true;
for i:=1 to N do
if myS=A[i] then begin inArray:=true end;
end;
function NomRul(myS:String):integer;
var i:integer;
begin
NomRul:=0;
if (myS=grammar[1])then NomRul:=1;
for i:=1 to 27 do
if grammar[i]=myS then NomRul:=i;
end;
function findnt(myS:String):string;
begin
findnt:='';
findnt:=notterm[nomRul(myS)]
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
type
TAState = ( A_H, A_OR1, A_OR2, A_NO1,A_NO2,A_NO3,A_VA1,A_VA2,A_VA3,A_CH1,
A_DO1,A_DO2,A_WH1,A_WH2,A_WH3,A_WH4,A_WH5,A_BY1,A_BY2,A_BY3,A_BY4,A_KO1,A_KO2,
A_KO3,A_P1,A_P2,A_P3,A_P4,A_BE1,A_BE2,A_BE3,A_BE4,A_BE5,A_EL1,A_EL2,A_EL3,A_TH1,
A_TH2,A_TH3,A_TH4,A_IF1,A_IF2,A_AN1,A_AN2,A_AN3,A_TO,A_Z,A_C1,A_C2,A_SL,A_GA,
A_PR1,A_PR2,A_PR3,A_TZ,A_PL,A_GA2,A_PO,A_MI,A_E,A_ID,A_IR1,A_IR2,A_KO4, A_IR3,A_BY5,A_PR4,A_BI2,A_BI1,A_BI3,A_KO5,A_SK,A_SK1);
var ind,pos,dl,i,j,i1,fl,zn,m:integer;
st,str,stroka:string;
sost:TAState;
CepofV:array [1..100]of integer;
p,stek,d:TStringList;
i2,i4,j2,fl2,n,k,vetv,u,ZZZ:integer;
MyTreeNode:TTreeNode;
nodeTree: TTreeNode;
begin
memo1.Clear;
if OpenDialog1.execute then
Memo1.lines.loadFromFile(OpenDialog1.FileName) ;
inputString:=TStringList.Create;
inputString.Sorted:=False;
for i:=0 to 2 do
for i1:=1 to 999 do
StringGrid3.Cells[i,i1]:='';
i1:=Memo1.Lines.Count;
ind:=1;
pos:=1;
ZZZ:=0;
sost:=A_H;
for i:=1 to i1 do
begin
str:='';
stroka:=Memo1.Lines[i-1];
stroka:=stroka+' ';
dl:=Length(stroka);
if ZZZ=1 then sost:=A_C1 else sost:=A_H;
fl:=0;
zn:=0;
for j:=1 to dl do
begin
st:=stroka[j];
case sost of
A_H:
case stroka[j] of
';': begin sost:=A_TZ;str:=str+st; end;
'>': begin sost:=A_GA2;str:=str+st; end;
'<': begin sost:=A_GA; str:=str+st end;
'=': begin sost:=A_PO; str:=str+st end;
':': begin sost:=A_P1;str:=str+st; end;
'n': begin sost:=A_NO1;str:=str+st; end;
'p': begin sost:=A_PR1;str:=str+st; end;
'e': begin sost:=A_KO1;str:=str+st; end;
'i': begin sost:=A_IF1;str:=str+st; end;
't': begin sost:=A_TH1;str:=str+st; end;
'o': begin sost:=A_OR1;str:=str+st; end;
'+': begin sost:=A_PL;str:=str+st; end;
'-': begin sost:=A_MI;str:=str+st; end;
'a': begin sost:=A_IR1;str:=str+st; end;
'{': begin sost:=A_C1;str:=str+st;ZZZ:=1 end;
'*': begin sost:=A_Z;str:=str+st; end;
'/': begin sost:=A_SL;str:=str+st; end;
'd': begin sost:=A_DO1;str:=str+st; end;
'w': begin sost:=A_WH1;str:=str+st; end;
'b': begin sost:=A_BY1;str:=str+st; end;
'(': begin sost:=A_SK;str:=str+st; end;
')': begin sost:=A_SK1;str:=str+st; end;
'0','1': begin sost:=A_CH1;str:=str+st; end;
'c','f'..'h','m','q'..'s','u','v','x'..'z': begin sost:=A_ID;str:=str+st; end;
' ': begin sost:=A_H;str:=''; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_C1:
case stroka[j] of
'}':begin sost:=A_H; ZZZ:=0; end;
else begin sost:=A_C1;str:=str+st; end;
end;
A_SK:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=2; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_SK1:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=3; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_TZ:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=1; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_GA2:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=12; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_GA:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=13; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_MI:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=17; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_PL:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=16; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_PO:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=6; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_Z:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=15; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_SL:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=15;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_CH1:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=11; end;
'0','1': begin sost:=A_CH1;str:=str+st; end;
else begin sost:=A_E;str:=str+st; end; end;
A_DO1:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=5; end;
'a'..'n','p'..'z','0'..'9' : begin sost:=A_ID; str:=str+st; end;
'o': begin sost:=A_DO2;str:=str+st; end;
else begin sost:=A_E;str:=str+st; end;
end;
A_DO2:
case stroka[j] of
'a'..'z','0'..'9': begin sost:=A_ID;str:=str+st; end;
' ':begin sost:=A_H;fl:=1;zn:=10;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_WH1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'h': begin sost:=A_WH2;str:=str+st;end;
'a'..'g','i'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_WH2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'i': begin sost:=A_WH3;str:=str+st;end;
'a'..'h','j'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_WH3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'l': begin sost:=A_WH4;str:=str+st;end;
'a'..'k','m'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_WH4:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'e': begin sost:=A_WH5;str:=str+st;end;
'a'..'d','f'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_WH5:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=24;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_ID:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BY1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'y' : begin sost:=A_BI1;str:=str+st;end;
'e': begin sost:=A_BY2;str:=str+st;end;
'a'..'d','f'..'x','z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BY2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'g': begin sost:=A_BY3;str:=str+st;end;
'a'..'f','h'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BY3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'i': begin sost:=A_BY4;str:=str+st;end;
'a'..'h','j'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BY4:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'n': begin sost:=A_BY5;str:=str+st;end;
'a'..'m','o'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BY5:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=21;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BI1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
't': begin sost:=A_BI2;str:=str+st;end;
'a'..'s','u'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BI2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'e': begin sost:=A_BI3;str:=str+st;end;
'a'..'d','f'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_BI3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=14;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_PR1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'r': begin sost:=A_PR2;str:=str+st;end;
'a'..'q','s'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_PR2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'o': begin sost:=A_PR3; str:=str+st;end;
'a'..'n','p'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_PR3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'g': begin sost:=A_PR4; str:=str+st;end;
'a'..'f','h'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_PR4:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=25;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_IF1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'f': begin sost:=A_IF2;str:=str+st;end;
'a'..'e','g'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_IF2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=18;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_OR1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'r': begin sost:=A_OR2;str:=str+st;end;
'a'..'q','s'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_OR2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=7;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_P1:
case stroka[j] of
'=':begin sost:=A_P2;str:=str+st;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_P2:
case stroka[j] of
' ':begin sost:=A_H;fl:=1;zn:=4;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_KO1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'n': begin sost:=A_KO2;str:=str+st;end;
'l': begin sost:=A_EL1;str:=str+st;end;
'a'..'k','m','o'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_KO2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'd': begin sost:=A_KO3;str:=str+st;end;
'a'..'c','e'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_KO3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=22;end;
'i','.': begin sost:=A_KO4;str:=str+st;end;
'a'..'h','j'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_KO4:
case stroka[j] of
'f': begin sost:=A_KO5;str:=str+st;end;
' ': begin sost:=A_H;fl:=1;zn:=23;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_KO5:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=26;end;
else begin sost:=A_E;str:=str+st; end;
end;
A_EL1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
's': begin sost:=A_EL2;str:=str+st;end;
'a'..'r','t'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_EL2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'e': begin sost:=A_EL3;str:=str+st;end;
'a'..'d','f'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_EL3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=20;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_IR1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'n': begin sost:=A_IR2;str:=str+st;end;
'a'..'m','o'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_IR2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'd': begin sost:=A_IR3;str:=str+st;end;
'a'..'c','e'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_IR3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=8;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_NO1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'o': begin sost:=A_NO2;str:=str+st;end;
'a'..'n','p'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_NO2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
't': begin sost:=A_NO3;str:=str+st;end;
'a'..'s','u'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_NO3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=9;end;
'a'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_TH1:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'h': begin sost:=A_TH2;str:=str+st;end;
'a'..'g','i'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_TH2:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'e': begin sost:=A_TH3;str:=str+st;end;
'a'..'d','f'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_TH3:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=5;end;
'n': begin sost:=A_TH4;str:=str+st;end;
'a'..'m','o'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_TH4:
case stroka[j] of
' ': begin sost:=A_H;fl:=1;zn:=19;end;
'a'..'d','f'..'z','0'..'9':begin sost:=A_ID;str:=str+st; end;
else begin sost:=A_E; str:=str+st; end;
end;
A_E: begin
if stroka[j]<>' 'then
begin
sost:=A_E;
str:=str+st;
end
else
begin
sost:=A_H;
Memo2.Lines.Append('Ошибочные символы -'+str+' СТОП!!! ');
str:='';
abort;
end;
end;
end;
if fl=1 then
begin
StringGrid3.Cells[0,ind]:=IntToStr(ind);
StringGrid3.Cells[1,ind]:=str;
if (zn=5) or (zn=11) then begin memo3.Lines.Add(str); end;
case zn of
1: begin StringGrid3.Cells[2,ind]:='Разделяюший знак ;'; inputString.Add(';'); end;
2: begin StringGrid3.Cells[2,ind]:=' открывающиеся скобки'; inputString.Add('('); end;
3: begin StringGrid3.Cells[2,ind]:=' закрывающиеся скобки'; inputString.Add(')'); end;
4: begin StringGrid3.Cells[2,ind]:='Знак присваивания'; inputString.Add(':='); end;
5: begin StringGrid3.Cells[2,ind]:='Идентификатор'; inputString.Add('a'); end;
6: begin StringGrid3.Cells[2,ind]:='Операвтор сравнения "равно"'; inputString.Add('='); end;
7: begin StringGrid3.Cells[2,ind]:='Логическое "или"'; inputString.Add('or'); end;
8: begin StringGrid3.Cells[2,ind]:='Логическое "и"'; inputString.Add('and'); end;
9: begin StringGrid3.Cells[2,ind]:='Логическое "не"'; inputString.Add('not'); end;
10: begin StringGrid3.Cells[2,ind]:='Ключевое слово do'; inputString.Add('do'); end;
11: begin StringGrid3.Cells[2,ind]:='Константа'; inputString.Add('a'); end;
12: begin StringGrid3.Cells[2,ind]:='Оператор сравнения "меньше" '; inputString.Add('>'); end;
13: begin StringGrid3.Cells[2,ind]:='Оператор сравнения "больше"'; inputString.Add('<'); end;
15: begin StringGrid3.Cells[2,ind]:='Дополнительные операции / '; inputString.Add('/'); end;
16: begin StringGrid3.Cells[2,ind]:='Арифметические операции +'; inputString.Add('+'); end;
17: begin StringGrid3.Cells[2,ind]:='Арифметические операции -';inputString.Add('-'); end;
18: begin StringGrid3.Cells[2,ind]:='Ключевое слово IF'; inputString.Add('if'); end;
19: begin StringGrid3.Cells[2,ind]:='Ключевое слово then'; inputString.Add('then'); end;
20: begin StringGrid3.Cells[2,ind]:='Ключевое слово else'; inputString.Add('else'); end;
21: begin StringGrid3.Cells[2,ind]:='Ключевое слово begin'; inputString.Add('begin'); end;
22: begin StringGrid3.Cells[2,ind]:='Ключевое слово end'; inputString.Add('end'); end;
23: begin StringGrid3.Cells[2,ind]:='Ключевое слово end.'; inputString.Add('end.'); end;
24: begin StringGrid3.Cells[2,ind]:='Ключевое слово while'; inputString.Add('while'); end;
25: begin StringGrid3.Cells[2,ind]:='Ключевое слово prog'; inputString.Add('prog'); end;
26: begin StringGrid3.Cells[2,ind]:='Ключевое слово endif'; inputString.Add('endif'); end;
end;
str:='';
ind:=ind+1;
fl:=0;
end;
end;
end;
Derevo();
TabIDlec();
end;
procedure TForm1.vCreat(Sender: TObject);
var a1,a2,i:integer;
begin
for a1:=0 to 3 do
for a2:=1 to 500 do
StringGrid2.Cells[a1,a2]:='';
for i:=1 to 500 do
begin
StringGrid1.Cells[0,i]:=IntToStr(i);
end;
for i:=1 to 500 do
begin
StringGrid4.Cells[0,i]:=IntToStr(i);
end;
StringGrid1.Cells[0,0]:='Номер';
StringGrid1.Cells[1,0]:='Иден-р';
StringGrid2.Cells[0,0]:='Индекс';
StringGrid2.Cells[1,0]:='Знач.ид.';
StringGrid2.Cells[2,0]:='Лев.сс.';
StringGrid2.Cells[3,0]:='Пра.сс.';
StringGrid3.Cells[0,0]:='Номер';
StringGrid3.Cells[1,0]:='Лексема';
StringGrid3.Cells[2,0]:='Инфа';
nomer:=0;
ukazatel:=0;
srsrav:=0;
knop:=0;
vssrav:=0;
srsrav1:=0;
knop1:=0;
vssrav1:=0;
adres:=0;
raz:=0;
a1:=1;
end;
function Xesh(St:string):integer; {процедура вычисление значения хэш-функции}
var dlina:integer;
twosyb:char;
fivesyb:char;
begin
dlina:=length(St);
if dlina=0 then Result:=0 else
begin
if dlina>=4 then begin
twosyb:=St[1];
fivesyb:=St[5];
Result:=ord(fivesyb)+ord(twosyb);
end
else begin
twosyb:=St[1];
Result:=ord( twosyb);
end;
end;
end;
procedure TForm1.TabID(); //заполн Рехеш
var i,j,k,dlina,ukazatel,hash,kol:integer;
stroka:string;
label 1,2;
begin
j:=0;
k:=2;
kol:=0;
ukazatel:=0;
dlina:=memo1.Lines.Count;
if dlina<>0 then
begin
for i:=0 to dlina-1 do
begin
stroka:=memo1.Lines[i];
hash:=Xesh(stroka);
if (StringGrid1.cells[1,hash])='' then
begin
StringGrid1.cells[1,hash]:=stroka;
end
else
begin
1: if (StringGrid1.cells[1,hash])=stroka then
begin
memo2.Lines[j]:='Удален повтор '+stroka;
j:=j+1;
ukazatel:=ukazatel+1;
goto 2;
end
else
begin
kol:=kol+1;
hash:=(Xesh(stroka)*k) mod 509;
if (StringGrid1.cells[1,hash])='' then
begin
StringGrid1.cells[1,hash]:=stroka;
end
else
begin
k:=k+1;
goto 1;
end;
end;
end;
2: end;
end;
Label5.Caption:='Кол-во коллизий '+inttostr(kol);
end;
procedure TForm1.TabIDlec(); //заполн Рехеш
var i,j,k,dlina,ukazatel,hash,kol:integer;
stroka:string;
label 1,2;
begin
j:=0;
k:=2;
kol:=0;
ukazatel:=0;
dlina:=memo3.Lines.Count;
if dlina<>0 then
begin
for i:=0 to dlina-1 do
begin
stroka:=memo3.Lines[i];
hash:=Xesh(stroka);
if (StringGrid4.cells[1,hash])='' then
begin
StringGrid4.cells[1,hash]:=stroka;
end
else
begin
1: if (StringGrid4.cells[1,hash])=stroka then
begin
// memo2.Lines[j]:='Удален повтор '+stroka;
j:=j+1;
ukazatel:=ukazatel+1;
goto 2;
end
else
begin
kol:=kol+1;
hash:=(Xesh(stroka)*k) mod 499;
if (StringGrid4.cells[1,hash])='' then
begin
StringGrid4.cells[1,hash]:=stroka;
end
else
begin
k:=k+1;
goto 1;
end;
end;
end;
2: end;
end;
Label18.Caption:='Кол-во коллизий '+inttostr(kol);
StringGrid4.Cells[0,0]:='Номер';
StringGrid4.Cells[1,0]:='Иден-р';
end;
procedure TForm1.ProstoZ(); //Заполнение Бинарное дерево
Label M1,M2,M3,M4;
Var i,i1,i2,i3,a1,a2,adres,i4:integer;
tek_uz,str,koren:string;
begin
for a1:=0 to 3 do
for a2:=1 to 500 do
StringGrid2.Cells[a1,a2]:='';
i1:=Memo1.Lines.Count;
begin
if Memo1.Lines[1]<>'' then
begin
StringGrid2.Cells[0,1]:='1';
StringGrid2.Cells[1,1]:=Memo1.Lines[0];
adres:=1;
koren:=StringGrid2.Cells[1,adres];
for i:=2 to i1-1 do
begin
a1:=1;
tek_uz:=koren;
str:=Memo1.Lines[i];
M1:
if str=tek_uz then Begin goto M3; end
else
if str<tek_uz then
if StringGrid2.Cells[2,a1]='' then
begin
adres:=adres+1;
StringGrid2.Cells[0,adres]:=IntToStr(adres);
StringGrid2.Cells[2,a1]:=IntToStr(adres);
StringGrid2.Cells[1,adres]:=str;
end
else
begin
i3:=StrToInt(StringGrid2.Cells[2,a1]);
a1:=i3;
tek_uz:=StringGrid2.Cells[1,a1];
goto M1;
end
else
if StringGrid2.Cells[3,a1]='' then
begin
adres:=adres+1;
StringGrid2.Cells[0,adres]:=IntToStr(adres);
StringGrid2.Cells[3,a1]:=IntToStr(adres);
StringGrid2.Cells[1,adres]:=str;
end
else
begin
i3:=StrToInt(StringGrid2.Cells[3,a1]);
a1:=i3;
tek_uz:=StringGrid2.Cells[1,a1];
goto M1;
end;
M3:
end;
end;
M2:
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button2Click(Sender: TObject);
var k,hash,dlina,i,srav,j,si: integer;
stroka: string;
label met1,met2;
begin
stroka:=Edit2.Text;
if stroka='' then
begin
memo2.Lines.Add('Поле пусто!');
Abort;
end;
inc(knop);
k:=2;
srav:=0;
hash:=Xesh(stroka);
for i:=1 to 500 do
begin
inc(srav);
if StringGrid1.Cells[0,hash]=IntToStr(hash) then
begin
if stroka=StringGrid1.Cells[1,hash] then
begin
memo2.Lines.Add('Иден-р '+stroka+' найден! Его номер '+ IntToStr(hash));
goto met1;
end
else
begin
for j:=1 to 500 do
begin
inc(srav);
hash:=(Xesh(stroka)*k) mod 499;
inc(k);
if StringGrid1.Cells[0,hash]=IntToStr(hash) then
begin
if stroka=StringGrid1.Cells[1,hash] then
begin
memo2.Lines.Add('Иден-р '+stroka+' найден! Его номер '+ IntToStr(hash));
goto met1;
end;
end
//else memo2.Lines.Add('Иден-р '+stroka+' не найден!');
end;
end;
end
else begin
memo2.Lines.Add('Иден-р '+stroka+' не найден!');
abort; end;
end;
met1: Label4.Caption:='Номер '+inttostr(hash);
label6.Caption:='Кол-во сравнений '+inttostr(srav);
label9.Caption:='Кол-во поисков '+inttostr(knop);
dlina:=memo1.Lines.Count;
vssrav:=vssrav+srav;
srsrav:=vssrav/dlina;
Label8.Caption:='Среднее кол-во сравнений '+floattostr(srsrav);
vssrav:=0;
srsrav:=0;
end;
procedure TForm1.Button6Click(Sender: TObject); //сброс
var
i,j:integer;
begin
edit1.Clear;
TreeView1.Items.Clear;
for j:=0 to 2 do begin
for i:=0 to 500 do begin
StringGrid1.Cells[j,i]:=' ';
StringGrid4.Cells[j,i]:=' ';
StringGrid3.Cells[j,i]:=' '; end; end;
for i:=0 to 3 do begin
for j:=0 to 500 do begin
StringGrid2.Cells[i,j]:=' ';
end; end;
label18.Caption:='Кол-во колллизий ';
memo3.Clear;
memo1.Clear;
memo2.Clear;
Edit2.Clear;
nomer:=0;
nomer:=0;
ukazatel:=0;
srsrav:=0;
knop:=0;
vssrav:=0;
srsrav1:=0;
knop1:=0;
vssrav1:=0;
adres:=0;
raz:=0;
a1:=1;
tek_uz:='';
koren:='' ;
label14.Caption:='Кол-во сравнений ';
label12.Caption:='Кол-во поисков ';
label11.Caption:='Среднее кол-во сравнений ';
Label4.Caption:='Номер ' ;
Label5.Caption:='Кол-во коллизий ' ;
Label6.Caption:='Кол-во сравнений ';
label8.Caption:='Среднее кол-во сравнений ';
label9.Caption:='Кол-во поисков ' ;
end;
procedure TForm1.Button5Click(Sender: TObject);
Label M1,M2,M3;
Var strz,tek_uz:string;
i,i1,a1,a2,fl:integer;
begin
strz:=Edit2.Text;
if strz='' then
begin
memo2.Lines.Add('Поле пусто!');
Abort;
end;
i1:=Memo1.Lines.Count;
inc(knop1);
a1:=1;
a2:=0;
fl:=0;
if Strz<>'' then
begin
tek_uz:=StringGrid2.Cells[1,1];
M2:
if strz=StringGrid2.Cells[1,a1] then
begin a2:=a2+1;fl:=1;goto M1;end
else
begin
a2:=a2+1;
if strz<StringGrid2.Cells[1,a1]then
if StringGrid2.Cells[2,a1]='' then goto M1
else
begin
i:=StrToInt(StringGrid2.Cells[2,a1]);
a1:=i;
goto M2;
end
else
if StringGrid2.Cells[3,a1]='' then goto M1
else
begin
i:=StrToInt(StringGrid2.Cells[3,a1]);
a1:=i;
goto M2;
end;
end;
end;
M1:
if fl=1 then begin memo2.lines.add('Элемент ' +strz+' найден.'); end
else begin memo2.lines.add('Элемент не найден.'); end;
Label11.Caption:='Среднее число сравнений '+FloatToStr(a2/i1);
Label14.Caption:='Сравнений '+IntToStr(a2);
Label12.Caption:='Колл-во поисков '+IntToStr(knop1);
end;
procedure TForm1.Derevo();
label Myend,zap,tree;
var SymbStack:TStringList;{входная строка и стэк соответственно}
i,j,verh,k,vetv,n,m,bezz:integer;
gamma,MyinS,syms,tek,cep:String;
mycase:char;
CepofV:array [1..100]of integer;
begin
if inputString.Count=0 then
begin
ShowMessage('Таблица лексем или исходный файл не загружены');
exit
end;
for i:=0 to inputString.Count-1 do MyinS:=MyinS+InputString[i];
{Edit2.Text:=MyinS;}
inputString.Add('!');
{Объявляем стэк}
SymbStack:=TStringList.Create;
SymbStack.Sorted:=False;
SymbStack.Add('!');
i:=0;
k:=0;
cep:='';
while i<=inputString.Count-1 do
begin
verh:=SymbStack.Count-1;
syms:=SymbStack[verh];
while (not(inArray(SymbStack[verh],term,26))) do verh:=verh-1;
if (SymbStack[verh]='!') and (inputString[i]='!') then goto MyEnd;
mycase:=PredMatrix[IndMatrix(SymbStack[verh]),IndMatrix(inputString[i])];
if ((mycase='<')or(mycase='='))then
begin {сдвиг}
SymbStack.Add(inputString[i]);
i:=i+1;
end
else
if (mycase='>')
then
begin {свертка}
gamma:='';
tek:='';
for j:=SymbStack.Count-1 downto 0 do
if not(inArray(SymbStack[j],term,26)) then
begin
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else
if (inArray(SymbStack[j],term,26))and(tek='') then
begin
tek:=SymbStack[j];
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else
if predMatrix[Indmatrix(SymbStack[j]),IndMatrix(tek)]='=' then
begin
tek:=SymbStack[j];
gamma:=SymbStack[j]+gamma;
SymbStack.Delete(j)
end
else break;
if findnt(gamma)<>''
then
begin
SymbStack.Add(findnt(gamma));
k:=k+1;
CepofV[k]:=NomRul(gamma);
{ ShowMessage('Цепочка '+gamma+' заменяется на '+findnt(gamma)+' по правилу '+inttostr(Nomrul(gamma))); }
cep:=inttostr(CepofV[k])+' '+cep;
end
else
begin {ошибка}
ShowMessage('Ошибка! Цепочка '+gamma+' недопустима'); abort;
goto tree
end;
end;
if mycase=' ' then
begin {ошибка}
ShowMessage('Ошибка! Символы '+Symbstack[verh]+' и '+InputString[i]+' не могут следовать друг за другом');
abort;
end;
end;
Myend:Edit1.Text:=cep;
{вывод дерева}
tree:n:=k;
with TreeView1 do
begin
Items.Add(Nil,'E');
vetv:=0;
for k:=n downto 1 do begin
m:=Items.Count;
if k<n then
for i:=m-1 downto 0 do
if Items[i].Text=notterm[CepofV[k]] then
if Items[i].HasChildren=False then
begin
vetv:=i;
goto zap
end;
zap: for i:=1 to 7 do
if CanonO[CepofV[k],i]<>'' then
Items.AddChild(Items[vetv],CanonO[CepofV[k],i])
end;
FullExpand
end;
InputString.Destroy;
SymbStack.Destroy;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
dlina,i:integer;
strZ:string;
begin
if OpenDialog1.execute then
Memo1.lines.loadFromFile(OpenDialog1.FileName) ;
TabID();
ProstoZ();
end;
end.
Соседние файлы в папке _NEXT_ СПО прога