IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Преобразование дерева-формулы
redeezko
сообщение 6.12.2010 12:48
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 22
Пол: Мужской

Репутация: -  0  +


Всем добрый день. Прошу помочь со следующей задачей:

Необходимо описать процедуру, которая преобразует дерево-формулу, заменяя в нем все поддеревья вида ((a*b)+-(c*b)) на ((a+-c)*b). Тип элементов дерева: char, т.е в формуле могут содержаться буквы(переменные)

Например:
дана формула ((5*а)+(3*а)), дерево, ей соответствующее:

--------а
----*
--------3
+
--------а
----*
--------5

На выходе должна получиться формула ((5+3)*а), и дерево:

----а
*
--------3
----+
--------5
Пока что у меня получилось написать только создание и вывод на печать этого дерева:

unit unit_tree;

interface

 type tTree=^Node;
      Node=Record
            Info:Char;
            Left,Right:tTree
           end;

  Procedure print_tree(root:tTree; h:integer);
   {Печать дерева}
  Procedure formula (var root:tTree; s:string);
   {Создание дерева-формулы}
  Procedure copy_tree (var root1:tTree; root:tTree);
//  Procedure proizv(root:tTree; var root1:tTree);

implementation

 const
  Operations=['-','+','*'];

 procedure print_tree;
  var
   i:integer;
  begin
   if root<>nil then
     begin
      print_tree (root^.Right,h+1);
      for i:=1 to h do write('    ');
      writeln(root^.Info);
      print_tree(root^.Left,h+1)
     end
  end;

 procedure copy_tree;
  begin
   if root<>nil then
     begin
      new (root1);
      root1^.info:=root^.info;
      copy_tree(root1^.Left,root^.Left);
      copy_tree(root1^.Right,root^.Right)
     end
    else root1:=nil
  end;

 function prior (a:char):byte;
  {Приоритет арифметической операции}
  begin
   case a of
    '+','-': prior:=1;
    '*':     prior:=2
   end
  end;

 procedure Delete_Brackets (var s:string);
  {Удаление крайних скобок }
  var
   i,n:integer;
  begin
    if s[1]='(' then
     begin
      n:=0;
      i:=2;
      while (n>=0) and (i<length(s)) do
       begin
        if s[i]='(' then inc(n)
         else if s[i]=')' then dec(n);
        inc(i)
       end;
      if n=0 then
       begin
        delete(s,1,1);
        delete(s,length(s),1)
       end
     end
  end;

 function Find_Root (var s:string):integer;
  {Поиск позиции "корня" для каждого поддерева}
  var
   pr,i,n:integer;
  begin
   Delete_Brackets(s);
   pr:=3;
   Find_Root:=0;
   i:=length(s);
   while (i>1) and (pr>1) do
    if s[i]=')' then
      begin
       n:=1;
       while n<>0 do
        begin
         dec(i);
         if s[i]=')' then inc(n)
          else if s[i]='(' then dec(n)
        end;
       dec(i)
      end
    else
     if (s[i] in Operations) and (prior(s[i])<pr) then
      begin
       Find_Root:=i;
       pr:=prior(s[i]);
       dec(i)
      end
      else dec(i)
  end;

 procedure formula;
  var
   n_pos:integer;
  begin
   n_pos:=Find_Root(s);
   if n_pos<>0 then
     begin
      new(root);
      root^.info:=s[n_pos];
      formula(root^.Left,copy(s,1,n_pos-1));
      formula(root^.Right,copy(s,n_pos+1,length(s)-n_pos))
     end
    else
     begin
      new(root);
      root^.info:=s[1];
      root^.Left:=nil;
      root^.Right:=nil
     end
  end;


А как найти необходимое для замены поддерево, а затем его заменить, я и не знаю..

Сообщение отредактировано: redeezko - 6.12.2010 13:18
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 28.07.2025 2:27
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"