Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Матвыражения

36K
18 марта 2009 года
Gonzo
32 / / 18.03.2009
Прочитать со стандартного ввода арифметическое выражение. В нем могут содержаться операции +, -, *, /, exp, ln, sin, cos, числовые константы и переменная x. Выражение необходимо представить в виде дерева, листья которого – числа или переменные, а внутренние узлы – операции (при этом есть у операции только один аргумент, то один из сыновей может быть nil).
Нужно написать процедуру со стринговым входным параметром (строка ввода), а выходным деревом.
После этого написать процедуру прямого обхода дерева для формирования префиксной формы записи выражения.

Еще вопрос: нет ни у кого модуля FParser?

За основу можно взять это:
Код:
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.
36K
23 марта 2009 года
Gonzo
32 / / 18.03.2009
Уточняю задание и выкладываю наработки. Вообщем программа считывает данные для построения дерева выражения из файла, причем одна строка файла: одна операция, одная константа или переменная 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)

Код:
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.

Упрощать ничего не нужно. Помогите разобраться. Пример входного файла вкладываю.
Нужно сменить расширение на *.in
44K
23 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
Код:
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.
36K
23 марта 2009 года
Gonzo
32 / / 18.03.2009
Спасибо. Добавляю отзыв.
36K
23 марта 2009 года
Gonzo
32 / / 18.03.2009
"При нахождении производной результатом должна быть структура указателей, описанная так ,как предыдущая. Но теперь это не обязательно должно быть дерево. Если с правой стороны равенства находятся подвыражения исходного выражения, то не стоит создавать в памяти новых узлов, а использовать уже существующие. В частности, это относится ко всему выражению exp(A). Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа).
Выписать ответ в формате таком же, как и формат входа (время пропорционально длине). Не стоит вставлять дополнительные пробелы или знаки конца строки (последняя строка должна заканчиваться знаком конца строки, так же как и предыдущие).Если программа не может посчитать производную какого-либо выражения, можно выписать на стандартный выход ошибок 'Производная не может быть найденна' (без кавычек)
Если же программа может найти производную выражения, то кроме самой производной она должна выписать на стандартный выход ошибок в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов."

Может что-нибудь присоветуете? Особенно про освобождение узлов. отблагодарю материально!
36K
24 марта 2009 года
Gonzo
32 / / 18.03.2009
Может кто-нибудь пояснить это:
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."

Код:
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.
44K
24 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
Сделал на основе предыдущего своего исходника (лениво было опять транслит исправлять)

Используемая техника называется счётчик ссылок. Комментарии {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.


UPD:
Цитата: Gonzo
Может кто-нибудь пояснить это:
"Программа должна считать производную в линейном времени – нужно только раз (конкретное число раз) проходить по определенному фрагменту дерева (чтобы это было возможно, фрагменты, которые выступают несколько раз, должны быть «подцеплены» в нескольких местах).Освободить уже не используемые части памяти (то есть узлы оригинального дерева, которые уже не используются в структуре ответа)."


Насколько я понял, имеется в виду, чтобы Diff от одного и того же дважды не вызывался. Но я не вижу такой ветки. А подцепление в нескольких местах — это вроде само собой делается.

44K
24 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
Забацал небольшой парсер. За корректность не ручаюсь.

Сеанс выглядит так:

Код:
Пустая строка оканчивает сеанс
Введите выражение: 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.
36K
25 марта 2009 года
Gonzo
32 / / 18.03.2009
Всё отлично!
Единственное нужно выписывать в файл exN.err в следующем порядке и по одному в строке: число узлов в памяти перед нахождением производной, после (но перед удалением из памяти ненужных уже узлов) и после удаления этих узлов.
OCTAGRAM, пришлите в личку номер кошелька.
44K
25 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
Сделал пока что интерактивную версию:
Код:
Узлов изначально: 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.
44K
26 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
Теперь с файлами.

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

«Пустая строка оканчивает сеанс» — это лишнее. Надо бы убрать, да только исходник уже закачан.
36K
27 марта 2009 года
Gonzo
32 / / 18.03.2009
Вообще нужно получить имя файла, считать выражение из файла, где оно записано в префиксной форме. Строить дерево выражения. Строить дерево производной, исходя из правил задания. Выписать производную в префиксной форме в файл. Выписать в файл состояние узлов.
Как только будет такой функционал программу оплатят.
44K
27 марта 2009 года
OCTAGRAM
30 / / 11.03.2009
DIFF2.PAS

Теперь выглядит так:
 
Код:
Пустая строка -> значение по умолчанию
Введите имя файла для чтения [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
36K
27 марта 2009 года
Gonzo
32 / / 18.03.2009
Попробуйте протестировать на основе этого. Вкладываю так же выходные файлы для сравнения.
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)
44K
03 апреля 2009 года
OCTAGRAM
30 / / 11.03.2009
Цитата: Gonzo
Попробуйте протестировать на основе этого. Вкладываю так же выходные файлы для сравнения.
Проверка будет выполняться с помощью тестирующей программы сравнивающей файлы на соответствие.
(архив *.rar)



Тесты либо у меня так распаковалось, либо на самом деле имеют нестандартный перенос строки. Если перенос поправить, то всё работает. Надо полагать, на тестирующей машине стоит *Nix, и там заработает.

DIFF3.PAS

Выключил отладочный вывод. Выражения слишком большие.

.out совпадал и без того, а вот .err немного расходился. По всей видимости, нули и единицы нужно было каждый раз заново создавать. Поправил — теперь сходится.

Как именно тестирующая машина задаёт входные и выходные файлы, непонятно, поэтому на месте придётся ещё слегка подпилить.

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог