uses crt;
Type Vhod=char;{integer}
U=^Tree;
Tree=Record
Inf:VHOD;
L,R:U;
End;
var ResTree:U;
s:string;
i:byte;
{процедура добавления числа в двоичное дерево}
Procedure InsRec(x:char{integer};Var Tree:U);
Begin
If Tree = Nil Then
Begin
New(Tree);
Tree^.L := Nil;
Tree^.R := Nil;
Tree^.Inf := x
End
Else
If x < Tree^.inf Then
InsRec(x,Tree^.L)
Else InsRec(x,Tree^.R);
End;
begin
clrscr;
writeln('Vvedite vyrazhenie: ');
readln(s);
for i:=1 to length(s) do
begin
insrec(s,ResTree);
end;
end.
Матвыражения
Прочитать со стандартного ввода арифметическое выражение. В нем могут содержаться операции +, -, *, /, exp, ln, sin, cos, числовые константы и переменная x. Выражение необходимо представить в виде дерева, листья которого – числа или переменные, а внутренние узлы – операции (при этом есть у операции только один аргумент, то один из сыновей может быть nil).
Нужно написать процедуру со стринговым входным параметром (строка ввода), а выходным деревом.
После этого написать процедуру прямого обхода дерева для формирования префиксной формы записи выражения.
Еще вопрос: нет ни у кого модуля FParser?
За основу можно взять это:
Нужно написать процедуру со стринговым входным параметром (строка ввода), а выходным деревом.
После этого написать процедуру прямого обхода дерева для формирования префиксной формы записи выражения.
Еще вопрос: нет ни у кого модуля FParser?
За основу можно взять это:
Код:
Уточняю задание и выкладываю наработки. Вообщем программа считывает данные для построения дерева выражения из файла, причем одна строка файла: одна операция, одная константа или переменная x (выражение в файле записанно в префиксной форме). Файл может называться от ex1.in до exN.in. С построением дерева выражения и с выводом дерева разобрался. Теперь нужна рекурсивная процедура символьного дифференцирования. Дифференцировать по таким правилам:
* D(число) = 0
* D(x) = 1
* D(A + B) = D(A) + D(B)
* D(A - B) = D(A) - D(B)
* D(A * B) = D(A) * B + A * D(B)
* D(A / B) = (D(A) * B - A * D(B)) / (B * B)
* D(exp A) = (exp A) * D(A)
* D(ln A) = (1 / A) * D(A)
* D(sin A) = (cos A) * D(A)
* D(cos A) = (0 - sin A) * D(A)
Упрощать ничего не нужно. Помогите разобраться. Пример входного файла вкладываю.
Нужно сменить расширение на *.in
* D(число) = 0
* D(x) = 1
* D(A + B) = D(A) + D(B)
* D(A - B) = D(A) - D(B)
* D(A * B) = D(A) * B + A * D(B)
* D(A / B) = (D(A) * B - A * D(B)) / (B * B)
* D(exp A) = (exp A) * D(A)
* D(ln A) = (1 / A) * D(A)
* D(sin A) = (cos A) * D(A)
* D(cos A) = (0 - sin A) * D(A)
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
procedure Diff(tree:TreePointer);
begin
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if r<>nil then
begin
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
clrscr;
root := nil;
write('Vvedite nomer faila s vhodnyni dannymi: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Fail: ',name);
writeln('Vvedite put k failu,esli on nahoditsia ne v papke s programmoi: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Fail: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Fail pust!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Priamoi obhod: ');
Prefix(root);
writeln;
writeln('Obratnyi obhod: ');
Postfix(root);
writeln;
writeln('Simmetrichnyi obhod: ');
Infix(root);
writeln;
Diff(root);
Infix(root);
readln;
end.
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
procedure Diff(tree:TreePointer);
begin
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if r<>nil then
begin
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
clrscr;
root := nil;
write('Vvedite nomer faila s vhodnyni dannymi: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Fail: ',name);
writeln('Vvedite put k failu,esli on nahoditsia ne v papke s programmoi: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Fail: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Fail pust!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Priamoi obhod: ');
Prefix(root);
writeln;
writeln('Obratnyi obhod: ');
Postfix(root);
writeln;
writeln('Simmetrichnyi obhod: ');
Infix(root);
writeln;
Diff(root);
Infix(root);
readln;
end.
Упрощать ничего не нужно. Помогите разобраться. Пример входного файла вкладываю.
Нужно сменить расширение на *.in
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : TreePointer; data : string;
right: TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function Diff(tree:TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := c1
else if d = '+' then
Diff := NewTree(Diff(A), '+', Diff(B))
else if d = '-' then
Diff := NewTree(Diff(A), '-', Diff(B))
else if d = '*' then
Diff := NewTree(NewTree(Diff(A), '*', B), '+', NewTree(A, '*', Diff(B)))
else if d = '*' then
Diff := NewTree(
NewTree(NewTree(Diff(A), '*', B), '-', NewTree(A, '*', Diff(B))),
'/', NewTree(B, '*', B)
)
else if d = 'exp' then
Diff := NewTree(tree, '*', Diff(B))
else if d = 'ln' then
Diff := NewTree(NewTree(c1, '/', B), '*', Diff(B))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', B), '*', Diff(B))
else if d = 'cos' then
Diff := NewTree(NewTree(c0, '-', NewTree(nil, 'sin', B)), '*', Diff(B))
else
Diff := c0; { это было число }
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if r<>nil then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Введите номер файла с входными данными: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Файл: ',name);
writeln('Введите путь к файлу, если он находится не в папке с программой: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Файл: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Файл пуст!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Прямой обход: ');
Prefix(root);
writeln;
writeln('Обратный обход: ');
Postfix(root);
writeln;
writeln('Симметричный обход: ');
Infix(root);
writeln;
root := Diff(root);
Infix(root);
readln;
end.
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : TreePointer; data : string;
right: TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function Diff(tree:TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := c1
else if d = '+' then
Diff := NewTree(Diff(A), '+', Diff(B))
else if d = '-' then
Diff := NewTree(Diff(A), '-', Diff(B))
else if d = '*' then
Diff := NewTree(NewTree(Diff(A), '*', B), '+', NewTree(A, '*', Diff(B)))
else if d = '*' then
Diff := NewTree(
NewTree(NewTree(Diff(A), '*', B), '-', NewTree(A, '*', Diff(B))),
'/', NewTree(B, '*', B)
)
else if d = 'exp' then
Diff := NewTree(tree, '*', Diff(B))
else if d = 'ln' then
Diff := NewTree(NewTree(c1, '/', B), '*', Diff(B))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', B), '*', Diff(B))
else if d = 'cos' then
Diff := NewTree(NewTree(c0, '-', NewTree(nil, 'sin', B)), '*', Diff(B))
else
Diff := c0; { это было число }
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if r<>nil then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Введите номер файла с входными данными: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Файл: ',name);
writeln('Введите путь к файлу, если он находится не в папке с программой: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Файл: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Файл пуст!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Прямой обход: ');
Prefix(root);
writeln;
writeln('Обратный обход: ');
Postfix(root);
writeln;
writeln('Симметричный обход: ');
Infix(root);
writeln;
root := Diff(root);
Infix(root);
readln;
end.
Спасибо. Добавляю отзыв.
"При нахождении производной результатом должна быть структура указателей, описанная так ,как предыдущая. Но теперь это не обязательно должно быть дерево. Если с правой стороны равенства находятся подвыражения исходного выражения, то не стоит создавать в памяти новых узлов, а использовать уже существующие. В частности, это относится ко всему выражению exp(A). Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа).
Выписать ответ в формате таком же, как и формат входа (время пропорционально длине). Не стоит вставлять дополнительные пробелы или знаки конца строки (последняя строка должна заканчиваться знаком конца строки, так же как и предыдущие).Если программа не может посчитать производную какого-либо выражения, можно выписать на стандартный выход ошибок 'Производная не может быть найденна' (без кавычек)
Если же программа может найти производную выражения, то кроме самой производной она должна выписать на стандартный выход ошибок в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов."
Может что-нибудь присоветуете? Особенно про освобождение узлов. отблагодарю материально!
Выписать ответ в формате таком же, как и формат входа (время пропорционально длине). Не стоит вставлять дополнительные пробелы или знаки конца строки (последняя строка должна заканчиваться знаком конца строки, так же как и предыдущие).Если программа не может посчитать производную какого-либо выражения, можно выписать на стандартный выход ошибок 'Производная не может быть найденна' (без кавычек)
Если же программа может найти производную выражения, то кроме самой производной она должна выписать на стандартный выход ошибок в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов."
Может что-нибудь присоветуете? Особенно про освобождение узлов. отблагодарю материально!
Может кто-нибудь пояснить это:
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root,diff_tree:TreePointer;
fail,rez:text;
nom:string;
name,put:string;
c1,c0:TreePointer;
function NewTree(left:TreePointer;data:string;right:TreePointer):TreePointer;
var
p : TreePointer;
begin
New(p);
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function Diff(tree:TreePointer) : TreePointer;
var
A,B:TreePointer;
d:string;
begin
A:=tree^.left;
B:=tree^.right;
d:=tree^.data;
if d='x' then Diff:=c1
else if d='+' then Diff:=NewTree(Diff(A), '+', Diff(B))
else if d='-' then Diff:=NewTree(Diff(A), '-', Diff(B))
else if d='*' then
Diff:=NewTree(NewTree(Diff(A),'*',B),'+',NewTree(A,'*',Diff(B)))
else if d='*' then
Diff:=NewTree(NewTree(NewTree(Diff(A),'*',B),'-',NewTree(A,'*',Diff(B))),'/',NewTree(B,'*',B))
else if d='exp' then Diff:=NewTree(tree, '*', Diff(B))
else if d='ln' then Diff:=NewTree(NewTree(c1,'/',B),'*',Diff(B))
else if d='sin' then Diff:=NewTree(NewTree(nil,'cos',B),'*',Diff(B))
else if d='cos' then Diff:=NewTree(NewTree(c0,'-',NewTree(nil,'sin',B)),'*',Diff(B))
else Diff:=c0; { это было число }
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if (r<>nil) then
begin
if (r^.right<>nil) then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end
else
begin
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
end;
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Writeln(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
function Think:boolean;
var i,j:byte;
begin
Think:=False;
j:=0;
repeat
j:=j+1;
for i:=1 to 4 do delay(40000);
write('.');
for i:=1 to 2 do delay(40000);
until (j=3) or (keypressed);
Think:=True;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Vvedite nomer faila s vhodnymy dannymi: ');
Think;
nom := ReadKey;
Writeln(nom);
name:='ex'+nom+'.in';
writeln('Fail: ',name);
writeln('Vvedite put k failu, esli on nahoditsia ne v papke s programmoi: ');
Think;
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Fail: ',name);
Think;
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Fail pust!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Ishodnoe fyrazhenie: ');
Infix(root);
writeln;
Think;
readln;
clrscr;
writeln('Ishodnoe vyrazhenie v prefiksnoi forme: ');
Prefix(root);
Think;
Diff_Tree := Diff(root);
readln;
clrscr;
writeln('Proizvodnaia vyrazhenia: ');
Infix(Diff_tree);
writeln;
Think;
readln;
clrscr;
assign(rez,put+'ex'+nom+'.out');
rewrite(rez);{zapisat v fail}
writeln('Proizvodnaia vyrazhenia v prefiksnoy forme: ');
Prefix(Diff_tree);
readln;
end.
type TreePointer = ^tree;
tree = record
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root,diff_tree:TreePointer;
fail,rez:text;
nom:string;
name,put:string;
c1,c0:TreePointer;
function NewTree(left:TreePointer;data:string;right:TreePointer):TreePointer;
var
p : TreePointer;
begin
New(p);
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function Diff(tree:TreePointer) : TreePointer;
var
A,B:TreePointer;
d:string;
begin
A:=tree^.left;
B:=tree^.right;
d:=tree^.data;
if d='x' then Diff:=c1
else if d='+' then Diff:=NewTree(Diff(A), '+', Diff(B))
else if d='-' then Diff:=NewTree(Diff(A), '-', Diff(B))
else if d='*' then
Diff:=NewTree(NewTree(Diff(A),'*',B),'+',NewTree(A,'*',Diff(B)))
else if d='*' then
Diff:=NewTree(NewTree(NewTree(Diff(A),'*',B),'-',NewTree(A,'*',Diff(B))),'/',NewTree(B,'*',B))
else if d='exp' then Diff:=NewTree(tree, '*', Diff(B))
else if d='ln' then Diff:=NewTree(NewTree(c1,'/',B),'*',Diff(B))
else if d='sin' then Diff:=NewTree(NewTree(nil,'cos',B),'*',Diff(B))
else if d='cos' then Diff:=NewTree(NewTree(c0,'-',NewTree(nil,'sin',B)),'*',Diff(B))
else Diff:=c0; { это было число }
end;
procedure Build(var p:TreePointer);
begin
new(p);
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:TreePointer);
begin
if (r<>nil) then
begin
if (r^.right<>nil) then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end
else
begin
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
end;
end;
end;
procedure Prefix(r:TreePointer);
begin
if r<>nil then
begin
Writeln(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
function Think:boolean;
var i,j:byte;
begin
Think:=False;
j:=0;
repeat
j:=j+1;
for i:=1 to 4 do delay(40000);
write('.');
for i:=1 to 2 do delay(40000);
until (j=3) or (keypressed);
Think:=True;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Vvedite nomer faila s vhodnymy dannymi: ');
Think;
nom := ReadKey;
Writeln(nom);
name:='ex'+nom+'.in';
writeln('Fail: ',name);
writeln('Vvedite put k failu, esli on nahoditsia ne v papke s programmoi: ');
Think;
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Fail: ',name);
Think;
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Fail pust!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Ishodnoe fyrazhenie: ');
Infix(root);
writeln;
Think;
readln;
clrscr;
writeln('Ishodnoe vyrazhenie v prefiksnoi forme: ');
Prefix(root);
Think;
Diff_Tree := Diff(root);
readln;
clrscr;
writeln('Proizvodnaia vyrazhenia: ');
Infix(Diff_tree);
writeln;
Think;
readln;
clrscr;
assign(rez,put+'ex'+nom+'.out');
rewrite(rez);{zapisat v fail}
writeln('Proizvodnaia vyrazhenia v prefiksnoy forme: ');
Prefix(Diff_tree);
readln;
end.
Сделал на основе предыдущего своего исходника (лениво было опять транслит исправлять)
Используемая техника называется счётчик ссылок. Комментарии {eat}, {noeat} в аргуметах определяют, как функция/процедура ведёт себя по отношению к ссылке: если {eat}, то съедает ссылку, если {noeat}, то нет.
UPD:
Используемая техника называется счётчик ссылок. Комментарии {eat}, {noeat} в аргуметах определяют, как функция/процедура ведёт себя по отношению к ссылке: если {eat}, то съедает ссылку, если {noeat}, то нет.
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
procedure Build(var p:TreePointer);
begin
new(p);
p^.refcount := 1;
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end;
end;
procedure Prefix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Введите номер файла с входными данными: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Файл: ',name);
writeln('Введите путь к файлу, если он находится не в папке с программой: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Файл: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Файл пуст!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Прямой обход: ');
Prefix(root);
writeln;
writeln('Обратный обход: ');
Postfix(root);
writeln;
writeln('Симметричный обход: ');
Infix(root);
writeln;
root := Diff(root);
Infix(root);
readln;
end.
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
procedure Build(var p:TreePointer);
begin
new(p);
p^.refcount := 1;
readln(fail,p^.data);
if (p^.data ='+') or (p^.data='-') or (p^.data ='*') or (p^.data ='/') then
begin
Build(p^.left);
Build(p^.right);
end
else
if (p^.data='exp') or (p^.data ='ln') or (p^.data ='cos') or (p^.data ='sin') then
begin
p^.left:= nil;
Build(p^.right);
end
else
begin
p^.left:= nil;
p^.right:= nil;
end
end;
procedure Infix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Write('(');
Infix(r^.left);
Write(r^.data);
Infix(r^.right);
Write(')');
end;
end;
procedure Prefix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Write(r^.data);
Prefix(r^.left);
Prefix(r^.right);
end;
end;
procedure Postfix(r:{noeat}TreePointer);
begin
if r<>nil then
begin
Postfix(r^.left);
Postfix(r^.right);
Write(r^.data);
end;
end;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
clrscr;
root := nil;
write('Введите номер файла с входными данными: ');
readln(nom);
str(nom,ns);
name:='ex'+ns+'.in';
clrscr;
writeln('Файл: ',name);
writeln('Введите путь к файлу, если он находится не в папке с программой: ');
readln(put);
if length(put)>0 then
begin
name:=put+name;
clrscr;
writeln('Файл: ',name);
readln;
end;
assign(fail,name);
reset(fail);
if eof(fail)=true then
begin
writeln('Файл пуст!');
readln;
end;
while eof(fail)=false do Build(root);
writeln('Прямой обход: ');
Prefix(root);
writeln;
writeln('Обратный обход: ');
Postfix(root);
writeln;
writeln('Симметричный обход: ');
Infix(root);
writeln;
root := Diff(root);
Infix(root);
readln;
end.
UPD:
Цитата: Gonzo
Может кто-нибудь пояснить это:
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."
Насколько я понял, имеется в виду, чтобы Diff от одного и того же дважды не вызывался. Но я не вижу такой ветки. А подцепление в нескольких местах — это вроде само собой делается.
Забацал небольшой парсер. За корректность не ручаюсь.
Сеанс выглядит так:
Сеанс выглядит так:
Код:
Пустая строка оканчивает сеанс
Введите выражение: sin x
Выражение: sin(x)
Производная: cos(x) * 1
Введите выражение: cos x
Выражение: cos(x)
Производная: (0 - sin(x)) * 1
Введите выражение: exp 2
Выражение: exp(2)
Производная: exp(2) * 0
Введите выражение: exp x
Выражение: exp(x)
Производная: exp(x) * 1
Введите выражение: exp (x * x)
Выражение: exp(x * x)
Производная: exp(x * x) * (1 * x + x * 1)
Введите выражение:
Введите выражение: sin x
Выражение: sin(x)
Производная: cos(x) * 1
Введите выражение: cos x
Выражение: cos(x)
Производная: (0 - sin(x)) * 1
Введите выражение: exp 2
Выражение: exp(2)
Производная: exp(2) * 0
Введите выражение: exp x
Выражение: exp(x)
Производная: exp(x) * 1
Введите выражение: exp (x * x)
Выражение: exp(x * x)
Производная: exp(x * x) * (1 * x + x * 1)
Введите выражение:
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
function Trim(Source : String) : String;
var
Start, Finish,
i, L : Integer;
begin
L := Length(Source);
Start := 1; Finish := 0;
for i := L downto 1 do
if Source <> ' ' then
begin Finish := i; Break; end;
for i := 1 to L do
if Source <> ' ' then
begin Start := i; Break; end;
Trim := Copy(Source, Start, Finish + 1 - Start);
end;
function IntToStr(I : LongInt) : String;
var
S : String[11];
begin
Str(I, S);
IntToStr := S;
end;
function IsAtom(item : {noeat}TreePointer) : Boolean;
begin
IsAtom := False;
if item <> nil then
begin
if item^.data = '+' then else
if item^.data = '-' then else
if item^.data = '*' then else
if item^.data = '/' then else
if item^.data = 'exp' then else
if item^.data = 'ln' then else
if item^.data = 'sin' then else
if item^.data = 'cos' then else
IsAtom := True;
end;
end;
function Parse(x : String; var Error : String) : TreePointer;
var
ParLevel : Integer;
i, L : Integer;
Q, W : TreePointer;
InPar : Boolean; { True, если это выражение в скобках }
begin
Error := '';
Parse := nil;
Q := nil; W := nil;
x := Trim(x);
L := Length(x);
if L = 0 then
begin
Error := 'Пустое подвыражение';
Exit;
end;
{ Проверить баланс скобок }
ParLevel := 0; InPar := True;
for i := 1 to L do
case x of
'(' : Inc(ParLevel);
')' : begin
if ParLevel <= 0 then
begin
Error := x;
Insert('|', Error, i);
Error := 'Неожиданная '')'': ' + Error;
Exit;
end;
Dec(ParLevel);
end;
else
if ParLevel = 0 then InPar := False;
end;
if ParLevel > 0 then
begin
Error := 'Не хватает скобок: ' + IntToStr(ParLevel); Exit;
end;
if InPar then
begin
Parse := Parse(Copy(x, 2, L - 2), Error);
Exit;
end;
{ Распознавать бинарные '+' и '-' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'+', '-' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
{ Распознавать бинарные '*' и '/' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'*', '/' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
if x[1] = '+' then
begin
Parse := Parse(Copy(x, 2, L - 1), Error);
Exit;
end;
if x[1] = '-' then
begin
Q := Parse(Copy(x, 2, L - 1), Error);
if Q = nil then Exit;
Parse := NewTree(NewRef(c0), '-', Q);
Exit;
end;
if Copy(x, 1, 3) = 'exp' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'exp', Q); Exit;
end;
end;
if Copy(x, 1, 2) = 'ln' then
begin
Q := Parse(Copy(x, 3, L - 2), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'ln', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'cos' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'cos', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'sin' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'sin', Q); Exit;
end;
end;
Parse := NewTree(nil, x, nil);
end;
{
Level:
0 ничего не надо в скобки
2 '+' и '-' надо в скобки
4 '+', '-', '*' и '/' надо в скобки
10 всё, кроме атомов, надо в скобки
}
function TreeToStr(tree : {eat}TreePointer; Level : Integer) : String;
var
A, B : TreePointer;
d, r : String;
mylev : Integer;
begin
if tree = nil then
TreeToStr := ''
else
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
r := ''; mylev := -1;
if d = '+' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 0);
mylev := 0;
end else
if d = '-' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 0;
end else
if d = '*' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 2;
end else
if d = '/' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 4);
mylev := 2;
end else
if IsAtom(tree) then
begin
r := d;
mylev := 10;
end else
begin
r := d + '(' + TreeToStr(NewRef(B), 0) + ')';
mylev := 6;
end;
if Level > mylev then r := '(' + r + ')';
TreeToStr := r;
end;
UnRef(tree);
end;
var
source : String;
Error : String;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
root := nil;
WriteLn('Пустая строка оканчивает сеанс');
Write('Введите выражение: '); ReadLn(source);
while source <> '' do
begin
root := Parse(source, Error);
if root <> nil then
begin
WriteLn('Выражение: ', TreeToStr(NewRef(root), 0));
WriteLn('Производная: ', TreeToStr(Diff(root), 0));
end else
WriteLn('Ошибка: ', Error);
WriteLn;
Write('Введите выражение: '); ReadLn(source);
end;
end.
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
root:TreePointer;
fail,rez:text;
nom:byte;
ns,name,put:string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
function Trim(Source : String) : String;
var
Start, Finish,
i, L : Integer;
begin
L := Length(Source);
Start := 1; Finish := 0;
for i := L downto 1 do
if Source <> ' ' then
begin Finish := i; Break; end;
for i := 1 to L do
if Source <> ' ' then
begin Start := i; Break; end;
Trim := Copy(Source, Start, Finish + 1 - Start);
end;
function IntToStr(I : LongInt) : String;
var
S : String[11];
begin
Str(I, S);
IntToStr := S;
end;
function IsAtom(item : {noeat}TreePointer) : Boolean;
begin
IsAtom := False;
if item <> nil then
begin
if item^.data = '+' then else
if item^.data = '-' then else
if item^.data = '*' then else
if item^.data = '/' then else
if item^.data = 'exp' then else
if item^.data = 'ln' then else
if item^.data = 'sin' then else
if item^.data = 'cos' then else
IsAtom := True;
end;
end;
function Parse(x : String; var Error : String) : TreePointer;
var
ParLevel : Integer;
i, L : Integer;
Q, W : TreePointer;
InPar : Boolean; { True, если это выражение в скобках }
begin
Error := '';
Parse := nil;
Q := nil; W := nil;
x := Trim(x);
L := Length(x);
if L = 0 then
begin
Error := 'Пустое подвыражение';
Exit;
end;
{ Проверить баланс скобок }
ParLevel := 0; InPar := True;
for i := 1 to L do
case x of
'(' : Inc(ParLevel);
')' : begin
if ParLevel <= 0 then
begin
Error := x;
Insert('|', Error, i);
Error := 'Неожиданная '')'': ' + Error;
Exit;
end;
Dec(ParLevel);
end;
else
if ParLevel = 0 then InPar := False;
end;
if ParLevel > 0 then
begin
Error := 'Не хватает скобок: ' + IntToStr(ParLevel); Exit;
end;
if InPar then
begin
Parse := Parse(Copy(x, 2, L - 2), Error);
Exit;
end;
{ Распознавать бинарные '+' и '-' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'+', '-' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
{ Распознавать бинарные '*' и '/' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'*', '/' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
if x[1] = '+' then
begin
Parse := Parse(Copy(x, 2, L - 1), Error);
Exit;
end;
if x[1] = '-' then
begin
Q := Parse(Copy(x, 2, L - 1), Error);
if Q = nil then Exit;
Parse := NewTree(NewRef(c0), '-', Q);
Exit;
end;
if Copy(x, 1, 3) = 'exp' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'exp', Q); Exit;
end;
end;
if Copy(x, 1, 2) = 'ln' then
begin
Q := Parse(Copy(x, 3, L - 2), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'ln', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'cos' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'cos', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'sin' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'sin', Q); Exit;
end;
end;
Parse := NewTree(nil, x, nil);
end;
{
Level:
0 ничего не надо в скобки
2 '+' и '-' надо в скобки
4 '+', '-', '*' и '/' надо в скобки
10 всё, кроме атомов, надо в скобки
}
function TreeToStr(tree : {eat}TreePointer; Level : Integer) : String;
var
A, B : TreePointer;
d, r : String;
mylev : Integer;
begin
if tree = nil then
TreeToStr := ''
else
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
r := ''; mylev := -1;
if d = '+' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 0);
mylev := 0;
end else
if d = '-' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 0;
end else
if d = '*' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 2;
end else
if d = '/' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 4);
mylev := 2;
end else
if IsAtom(tree) then
begin
r := d;
mylev := 10;
end else
begin
r := d + '(' + TreeToStr(NewRef(B), 0) + ')';
mylev := 6;
end;
if Level > mylev then r := '(' + r + ')';
TreeToStr := r;
end;
UnRef(tree);
end;
var
source : String;
Error : String;
begin
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
root := nil;
WriteLn('Пустая строка оканчивает сеанс');
Write('Введите выражение: '); ReadLn(source);
while source <> '' do
begin
root := Parse(source, Error);
if root <> nil then
begin
WriteLn('Выражение: ', TreeToStr(NewRef(root), 0));
WriteLn('Производная: ', TreeToStr(Diff(root), 0));
end else
WriteLn('Ошибка: ', Error);
WriteLn;
Write('Введите выражение: '); ReadLn(source);
end;
end.
Всё отлично!
Единственное нужно выписывать в файл exN.err в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов.
OCTAGRAM, пришлите в личку номер кошелька.
Единственное нужно выписывать в файл exN.err в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов.
OCTAGRAM, пришлите в личку номер кошелька.
Сделал пока что интерактивную версию:
Вроде работает.
Код:
Узлов изначально: 0
Узлов после добавления констант: 2
Пустая строка оканчивает сеанс
Введите выражение: x * x
Узлов после ввода выражения: 5
Выражение: x * x
Производная: 1 * x + x * 1
Узлов после вычисления производной: 8
Узлов после удаления ненужных: 7
Узлов после освобождения узлов производной: 2
Введите выражение: exp cos x
Узлов после ввода выражения: 5
Выражение: exp(cos(x))
Производная: exp(cos(x)) * (0 - sin(x)) * 1
Узлов после вычисления производной: 9
Узлов после удаления ненужных: 9
Узлов после удаления производной: 2
Введите выражение: ln (1 / x)
Узлов после ввода выражения: 6
Выражение: ln(1 / x)
Производная: 1 / (1 / x) * (0 * x - 1 * 1) / (x * x)
Узлов после удаления производной: 13
Узлов после удаления ненужных: 12
Узлов после удаления производной: 2
Введите выражение: 1 * x + x * 1
Узлов после ввода выражения: 9
Выражение: 1 * x + x * 1
Производная: 0 * x + 1 * 1 + 1 * 1 + x * 0
Узлов после вычисления производной: 16
Узлов после удаления ненужных: 13
Узлов после удаления производной: 2
Введите выражение:
Узлов в конце сеанса: 2
Узлов после удаления констант: 0
Узлов после добавления констант: 2
Пустая строка оканчивает сеанс
Введите выражение: x * x
Узлов после ввода выражения: 5
Выражение: x * x
Производная: 1 * x + x * 1
Узлов после вычисления производной: 8
Узлов после удаления ненужных: 7
Узлов после освобождения узлов производной: 2
Введите выражение: exp cos x
Узлов после ввода выражения: 5
Выражение: exp(cos(x))
Производная: exp(cos(x)) * (0 - sin(x)) * 1
Узлов после вычисления производной: 9
Узлов после удаления ненужных: 9
Узлов после удаления производной: 2
Введите выражение: ln (1 / x)
Узлов после ввода выражения: 6
Выражение: ln(1 / x)
Производная: 1 / (1 / x) * (0 * x - 1 * 1) / (x * x)
Узлов после удаления производной: 13
Узлов после удаления ненужных: 12
Узлов после удаления производной: 2
Введите выражение: 1 * x + x * 1
Узлов после ввода выражения: 9
Выражение: 1 * x + x * 1
Производная: 0 * x + 1 * 1 + 1 * 1 + x * 0
Узлов после вычисления производной: 16
Узлов после удаления ненужных: 13
Узлов после удаления производной: 2
Введите выражение:
Узлов в конце сеанса: 2
Узлов после удаления констант: 0
Вроде работает.
Код:
uses Crt;
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
TotalNodes : Integer;
root, rootdiff : TreePointer;
fail, rez : text;
nom : byte;
ns, name, put : string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
TotalNodes := TotalNodes + 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
TotalNodes := TotalNodes - 1;
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
function Trim(Source : String) : String;
var
Start, Finish,
i, L : Integer;
begin
L := Length(Source);
Start := 1; Finish := 0;
for i := L downto 1 do
if Source <> ' ' then
begin Finish := i; Break; end;
for i := 1 to L do
if Source <> ' ' then
begin Start := i; Break; end;
Trim := Copy(Source, Start, Finish + 1 - Start);
end;
function IntToStr(I : LongInt) : String;
var
S : String[11];
begin
Str(I, S);
IntToStr := S;
end;
function IsAtom(item : {noeat}TreePointer) : Boolean;
begin
IsAtom := False;
if item <> nil then
begin
if item^.data = '+' then else
if item^.data = '-' then else
if item^.data = '*' then else
if item^.data = '/' then else
if item^.data = 'exp' then else
if item^.data = 'ln' then else
if item^.data = 'sin' then else
if item^.data = 'cos' then else
IsAtom := True;
end;
end;
function Parse(x : String; var Error : String) : TreePointer;
var
ParLevel : Integer;
i, L : Integer;
Q, W : TreePointer;
InPar : Boolean; { True, если это выражение в скобках }
begin
Error := '';
Parse := nil;
Q := nil; W := nil;
x := Trim(x);
L := Length(x);
if L = 0 then
begin
Error := 'Пустое подвыражение';
Exit;
end;
{ Проверить баланс скобок }
ParLevel := 0; InPar := True;
for i := 1 to L do
case x of
'(' : Inc(ParLevel);
')' : begin
if ParLevel <= 0 then
begin
Error := x;
Insert('|', Error, i);
Error := 'Неожиданная '')'': ' + Error;
Exit;
end;
Dec(ParLevel);
end;
else
if ParLevel = 0 then InPar := False;
end;
if ParLevel > 0 then
begin
Error := 'Не хватает скобок: ' + IntToStr(ParLevel); Exit;
end;
if InPar then
begin
Parse := Parse(Copy(x, 2, L - 2), Error);
Exit;
end;
{ Распознавать бинарные '+' и '-' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'+', '-' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
{ Распознавать бинарные '*' и '/' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'*', '/' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
if x[1] = '+' then
begin
Parse := Parse(Copy(x, 2, L - 1), Error);
Exit;
end;
if x[1] = '-' then
begin
Q := Parse(Copy(x, 2, L - 1), Error);
if Q = nil then Exit;
Parse := NewTree(NewRef(c0), '-', Q);
Exit;
end;
if Copy(x, 1, 3) = 'exp' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'exp', Q); Exit;
end;
end;
if Copy(x, 1, 2) = 'ln' then
begin
Q := Parse(Copy(x, 3, L - 2), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'ln', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'cos' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'cos', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'sin' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'sin', Q); Exit;
end;
end;
Parse := NewTree(nil, x, nil);
end;
{
Level:
0 ничего не надо в скобки
2 '+' и '-' надо в скобки
4 '+', '-', '*' и '/' надо в скобки
10 всё, кроме атомов, надо в скобки
}
function TreeToStr(tree : {eat}TreePointer; Level : Integer) : String;
var
A, B : TreePointer;
d, r : String;
mylev : Integer;
begin
if tree = nil then
TreeToStr := ''
else
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
r := ''; mylev := -1;
if d = '+' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 0);
mylev := 0;
end else
if d = '-' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 0;
end else
if d = '*' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 2;
end else
if d = '/' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 4);
mylev := 2;
end else
if IsAtom(tree) then
begin
r := d;
mylev := 10;
end else
begin
r := d + '(' + TreeToStr(NewRef(B), 0) + ')';
mylev := 6;
end;
if Level > mylev then r := '(' + r + ')';
TreeToStr := r;
end;
UnRef(tree);
end;
var
source : String;
Error : String;
begin
TotalNodes := 0;
WriteLn('Узлов изначально: ', TotalNodes);
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
WriteLn('Узлов после добавления констант: ', TotalNodes);
root := nil; rootdiff := nil;
WriteLn('Пустая строка оканчивает сеанс');
Write('Введите выражение: '); ReadLn(source);
while source <> '' do
begin
root := Parse(source, Error);
if root <> nil then
begin
WriteLn('Узлов после ввода выражения: ', TotalNodes);
WriteLn('Выражение: ', TreeToStr(NewRef(root), 0));
rootdiff := Diff(NewRef(root));
WriteLn('Производная: ', TreeToStr(NewRef(rootdiff), 0));
WriteLn('Узлов после вычисления производной: ', TotalNodes);
UnRef(root);
WriteLn('Узлов после удаления ненужных: ', TotalNodes);
UnRef(rootdiff);
WriteLn('Узлов после удаления производной: ', TotalNodes);
end else
WriteLn('Ошибка: ', Error);
WriteLn;
Write('Введите выражение: '); ReadLn(source);
end;
WriteLn('Узлов в конце сеанса: ', TotalNodes);
UnRef(c0); UnRef(c1);
WriteLn('Узлов после удаления констант: ', TotalNodes);
end.
type TreePointer = ^tree;
tree = record
refcount : Integer;
data: string;
left: TreePointer;
right: TreePointer;
end;
var
TotalNodes : Integer;
root, rootdiff : TreePointer;
fail, rez : text;
nom : byte;
ns, name, put : string;
c1, c0 : TreePointer;
function NewTree(left : {eat}TreePointer; data : string;
right: {eat}TreePointer) : TreePointer;
var
p : TreePointer;
begin
New(p);
p^.refcount := 1;
TotalNodes := TotalNodes + 1;
NewTree := p;
p^.data := data;
p^.left := left;
p^.right := right;
end;
function NewRef(item : {noeat}TreePointer) : TreePointer;
begin
if item <> nil then
item^.refcount := item^.refcount + 1;
NewRef := item;
end;
procedure UnRef(item : {eat}TreePointer);
begin
if item <> nil then
begin
item^.refcount := item^.refcount - 1;
if item^.refcount = 0 then
begin
Unref(item^.left);
Unref(item^.right);
Dispose(item);
TotalNodes := TotalNodes - 1;
end;
end;
end;
function Diff(tree:{eat}TreePointer) : TreePointer;
var
A, B : TreePointer;
d : string;
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
if d = 'x' then Diff := NewRef(c1)
else if d = '+' then
Diff := NewTree(Diff(NewRef(A)), '+', Diff(NewRef(B)))
else if d = '-' then
Diff := NewTree(Diff(NewRef(A)), '-', Diff(NewRef(B)))
else if d = '*' then
Diff := NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'+', NewTree(NewRef(A), '*', Diff(NewRef(B))))
else if d = '/' then
Diff := NewTree(
NewTree(NewTree(Diff(NewRef(A)), '*', NewRef(B)),
'-', NewTree(NewRef(A), '*', Diff(NewRef(B)))),
'/', NewTree(NewRef(B), '*', NewRef(B))
)
else if d = 'exp' then
Diff := NewTree(NewRef(tree), '*', Diff(NewRef(B)))
else if d = 'ln' then
Diff := NewTree(NewTree(NewRef(c1), '/', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'sin' then
Diff := NewTree(NewTree(nil, 'cos', NewRef(B)), '*', Diff(NewRef(B)))
else if d = 'cos' then
Diff := NewTree(NewTree(NewRef(c0), '-',
NewTree(nil, 'sin', NewRef(B))), '*', Diff(NewRef(B)))
else
Diff := NewRef(c0); { это было число }
UnRef(tree);
end;
function Trim(Source : String) : String;
var
Start, Finish,
i, L : Integer;
begin
L := Length(Source);
Start := 1; Finish := 0;
for i := L downto 1 do
if Source <> ' ' then
begin Finish := i; Break; end;
for i := 1 to L do
if Source <> ' ' then
begin Start := i; Break; end;
Trim := Copy(Source, Start, Finish + 1 - Start);
end;
function IntToStr(I : LongInt) : String;
var
S : String[11];
begin
Str(I, S);
IntToStr := S;
end;
function IsAtom(item : {noeat}TreePointer) : Boolean;
begin
IsAtom := False;
if item <> nil then
begin
if item^.data = '+' then else
if item^.data = '-' then else
if item^.data = '*' then else
if item^.data = '/' then else
if item^.data = 'exp' then else
if item^.data = 'ln' then else
if item^.data = 'sin' then else
if item^.data = 'cos' then else
IsAtom := True;
end;
end;
function Parse(x : String; var Error : String) : TreePointer;
var
ParLevel : Integer;
i, L : Integer;
Q, W : TreePointer;
InPar : Boolean; { True, если это выражение в скобках }
begin
Error := '';
Parse := nil;
Q := nil; W := nil;
x := Trim(x);
L := Length(x);
if L = 0 then
begin
Error := 'Пустое подвыражение';
Exit;
end;
{ Проверить баланс скобок }
ParLevel := 0; InPar := True;
for i := 1 to L do
case x of
'(' : Inc(ParLevel);
')' : begin
if ParLevel <= 0 then
begin
Error := x;
Insert('|', Error, i);
Error := 'Неожиданная '')'': ' + Error;
Exit;
end;
Dec(ParLevel);
end;
else
if ParLevel = 0 then InPar := False;
end;
if ParLevel > 0 then
begin
Error := 'Не хватает скобок: ' + IntToStr(ParLevel); Exit;
end;
if InPar then
begin
Parse := Parse(Copy(x, 2, L - 2), Error);
Exit;
end;
{ Распознавать бинарные '+' и '-' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'+', '-' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
{ Распознавать бинарные '*' и '/' }
for i := L - 1 downto 2 do
case x of
')' : Inc(ParLevel);
'(' : Dec(ParLevel);
'*', '/' : if ParLevel = 0 then
begin
Q := Parse(Copy(x, 1, i - 1), Error);
if Q = nil then Exit;
W := Parse(Copy(x, i + 1, L - i), Error);
if W = nil then begin UnRef(W); Exit; end;
Parse := NewTree(Q, x, W);
Exit;
end;
end;
if x[1] = '+' then
begin
Parse := Parse(Copy(x, 2, L - 1), Error);
Exit;
end;
if x[1] = '-' then
begin
Q := Parse(Copy(x, 2, L - 1), Error);
if Q = nil then Exit;
Parse := NewTree(NewRef(c0), '-', Q);
Exit;
end;
if Copy(x, 1, 3) = 'exp' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'exp', Q); Exit;
end;
end;
if Copy(x, 1, 2) = 'ln' then
begin
Q := Parse(Copy(x, 3, L - 2), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'ln', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'cos' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'cos', Q); Exit;
end;
end;
if Copy(x, 1, 3) = 'sin' then
begin
Q := Parse(Copy(x, 4, L - 3), Error);
if Q <> nil then
begin
Parse := NewTree(nil, 'sin', Q); Exit;
end;
end;
Parse := NewTree(nil, x, nil);
end;
{
Level:
0 ничего не надо в скобки
2 '+' и '-' надо в скобки
4 '+', '-', '*' и '/' надо в скобки
10 всё, кроме атомов, надо в скобки
}
function TreeToStr(tree : {eat}TreePointer; Level : Integer) : String;
var
A, B : TreePointer;
d, r : String;
mylev : Integer;
begin
if tree = nil then
TreeToStr := ''
else
begin
A := tree^.left; B := tree^.right;
d := tree^.data;
r := ''; mylev := -1;
if d = '+' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 0);
mylev := 0;
end else
if d = '-' then
begin
r := TreeToStr(NewRef(A), 0) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 0;
end else
if d = '*' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 2);
mylev := 2;
end else
if d = '/' then
begin
r := TreeToStr(NewRef(A), 2) + ' ' + d + ' ' +
TreeToStr(NewRef(B), 4);
mylev := 2;
end else
if IsAtom(tree) then
begin
r := d;
mylev := 10;
end else
begin
r := d + '(' + TreeToStr(NewRef(B), 0) + ')';
mylev := 6;
end;
if Level > mylev then r := '(' + r + ')';
TreeToStr := r;
end;
UnRef(tree);
end;
var
source : String;
Error : String;
begin
TotalNodes := 0;
WriteLn('Узлов изначально: ', TotalNodes);
c0 := NewTree(nil, '0', nil);
c1 := NewTree(nil, '1', nil);
WriteLn('Узлов после добавления констант: ', TotalNodes);
root := nil; rootdiff := nil;
WriteLn('Пустая строка оканчивает сеанс');
Write('Введите выражение: '); ReadLn(source);
while source <> '' do
begin
root := Parse(source, Error);
if root <> nil then
begin
WriteLn('Узлов после ввода выражения: ', TotalNodes);
WriteLn('Выражение: ', TreeToStr(NewRef(root), 0));
rootdiff := Diff(NewRef(root));
WriteLn('Производная: ', TreeToStr(NewRef(rootdiff), 0));
WriteLn('Узлов после вычисления производной: ', TotalNodes);
UnRef(root);
WriteLn('Узлов после удаления ненужных: ', TotalNodes);
UnRef(rootdiff);
WriteLn('Узлов после удаления производной: ', TotalNodes);
end else
WriteLn('Ошибка: ', Error);
WriteLn;
Write('Введите выражение: '); ReadLn(source);
end;
WriteLn('Узлов в конце сеанса: ', TotalNodes);
UnRef(c0); UnRef(c1);
WriteLn('Узлов после удаления констант: ', TotalNodes);
end.
Теперь с файлами.
DIFF.PAS
Оставил отладочный вывод, без него тяжело проверять. Если что, лишние WriteLn можно стереть. А сами файлы в префиксной форме.
Сеанс выглядит так:
«Пустая строка оканчивает сеанс» — это лишнее. Надо бы убрать, да только исходник уже закачан.
DIFF.PAS
Оставил отладочный вывод, без него тяжело проверять. Если что, лишние WriteLn можно стереть. А сами файлы в префиксной форме.
Сеанс выглядит так:
Код:
Пустая строка оканчивает сеанс
Введите путь к файлам тестов [Y:\JUST_T~1]:
Введите номер первого теста [1]:
Введите номер последнего теста [6]:
ex1.in : (3 + 5) * cos(3) - 4
ex1.out : (0 + 0) * cos(3) + (3 + 5) * (0 - sin(3)) * 0 - 0
ex1.err: 10, 18, 15
ex2.in : x * x
ex2.out : 1 * x + x * 1
ex2.err : 5, 8, 7
ex3.in : exp(cos(x))
ex3.out : exp(cos(x)) * (0 - sin(x)) * 1
ex3.err : 5, 9, 9
ex4.in : ln(1 / x)
ex4.out : 1 / (1 / x) * (0 * x - 1 * 1) / (x * x)
ex4.err : 6, 13, 12
ex5.in : 1 * x + x * 1
ex5.out : 0 * x + 1 * 1 + 1 * 1 + x * 0
ex5.err : 9, 16, 13
ex6.in : exp(x * x)
ex6.out : exp(x * x) * (1 * x + x * 1)
ex6.err : 6, 10, 10
Введите путь к файлам тестов [Y:\JUST_T~1]:
Введите номер первого теста [1]:
Введите номер последнего теста [6]:
ex1.in : (3 + 5) * cos(3) - 4
ex1.out : (0 + 0) * cos(3) + (3 + 5) * (0 - sin(3)) * 0 - 0
ex1.err: 10, 18, 15
ex2.in : x * x
ex2.out : 1 * x + x * 1
ex2.err : 5, 8, 7
ex3.in : exp(cos(x))
ex3.out : exp(cos(x)) * (0 - sin(x)) * 1
ex3.err : 5, 9, 9
ex4.in : ln(1 / x)
ex4.out : 1 / (1 / x) * (0 * x - 1 * 1) / (x * x)
ex4.err : 6, 13, 12
ex5.in : 1 * x + x * 1
ex5.out : 0 * x + 1 * 1 + 1 * 1 + x * 0
ex5.err : 9, 16, 13
ex6.in : exp(x * x)
ex6.out : exp(x * x) * (1 * x + x * 1)
ex6.err : 6, 10, 10
«Пустая строка оканчивает сеанс» — это лишнее. Надо бы убрать, да только исходник уже закачан.
Вообще нужно получить имя файла, считать выражение из файла, где оно записано в префиксной форме. Строить дерево выражения. Строить дерево производной, исходя из правил задания. Выписать производную в префиксной форме в файл. Выписать в файл состояние узлов.
Как только будет такой функционал программу оплатят.
Как только будет такой функционал программу оплатят.
DIFF2.PAS
Теперь выглядит так:
Последние три строки можно отключить, изменив const Debug_Output на False
Теперь выглядит так:
Код:
Пустая строка -> значение по умолчанию
Введите имя файла для чтения [Y:\JUST_T~1\ex1.in]: ex2.in
Введите имя файла для записи [ex2.out]:
Введите имя файла для состояния [ex2.err]:
ex2.in: x * x
ex2.out: 1 * x + x * 1
ex2.err: 5, 8, 7
Введите имя файла для чтения [Y:\JUST_T~1\ex1.in]: ex2.in
Введите имя файла для записи [ex2.out]:
Введите имя файла для состояния [ex2.err]:
ex2.in: x * x
ex2.out: 1 * x + x * 1
ex2.err: 5, 8, 7
Последние три строки можно отключить, изменив const Debug_Output на False
Попробуйте протестировать на основе этого. Вкладываю так же выходные файлы для сравнения.
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)
Цитата: Gonzo
Попробуйте протестировать на основе этого. Вкладываю так же выходные файлы для сравнения.
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)
Тесты либо у меня так распаковалось, либо на самом деле имеют нестандартный перенос строки. Если перенос поправить, то всё работает. Надо полагать, на тестирующей машине стоит *Nix, и там заработает.
DIFF3.PAS
Выключил отладочный вывод. Выражения слишком большие.
.out совпадал и без того, а вот .err немного расходился. По всей видимости, нули и единицы нужно было каждый раз заново создавать. Поправил — теперь сходится.
Как именно тестирующая машина задаёт входные и выходные файлы, непонятно, поэтому на месте придётся ещё слегка подпилить.