Описание программы. Структуры данных.

type

Sym=recordсведения об элементе анализируемого массива

Num:Boolean; константа или операция

Code:Byte; код для операции или номер в массиве констант

end;

operat=recordэлемент анализируемого массива

Op : Sym;

Prior : Byte

end;

cMas = array [1..Maxsym] of string[10]; массив констант

uMas = array [1..MaxSym] of Operat;

sMas = array [1..MaxSym] of Char;

pTree = ^tTree;

tStr=recordпредставление ф-ии и производной в дереве.

S : array [1..Maxder] of Char;

Len : Integer

end;

tTree=recordэлемент дерева

Code:Integer; код операции или номер в массиве констант

Func,Der:tStr; ф-ия/производная поддеревьев элемента

left,right : pTree

end;

Иерархия функций.

Внешние спецификации функций.

ПОДПРОГРАММА	ДЕЙСТВИЕ
getF	Получает ф-ю из массива операций
GetConst	Получает операнд
Mode	Модифицирует входной файл, удаляя ненужные символы
DataAn	Анализирует входную строку, разбивая ее на операции
GetConMas	Формирует массив использованных в функции переменных
placed	Определяет, есть ли такая переменная в строке
Create	Инициализирует дерево
FindMin	Находит операцию минимального приоритета в массиве
FormCodeTable	Создает кодировочную таблицу для операций
MakeTree	Формирует дерево по массиву
FillStartCond	Заполняет поля в листьях дерева
Push	Записывает одну строку в др. с некоторого номера
Zero	Сравнивает строку с «0»
One	Сравнивает строку с «1»
mOne	Сравнивает строку с «-1»
Equil	Сравнивает строки
InOp	Проверяет, нет ли в строке операций приоритета 1
InOp2	Проверяет, нет ли в строке операций приоритета 1 или 2
InOp3	Проверяет, не один ли символ в строке
Sum	Суммирует строки
Minus	Вычитает строки
Mult	Перемножает строки
Diviz	Делит строки
Deg	Возводит строку в степень другой
Derivate	Дифференцирует
DrawSpace	Выводит некоторое кол-во пробелов на экран
DrawTree	Выводит дерево на экран
DrawSpaceF	Выводит некоторое кол-во пробелов в файл
DrawTreeF	Выводит дерево в файл

Характеристика программы.

Список файлов.

Derivate.exe– программа

Derivat.pas – исходный код

TreeForD.pas– исходный код основного модуля

Inform.pas– исходный код модуля с описанием типов.

i.txt– входной файл для примера

Исследование.

Все проведенные тесты показывают корректность работы программы.

Приложения.

Листинг исходного файла программы.

uses Crt, Inform, Treeford;

var

Size : Integer;

function getF(var M:sMas;var I:Integer;var Code:Byte):Boolean;

var

Get:Boolean;

begin

get := false;

If (M[I] = 's') and (M[I+1] = 'i') and (M[I+2] = 'n') then

begin

Code := 6;

get:=true;

I:=I+3

end;

If (M[I] = 'c') and (M[I+1] = 'o') and (M[I+2] = 's') then

begin

Code := 7;

get:=true;

I:=I+3

end;

If (M[I] = 'a') and (M[I+1] = 's') and (M[I+2] = 'i') then

begin

Code := 8;

get:=true;

I:=I+3

end;

If (M[I] = 'a') and (M[I+1] = 't') and (M[I+2] = 'g') then

begin

Code := 9;

get:=true;

I:=I+3

end;

If (M[I] = 'l') and (M[I+1] = 'o') and (M[I+2] = 'g') then

begin

Code := 10;

get:=true;

I:=I+3

end;

If (M[I] = 'e') and (M[I+1] = 'x') and (M[I+2] = 'p') then

begin

Code := 11;

get:=true;

I:=I+3

end;

GetF := Get

end;

function GetConst(var M:sMas;var I:Integer; var S : String; MaxNum:Integer):Boolean;

var

Del,Exit,Get:Boolean;

H: Text;

begin

assign(H,'H.txt');

rewrite(H);

Get := False;

Del := false;

If (M[I] >= 'a') and (M[I] <= 'z') then

begin

Get := true;

I := I + 1;

