Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.12.2012, 18:21   #1
olol-o
Новичок
Джуниор
 
Регистрация: 25.12.2012
Сообщений: 2
По умолчанию улаление вершины дерева

помогите, пожалуйста, с задачей про улаление вершины дерева.
тут где то ошибка. нужно удалить все вершины, имеющие максимальную сумму цифр
type tree = ^node;
node = record
info, count: integer;
h: boolean;
left, right: tree;
end;

var t: tree; a,x, n,m,max: integer; f: text;

procedure del_tree(var t: tree; a: integer);
var
temp: tree;
procedure delete(var t1: tree);
begin
if t1^.right <> nil then delete(t1^.right)
else begin
temp := t1;
t^.info := t1^.info;
t1 := t1^.left;
end;
end;

begin
if t <> nil then
if a > t^.info then del_tree(t^.right, a)
else if a < t^.info then del_tree(t^.left, a)
else begin
temp := t;
if t^.right = nil then t := t^.left
else if t^.left = nil then t := t^.right
else delete(t^.left);
dispose(temp);
end;
end;

function Summa(var x:integer):integer;
var s:integer;
begin
s := 0;
while x <> 0 do
begin
s := s + x mod 10;
x := x div 10;
end;
Summa:= s;
end;

procedure Print_tree( t: tree; d: integer);
begin
if t <> nil then begin
print_tree(t^.right, d + 1);
write(t^.info: d * 5);
if (Summa(x)>max) then max:=Summa(x);
writeln('(' , summa(t^.info) , ')');
print_tree(t^.left, d + 1);
end;
end;

procedure P_tree(var t: tree; d:integer);
begin
if t <> nil then begin
p_tree(t^.right, d+1);
if t^.info=max then del_tree(t,t^.info);
if t <> nil then p_tree(t^.left, d+1);
//if t^.info=max then del_tree(t,t^.info);
end;
end;

procedure ins_tree(var t: tree; a: Integer );
begin
if t = nil then begin
new(t);
t^.info := a;
t^.left := nil;
t^.right := nil;
t^.count := 1;
end
else if a > t^.info then ins_tree(t^.right, a)
else if a < t^.info then ins_tree(t^.left, a)
// else if a = t^.info then inc(t^.count);
end;

begin
t := nil;
max:=0;
assign(f, 'input.txt');
reset(f);
while not EOF(f) do
begin
readln(f, a);
ins_tree(t, a);
end;
writeln('derevo');
print_tree(t, 0);
p_tree(t,0);
close(f);
writeln('polychennoe derevo');
print_tree(t,0);
end.

Последний раз редактировалось olol-o; 25.12.2012 в 21:02.
olol-o вне форума Ответить с цитированием
Старый 25.12.2012, 19:03   #2
hon
Форумчанин
 
Регистрация: 08.06.2011
Сообщений: 693
По умолчанию

Где компилятор ругается? Почему код не оформлен? Из-за этого его не возможно читать. На месте некоторых знаков из-за этого смайлы идут.
hon вне форума Ответить с цитированием
Старый 25.12.2012, 20:45   #3
olol-o
Новичок
Джуниор
 
Регистрация: 25.12.2012
Сообщений: 2
По умолчанию

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

Последний раз редактировалось olol-o; 25.12.2012 в 21:00.
olol-o вне форума Ответить с цитированием
Старый 27.12.2012, 17:05   #4
hon
Форумчанин
 
Регистрация: 08.06.2011
Сообщений: 693
По умолчанию

Кажется проблема здесь (выделено красным):
Код:
if t1^.right <> nil then delete(t1^.right)
На этом форуме перед отправкой сообщения нужно выделить код и нажать кнопку с #. Вот оформленный по правилам форума код+оформленный через DelForEx.

Код:
type
   tree=^node;
   node=record
      info, count: integer;
      h: boolean;
      left, right: tree;
   end;

var
   t: tree; a, x, n, m, max: integer; f: text;

procedure del_tree(var t: tree; a: integer);
var
   temp: tree;
   procedure delete(var t1: tree);
   begin
      if t1^.right<>nil then delete(t1^.right)
      else begin
         temp:=t1;
         t^.info:=t1^.info;
         t1:=t1^.left;
      end;
   end;

begin
   if t<>nil then
      if a>t^.info then del_tree(t^.right, a)
      else if a<t^.info then del_tree(t^.left, a)
      else begin
         temp:=t;
         if t^.right=nil then t:=t^.left
         else if t^.left=nil then t:=t^.right
         else delete(t^.left);
         dispose(temp);
      end;
end;

function Summa(var x: integer): integer;
var
   s: integer;
begin
   s:=0;
   while x<>0 do
   begin
      s:=s+x mod 10;
      x:=x div 10;
   end;
   Summa:=s;
end;

procedure Print_tree(t: tree; d: integer);
begin
   if t<>nil then begin
      print_tree(t^.right, d+1);
      write(t^.info: d*5);
      if (Summa(x)>max) then max:=Summa(x);
      writeln('(', summa(t^.info), ')');
      print_tree(t^.left, d+1);
   end;
end;

procedure P_tree(var t: tree; d: integer);
begin
   if t<>nil then begin
      p_tree(t^.right, d+1);
      if t^.info=max then del_tree(t, t^.info);
      if t<>nil then p_tree(t^.left, d+1);
//if t^.info=max then del_tree(t,t^.info);
   end;
end;

procedure ins_tree(var t: tree; a: Integer);
begin
   if t=nil then begin
      new(t);
      t^.info:=a;
      t^.left:=nil;
      t^.right:=nil;
      t^.count:=1;
   end
   else if a>t^.info then ins_tree(t^.right, a)
   else if a<t^.info then ins_tree(t^.left, a)
// else if a = t^.info then inc(t^.count);
end;

begin
   t:=nil;
   max:=0;
   assign(f, 'input.txt');
   reset(f);
   while not EOF(f) do
   begin
      readln(f, a);
      ins_tree(t, a);
   end;
   writeln('derevo');
   print_tree(t, 0);
   p_tree(t, 0);
   close(f);
   writeln('polychennoe derevo');
   print_tree(t, 0);
end.

Последний раз редактировалось hon; 27.12.2012 в 17:08.
hon вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Найти вершины прямоугольника vslinko Помощь студентам 1 19.11.2012 22:04
Вершины Alina_Honey Паскаль, Turbo Pascal, PascalABC.NET 0 12.05.2011 20:42
Граф и вершины faustpatron13 Мультимедиа в Delphi 0 04.01.2011 07:32
найти вершины квадрата dimon131 Общие вопросы C/C++ 7 23.12.2010 12:04
DirectX 10. Формат вершины HWork Gamedev - cоздание игр: Unity, OpenGL, DirectX 2 06.09.2010 10:12