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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 17.05.2008, 14:07   #1
Neznau
Пользователь
 
Регистрация: 17.05.2008
Сообщений: 16
По умолчанию Помогите с задачей на деревья

Просьба, если получится написать программу полностью, т.к. в этой теме я полный "0"((
Найти количество четных элементов дерева, принадлежащих [а;b].

Последний раз редактировалось Neznau; 17.05.2008 в 14:10.
Neznau вне форума Ответить с цитированием
Старый 19.05.2008, 18:46   #2
Neznau
Пользователь
 
Регистрация: 17.05.2008
Сообщений: 16
По умолчанию

Вот у меня получилось такое решение, но на Паскале не работает. Помогите, пожалуйста если не сложно, исправить ошибки чтоб работало всё.
Type Tree=^TNode;
TNode=record
l:Tree;
info:integer;
r:tree;
end;
var a,b,i,k, x:integer; t:Tree;
procedure addddp(rt:Tree; c:integer);
Var tek, pred:Tree;
begin tek:=rt;
while tek<>nil do begin
pred:=tek;
if x<tek^.info then
tek:=tek^.l else tek:=rt;
end;
new(tek);
tek^.info:=x;
tek^.l:=nil;
tek^.r:=nil;
if x<pred^.info then pred^.l:=tek
else pred^.r:=tek;
begin
new(t);
readln(x);
t^.l:=nil;
t^.info:=x;
readln(x);
t^.r:=nil;
while x<>0 do begin
addddp(t,x); for i:=a to b do begin;
readln(n);
end;
end;
procedure mmm(rt:Tree; var k:integer);
begin
if t<>nil then
begin if (t^.info mod 2) =0 then k:=k+1;
mmm(t^.l,k);
mmm(t^.r,k);
end;
end;
begin
k:=0;
writeln ('vvedite a');
readln (a);
writeln ('vvedite b');
readln (b);
mmm(t,k);
end;
writeln(k);
end.
Neznau вне форума Ответить с цитированием
Старый 19.05.2008, 19:19   #3
Neznau
Пользователь
 
Регистрация: 17.05.2008
Сообщений: 16
По умолчанию

Спасибо большое, у меня вот уже заработало на Паскале, но только мне надо кол-во всех четных эл., а оно выводит у меня что-то не то. может опять где-то ошибка.
Type TTree=^TNode;
TNode=record
r, l:TTree;
info:integer;
end;
var a,b,i,k, x:integer; T:TTree; c:integer;
procedure addddp(t:TTree; c:integer);
Var tek, pred:TTree;
begin tek:=t;
while tek<>nil do begin
pred:=tek;
if c<tek^.info then
tek:=tek^.l else tek:=tek^.r;
end;
new(tek);
tek^.info:=c;
tek^.l:=nil;
tek^.r:=nil;
if c<pred^.info then pred^.l:=tek
else pred^.r:=tek;
end;
procedure mmm(t:TTree; var k:integer);
begin
if t<>nil then
begin if (t^.info mod 2) =0 then k:=k+1;
mmm(t^.l,k);
mmm(t^.r,k);
end;
c:=0;
end;
begin
new(t);
readln(x);
t^.l:=nil;
t^.info:=x;
readln(x);
t^.r:=nil;
while x<>0 do begin
addddp(t,x);
readln(x);
end;
begin
k:=0;
writeln ('vvedite a');
readln (a);
writeln ('vvedite b');
readln (b);
for i:=a to b do begin
mmm(t,k);
end;
writeln(k);
end.

Последний раз редактировалось Neznau; 19.05.2008 в 19:21.
Neznau вне форума Ответить с цитированием
Старый 19.05.2008, 19:28   #4
delphin100
Он лайн
Форумчанин
 
Аватар для delphin100
 
Регистрация: 26.09.2007
Сообщений: 173
Сообщение Код

Я подчистил ваш код. Посмотрите и протестируйте.
Код:
Type Tree=^TNode;
 TNode=record
  l:Tree;
  info:integer;
  r:tree;
       end;
var a,b,i,k, x,n:integer; t:Tree;
 procedure addddp(rt:Tree; c:integer);
 Var tek, pred:Tree;
  begin
   tek:=rt;
   while tek<>nil do
    begin
     pred:=tek;
     if x<tek^.info then tek:=tek^.l
                    else tek:=rt;
    end;
   new(tek);
   tek^.info:=x;
   tek^.l:=nil;
   tek^.r:=nil;
   if x<pred^.info then pred^.l:=tek
                   else pred^.r:=tek;
   begin
    new(t);
    readln(x);
    t^.l:=nil;
    t^.info:=x;
    readln(x);
    t^.r:=nil;
    while x<>0 do
     begin
      addddp(t,x);
      for i:=a to b do
      {begin }
        readln(n);
      {end;  } {Begin end ne nugni pri odnom deystvii}
     end;
   end;
  end;
 procedure mmm(rt:Tree; var k:integer);
  begin
   if t<>nil then
    begin
     if (t^.info mod 2) =0 then
      k:=k+1;
      mmm(t^.l,k);
      mmm(t^.r,k);
    end;
  end;
begin
 k:=0;
 writeln ('vvedite a');
 readln (a);
 writeln ('vvedite b');
 readln (b);
 mmm(t,k);
 writeln(k);
readln;
end.
delphin100 вне форума Ответить с цитированием
Старый 19.05.2008, 19:35   #5
Neznau
Пользователь
 
Регистрация: 17.05.2008
Сообщений: 16
По умолчанию

Спасибо, но я ввожу а, ввожу b. и оно выводит сразу 0 всегда.
А в той, что я переделала 2-ой раз, там я ввожу числа, например 1 2 3 4 5, затем a - 1, b - 5, и оно должно вывести, что 2 эл. четны, а паскаль выводит 10. и так с любыми числами он не то считает, не кол-во. что надо исправить?
Neznau вне форума Ответить с цитированием
Старый 19.05.2008, 20:16   #6
Neznau
Пользователь
 
Регистрация: 17.05.2008
Сообщений: 16
По умолчанию

Спасибо, delphin100 за внимание к моей задачи, уже все работает правильно. спасибо.
Neznau вне форума Ответить с цитированием
Старый 19.05.2008, 20:31   #7
IgorKr
Пользователь
 
Аватар для IgorKr
 
Регистрация: 19.11.2006
Сообщений: 44
По умолчанию

У меня тоже вопрос по деревьям. Токо он немного теоретический. Работа происходит с красно-черными деревьями. После добавлении элемента в дерево он изменяет свойства красно-черных деревьев. В литературе пишут что решить это можно при помощьи поворотов. Повороты описываються также в литературе. Вопрос состоит в следуещем: как определить где нужно делать поворот?
IgorKr вне форума Ответить с цитированием
Старый 19.05.2008, 21:13   #8
delphin100
Он лайн
Форумчанин
 
Аватар для delphin100
 
Регистрация: 26.09.2007
Сообщений: 173
Сообщение литература vs голова

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

P.S.: когда вам кто-то помогает не забывайте ему спс говорить то-есть на ссылку кликать. )Это я так к слову.(
delphin100 вне форума Ответить с цитированием
Старый 31.05.2009, 14:39   #9
Нюська
Пользователь
 
Регистрация: 26.05.2009
Сообщений: 16
По умолчанию

!!!!!!!!!!!!!!!!!!!!!!!!!!
Нюська вне форума Ответить с цитированием
Старый 31.05.2009, 14:43   #10
Нюська
Пользователь
 
Регистрация: 26.05.2009
Сообщений: 16
По умолчанию

Помогите, не работает модуль для работы с красно-черным деревом, нужно очень срочно, помогите отладить операцию добавления элемента в дерево, и создание самого дерева, не пойму где ошибка в коде.

Procedure Left_Rotate (Var X:RBTree);
Var Y:RBTree;
Begin
Y:=X^.RSon;
X^.RSon:=Y^.LSon;
IF (Y^.LSon<>nul) THEN Y^.LSon^.Parent:=X;
IF (Y<>nul) THEN Y^.Parent:=X^.Parent;
IF (X^.Parent<>nul) THEN
Begin
IF (X=X^.Parent^.LSon) THEN X^.Parent^.LSon:=Y
ELSE X^.Parent^.RSon:=Y;
End
ELSE RBT:=Y;
Y^.LSon:=X;
IF (X<>nul) THEN X^.Parent:=Y;
End;

{.................................. .............................}
Procedure Right_Rotate (Var X:RBTree);
Var Y:RBTree;
Begin
Y:=X^.LSon;
X^.LSon:=Y^.RSon;
IF (Y^.RSon<>nul) THEN Y^.RSon^.Parent:=X;
IF (Y<>nul) THEN Y^.Parent:=X^.Parent;
IF (X^.Parent<>nul) THEN
Begin
IF (X=X^.Parent^.RSon) THEN X^.Parent^.RSon:=Y
ELSE X^.Parent^.LSon:=Y;
End
ELSE RBT:=Y;
Y^.RSon:=X;
IF (X<>nul) THEN X^.Parent:=Y;
End;

{.................................. ..............................}
Procedure PutFixup (Var RBT,X:RBTree);
Var Y:RBTree;
Begin
While ((X<>RBT) and (X^.Parent^.Color=1)) do
Begin
IF (X^.Parent=X^.Parent^.Parent^.LSon) THEN
Begin
Y:=X^.Parent^.Parent^.RSon;
IF (Y^.Color=1) THEN
Begin
{uncle red}
X^.Parent^.Color:=0;
Y^.Color:=0;
X^.Parent^.Parent^.Color:=1;
X:=X^.Parent^.Parent;
End
ELSE
Begin
{uncle black}
IF (X=X^.Parent^.RSon) THEN
Begin
X:=X^.Parent;
Left_Rotate(X);
End;
X^.Parent^.Color:=0;
X^.Parent^.Parent^.Color:=1;
Right_Rotate(X^.Parent^.Parent);
End;
End
ELSE
Begin
Y:=X^.Parent^.Parent^.LSon;
IF (Y^.Color=1) THEN
Begin
{uncle red}
X^.Parent^.Color:=0;
Y^.Color:=0;
X^.Parent^.Parent^.Color:=1;
X:=X^.Parent^.Parent;
End
ELSE
Begin
{uncle black}
IF (X=X^.Parent^.LSon) THEN
Begin
X:=X^.Parent;
Right_Rotate(X);
End;
X^.Parent^.Color:=0;
X^.Parent^.Parent^.Color:=1;
Right_Rotate(X^.Parent^.Parent);
End;
End;
RBT^.Color:=0;
End;
End;

{.................................. .............................}
Function PutTree (Var RBT:RBTree; Var E):boolean;

Function Compare(a,b:integer):boolean;
Begin
IF (a<b) THEN Compare:=true
ELSE Compare:=false;
End;

Function Equality(a,b:integer):boolean;
Begin
IF (a=b) THEN Equality:=true
ELSE Equality:=false;
End;


Var Current,Parent,X:RBTree;
Begin
Current:=RBT;
Parent:=nul;
While (Current<>nul) do
Begin
IF Equality(integer(E),integer(Current ^.Data^)) THEN
Begin
PutTree:=true;
exit;
End;
Parent:=Current;
IF Compare(integer(E),integer(Current^ .Data^)) THEN Current:=Current^.LSon
ELSE Current:=Current^.RSon;
End;
IF MemAvail >= SizeOf(Element) THEN
Begin
integer(X^.Data^):=integer(E);
X^.Parent:=Parent;
X^.LSon:=nul;
X^.RSon:=nul;
X^.Color:=1;
IF (Parent<>nul) THEN
Begin
IF Compare(integer(E),integer(Parent^. Data^)) THEN Parent^.LSon:=X
ELSE Parent^.LSon:=X;
End
ELSE
RBT:=X;
PutFixup(RBT,X);
PutTree:=false;
End
ELSE

RBTreeError:=RBTreeNotMem;
End;


Procedure BildTree(Var T:RBTree);
Var i,n,a:integer;
h:boolean;
Sentinel:RBTree;
Begin
Write('Input quantity numbers in rows:');
Read(n);
i:=1;
Write('Input row of number - ');
While i<=n do
Begin
Read(a);
h:=PutTree(T,a);
inc(i);
End;
End;
Нюська вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите с задачей drossel Общие вопросы C/C++ 9 01.06.2008 21:45
Помогите с задачей в С++ vovchara Помощь студентам 2 22.04.2008 22:49
Помогите с задачей на С++ Nemisoi Помощь студентам 1 22.04.2008 22:09