S := M[I - 1]

end

else

begin

Exit := false;

while not(Exit) do

begin

If I <= MaxNum then

If (M[I] >= '0') and (M[I] <= '9') then

begin

Get := true;

write(H,M[I]);

I := I + 1;

end

else If M[I] = '.' then

If Del then

Exit := true

else

begin

Get := true;

write(H,'.');

I := I + 1;

Del := true

end

else

Exit := true

else

Exit := true

end;

reset(H);

If Get then

read(H,S)

end;

close(H);

GetConst := Get

end;

procedure Mode(var F:Text);

var

M : sMas;

C : Char;

I,J : Integer;

begin

reset(F);

I := 0 ;

while not(Eof(F)) do

begin

Read(F,C);

If not((ord(C) = 32) or (ord(C) = 13)) then

If (C >= 'A') and (C <= 'Z') then

begin

I := I + 1;

M[I] := chr(ord(C)-ord('A')+ord('a'))

end

else

begin

I := I + 1;

M[I] := C

end

end;

rewrite(F);

For J := 1 to I do

write(F,M[J])

end;

Function DataAn(var F:Text;var OpM:uMas;var CoM:cMas):Boolean;

var

M : sMas;

C : Char;

I,J,MaxNum,BrNum,K,P : Integer;

Exit,Answer,State:Boolean;

S : String;

begin

Mode(F);

reset(F);

I := 1;

while not(Eof(F)) do

begin

Read(F,C);

M[I] := C;

I := I + 1

end;

MaxNum := I - 1;

BrNum := 0;

Exit := false;

I := 1;

J := I;

Answer := false;

State := false;

while (I <= MaxNum) and not(Exit) do

begin

C := M[I];

write(C);

K := I;

If C = '(' then

If State then

begin

writeln;

writeln('It is not a good place for "("');

readkey;

Exit := true;

answer := false

end

else

begin

BrNum := BrNum + 1;

I := I + 1

end

else

If C = ')' then

If (State and (BrNum > 0)) then

begin

BrNum := BrNum - 1;

I := I + 1

end

else

begin

writeln;

writeln('It is not a good place for ")"');

readkey;

Exit := true;

answer := false

end

else If C = '-' then

If State then

begin

OpM[J].Op.Num := false;

Opm[J].Op.Code := 3;

Opm[J].Prior := BrNum * 4 + 1;

State := false;

I := I + 1;

J := J + 1

end

else

begin

OpM[J].Op.Num := true;

CoM[J] := '-1';

OpM[J].Prior := 255;

OpM[J + 1].Op.Num := false;

Opm[J + 1].Op.Code := 4;

Opm[J + 1].Prior := BrNum * 4 + 2;

J := J + 2;

I := I + 1

end

else

If (C = '+') or (C = '*') or (C = '/') or (C = '^') then

If State then

begin

OpM[J].Op.Num := false;

If C = '+' then

begin

Opm[J].Op.Code := 2;

Opm[J].Prior := BrNum * 4 + 1;

J := J + 1;

I := I + 1;

end;

If (C = '*') then

begin

Opm[J].Op.Code := 4;

Opm[J].Prior := BrNum * 4 + 2;

J := J + 1;

I := I + 1

end;

If (C = '/') then

begin

Opm[J].Op.Code := 5;

Opm[J].Prior := BrNum * 4 + 2;

J := J + 1;

I := I + 1

end;

If (C = '^') then

begin

Opm[J].Op.Code := 16;

Opm[J].Prior := BrNum * 4 + 4;

J := J + 1;

I := I + 1

end;

State := false

end

else

begin

writeln;

writeln('It is not a good place for ',C);

readkey;

Exit := true;

answer := false

end

else

If GetF(M,I,OpM[J].op.Code) and (I - 1 <= MaxNum) then

If not(State) then

begin

For P := K + 1 to I do

write(M[P]);

If M[I] = '(' then

begin

OpM[J].Op.Num := false;

OpM[J].Prior := BrNum * 4 + 3;

BrNum := BrNum + 1;

J := J + 1;

I := I + 1

end

else

begin

writeln;

writeln;

writeln('There should be "("');

readkey;

Exit := true

end

end

else

begin

For P := K + 1 to I - 1 do

write(M[P]);

writeln;

writeln('Not a good place for this');

readkey;

Exit := true

end

else

If GetConst(M,I,S,MaxNum) and (I - 1 <= MaxNum) then

If not(State) then

begin

For P := K + 1 to I - 1 do

write(M[P]);

OpM[J].Op.Num := true;

CoM[J] := S;

OpM[J].Prior := 255;

J := J + 1;

State := true

end

else

begin

For P := K + 1 to I - 1 do

write(M[P]);

writeln;

writeln('Not a good place for this');

readkey;

Exit := true

end

else

begin

writeln;

writeln('Not a good place for this');

readkey;

Exit := true

end

end;

If BrNum <> 0 then

begin

writeln;

writeln;

writeln('Not enough ")"');

Exit := true

end;

DataAn := not(Exit);

Size := J - 1

end;

procedure GetConMas(var CoM : cMas; var M : sMas; var Size1,Size2 : Integer);

var

I,J : Integer;

begin

J := 0;

For I := 1 to Size1 do

If ((length(Com[I]) = 1)) and (CoM[I][1] <= 'z') and (CoM[I][1] >= 'a') then

begin

J := J + 1;

M[J] := CoM[I][1]

end;

Size2 := J

end;

function placed(var M : sMas; Size : Integer; Ch : Char) : Boolean;

var

I : Integer;

Ans : Boolean;

begin

Ans := false;

I := 1;

while (I <= Size) and not(Ans) do

begin

If M[I] = Ch then

Ans := true;

I := I + 1

end;

placed := Ans;

end;

var

OpM: uMas;

Com: cMas;

M : sMas;

F,Fo,Fout: Text;

I,K,L,Ch:Integer;

S:String;

R:pTree;

Exit,Answer : Boolean;

C : Char;

begin

clrscr;

TextColor(White);

assign(F,'i.txt');

assign(Fout,'fout.txt');

writeln('The function is: ');

rewrite(Fout);

reset(F);

writeln(Fout,'The function is: ');

writeln;

writeln;

writeln(Fout);

while not EoF(F) do

begin

read(F,C);

write(Fout,C)

end;

If DataAn(F,OpM,CoM) then

begin

readkey;

create(R);

writeln;

K := 1;

L := Size;

MakeTree(R,Opm,K,L);

GetConMas(CoM,M,Size,K);

Exit := false;

Answer := false;

while not(Exit) do

begin

writeln;

writeln;

write('Input a derivation variable or Press Esc to exit: ');

Ch := ord(readkey);

If Ch = 27 then

Exit := true

else

begin

writeln(Chr(Ch));

if placed(M,K,chr(Ch)) then

begin

Exit := true;

Answer := true

end

else

begin

writeln('Incorrect variable');

readkey

end

end

end;

If Answer then

begin

S := Chr(Ch);

FillStartCond(R,OpM,CoM,S);

writeln;

writeln;

writeln(Fout);

writeln(Fout);

writeln(Fout);

writeln('The operation tree is: ');

writeln(Fout,'The operation tree is: ');

writeln;

writeln;

writeln(Fout);

writeln(Fout);

DrawTree(R,OpM,CoM,0);

DrawTreeF(Fout,R,OpM,CoM,0);

readkey;

If Derivate(Fout,R,OpM,CoM) then;

clrscr;

writeln(Fout);

writeln(Fout);

writeln(Fout);

write('F(',chr(Ch),')=');

write(Fout,'F(',chr(Ch),')=');

For I := 1 to R^.Func.Len do

begin

write(R^.Func.S[I]);

write(Fout,R^.Func.S[I])

end;

writeln;

writeln;

writeln(Fout);

writeln(Fout);

write('F');

write(Fout,'F');

write('`');

write(Fout,'`');

write('(',Chr(Ch),')=');

write(Fout,'(',Chr(Ch),')=');

For I := 1 to R^.Der.Len do

begin

write(R^.der.S[I]);

write(Fout,R^.der.S[I])

end;

readkey;

{DrawTree(R,OpM,CoM,0);}

end

end

else

begin

writeln;

writeln;

writeln;

writeln('The function is incorrect!')

end;

readkey;

close(F);

close(Fout)

end.