[delphi/pascal] Usuwanie wezla , obrot w drzewie

0

media klamia, ale podobno jest tu ktos kto ma wieksze pojecie na temat programowania wiec prosze pomocy musze zrobic obracanie drzewa zachowujac jego struktore wedlug dowolnego wezla a takze usuwanie dowolnego wezla bez straty struktury troche probowalem ale nie bardzo moge sobie z tym poradzic a mam juz malo czasu prosze o pomoc najlepiej wprowadzajac odpowiednie dane w 2 puste procedury badz jak tez dusza woli :] oto kod programu:

program krzaczor;
uses crt;
type
typ_danych = integer;
wsk_elem = ^element;
element = record
dane : typ_danych;
lewe_dz : wsk_elem;
prawe_dz : wsk_elem;
end;
var
drzewo, aktualny, war, ojciec : wsk_elem;
f : typ_danych;
l,k : integer;
znak, I,O,P : char;
koniec,jest : boolean;

function porownaj (var dana_1, dana_2 : typ_danych) : shortint;
begin
if dana_1 > dana_2 then
porownaj := 1
else if dana_1 = dana_2 then
porownaj := 0
else
porownaj := -1;
end;

procedure dodaj_dane (var korzen : wsk_elem; do_dodania : typ_danych);
var
nowy_elem : wsk_elem;
tutaj_wstaw : wsk_elem;
begin
new (nowy_elem);
nowy_elem^.dane := do_dodania;
nowy_elem^.lewe_dz := nil;
nowy_elem^.prawe_dz := nil;

if korzen = nil then
begin
korzen := nowy_elem;
exit;
end;

tutaj_wstaw := korzen;

repeat
if porownaj (do_dodania, tutaj_wstaw^.dane) >= 0 then
begin
if tutaj_wstaw^.prawe_dz = nil then
tutaj_wstaw^.prawe_dz := nowy_elem;
tutaj_wstaw := tutaj_wstaw^.prawe_dz
end
else
begin
if tutaj_wstaw^.lewe_dz = nil then
tutaj_wstaw^.lewe_dz := nowy_elem;
tutaj_wstaw := tutaj_wstaw^.lewe_dz;
end
until tutaj_wstaw = nowy_elem;
end;

procedure kasuj (var korzen : wsk_elem);
begin
if korzen = nil then
exit;
if korzen^.lewe_dz <> nil then
kasuj (korzen^.lewe_dz);
if korzen^.prawe_dz <> nil then
kasuj (korzen^.prawe_dz);
dispose (korzen);
korzen := nil;
ojciec := nil;
writeln;
write ('Skasowano element drzewa');
end;

function menu : char;
begin
textcolor (white);
while keypressed do
menu := readkey;

writeln ('A - Dodaj liczbe do drzewa');
writeln ('S - Wywaz drzewo');
writeln ('D - Kasuj drzewo');
writeln ('W - Pokaz elementy drzewa');
writeln ('F - Wyszukaj');
writeln ('E - Usun wezel');
write ('Q - Koniec ');
writeln ('[I]-lewo, [O]-centruj, [P]-prawo');
menu := upcase(readkey);
end;

procedure dodaj_liczbe;
var
liczba : integer;
begin
write ('Podaj liczbe: ');
readln (liczba);
dodaj_dane (drzewo, liczba);
end;

procedure wyswietl (var korzen : wsk_elem; poziom, numer : byte);
var
wsk : wsk_elem;
znak : char;
begin
if poziom = 1 then
if (korzen = nil) and (poziom = 1) then
write ('Drzewo jest puste');

if (korzen = nil) or (poziom > 6) then
exit;

gotoxy ((1 shl (6 - poziom)) + (1 shl (7 - poziom)) * (numer-1), poziom * 2);
if korzen=aktualny then
begin
textcolor (red+blink);
writeln (korzen^.dane)
end
else
begin
textcolor (white);
writeln (korzen^.dane)
end;

if korzen^.lewe_dz <> nil then
wyswietl (korzen^.lewe_dz, poziom + 1, numer * 2 - 1);
if korzen^.prawe_dz <> nil then
wyswietl (korzen^.prawe_dz, poziom + 1, numer * 2);
end;

procedure pokaz(drzewo:wsk_elem);

begin
if drzewo=nil then exit;
if drzewo.lewe_dz<>nil then pokaz (drzewo.lewe_dz);
write (drzewo^.dane,' ,');
if drzewo.prawe_dz<>nil then pokaz (drzewo.prawe_dz);
end;

procedure szukaj(drzewo:wsk_elem; b:typ_danych);

begin
if drzewo=nil then exit;
if b=drzewo^.dane then jest := True;
if (drzewo.lewe_dz<>nil) and (drzewo.dane>b) then
szukaj (drzewo^.lewe_dz,b);
if (drzewo.prawe_dz<>nil) and (drzewo.dane<b) then
szukaj (drzewo^.prawe_dz,b);
end;

procedure idz (krzak:wsk_elem; co : char);

begin
if krzak=nil then exit;
if co = 'O' then war:=krzak;
if (co = 'I') and (krzak^.lewe_dz<>nil) then
begin
ojciec:=krzak;
idz(krzak^.lewe_dz,'O')
end;
if (co = 'P') and (krzak^.prawe_dz<>nil) then
begin
ojciec:=krzak;
idz(krzak^.prawe_dz,'O')
end
end;

procedure obrot;

begin
end;

procedure del_wezel (krzaczor:wsk_elem);

var
nast:wsk_elem;

begin
end;

begin
clrscr;
koniec := False;
drzewo := nil;
ojciec := nil;
repeat
textbackground (blue);
gotoxy (1,17);
case menu of
'A' : dodaj_liczbe;
'S' : begin
write ('Do jakiej liczby ma byc wywazone drzewo ? ');
readln (k);
wywaz (drzewo , k ,1)
end;
'D' : kasuj (drzewo);
'W' : begin
if drzewo<>nil then
begin
pokaz (drzewo);
znak:=readkey
end
else
end;
'F' : begin
if drzewo<>nil then begin
write ('Wpisz wartosc do sprawdzenia ');
read (f);
jest := False;
szukaj (drzewo,f);
gotoxy (1,24);
if jest = True then
write ('W drzewie znajduje sie podana wartosc.')
else
write ('W drzewie nie odnaleziono podanej wartosci.');
znak:=readkey
end
else
end;
'I' : idz (aktualny,'I');
'O' : begin
ojciec:=nil;
idz (drzewo,'O');
end;
'P' : idz (aktualny,'P');
'Q' : koniec := True;
'E' : del_wezel(war);
{begin
if drzewo<>nil then begin
write ('Ktory wezel usunac ? ');
read (f); jest := False;
szukaj (drzewo,f);
if jest=True then
begin
gotoxy (1,24);
write ('Usunieto wybrany wezel...');
del_wezel (drzewo,f);
znak:=readkey
end
else
begin
gotoxy (1,24);
write ('W drzewie nie ma podanego wezla...');
znak:=readkey
end
end
end;}
end;
aktualny:=war;
clrscr;
wyswietl (drzewo, 1, 1);
until koniec;
kasuj (drzewo);
end.

ps. te moje probowanie stanelo na tym ze usuwam wezly bez nastepnikow i z jednym, ale gdy juz sie pojawia te jedno dziecko to znalazlem luki w tym co popisalem wiec zostawiam te dwa pola puste zeby nie namieszac komus kto ma o tym wieksze pojecie, mysle ze jak chociaz jedna z tych wymienionych przeze mnie procedur bedzie dzialala to jakos dam rade z reszta, ale i tak dziekuje z gory za jakakolwiek sensowna pomoc

0

Ja mam coś co może ci pomóc. Jest to kod z drzewa avl ale się powinno nadać:

// tak wygląda definicja węzła
type
  PWz = ^TWz;
  TWz = record
     Key: Integer;
     Data: Pointer;
     Left: PWz;
     Right: PWz;
     V: ShortInt;
  end;

procedure TAvlTree.Del(Key: Integer);
begin
  RemoveItem(Key, FRoot, 0);
end;

function TAvlTree.RemoveItem(Key: Integer; var wz: PWz; s: Integer): Integer;
var
  x, y{, m, n}: PWz;
  h, i: Integer;
  temp: TWz;
begin
  Result:= s;
  if wz = nil then begin
     Result:= 0;
     Exit;
  end;
  if wz^.Key = Key then begin // znaleziono węzel o kluczu key
     if (wz^.Left = nil)or(wz^.Right = nil) then begin // jedno lub zero potomstwa
        if wz^.Left = nil then
           x:= wz^.Right // ma prawe potomstwo
        else
           x:= wz^.Left; // ma lewe potomstwo
        Dispose(wz);
        wz:= x;
        Result:= s;
     end else begin// oboje potomstwa
        y:= wz^.Right;
        x:= wz;
        while y^.Left <> nil do begin
          y:= y^.Left; // szukanie najbliższej liczby
        end;
        temp:= y^;
        RemoveItem(y^.Key, FRoot, 0);
        x^.Key:= temp.Key;
        x^.Data:= temp.Data;
     end;
     Exit;
  end else if wz^.Key < Key then begin // klucz jest po prawej stronie
     h:= RemoveItem(Key, wz^.Right, -1);
     i:= wz^.V;
     wz^.V:= wz^.V + h;
     Rownowaz(wz);
     if h = 0 then
        Result:= 0;
     if abs(i) <= abs(wz^.V) then
        Result:= 0;
  end else begin                       // klucz jest po lewej stronie
     h:= RemoveItem(Key, wz^.Left , 1);
     i:= wz^.V;
     wz^.V:= wz^.V + h;
     Rownowaz(wz);
     if h = 0 then
        Result:= 0;
     if abs(i) <= abs(wz^.V) then
        Result:= 0;
  end;
end;

// Procedura Rownowaz jest tu nie istotna gdyrz orginalnie dbała o strukturę drzewa AVL

procedure TAvlTree.Rotuj(var wz: PWz); // pojedyńcza rotacja w prawo lub w lewo
var
  x, y, A, B, C: PWz;
  m, n, l: Integer;
begin
  if wz^.V < 0 then begin
     y:= wz;        //         y         x
     C:= y^.Right;  //       /  \       / \
     x:= y^.Left;   //      x   C  ->  A   y
     A:= x^.Left;   //     / \            / \
     B:= x^.Right;  //    A  B           B   C
     m:= Count(A);
     n:= Count(B);
     l:= Count(C);
     wz:= x;
     x^.Left:= A;
     x^.Right:= y;
     y^.Left:= B;
     y^.Right:= C;
     x^.V:= max(l + 1, n + 1) - m;
     y^.V:= l - n;
  end else begin
     x:= wz;        //      x             y
     A:= x^.Left;   //     / \           / \
     y:= x^.Right;  //    A   y   ->    x   C
     B:= y^.Left;   //       / \       / \
     C:= y^.Right;  //      B   C     A  B
     m:= Count(A);
     n:= Count(B);
     l:= Count(C);
     wz:= y;
     y^.Right:= C;
     y^.Left:= x;
     x^.Left:= A;
     x^.Right:= B;
     y^.V:= l - max(m + 1, n + 1);
     x^.V:= n - m;
  end;
end;
// nie przejmuj sie Count to możesz spokojnie usunąć

// i jeszcze podwójna rotacja możę też sie przyda
procedure TAvlTree.DublRotate(var wz: PWz);
begin
  if wz^.V > 0 then begin
     Rotuj(wz^.Right);
     Rotuj(wz);
  end else begin
     Rotuj(wz^.Left);
     Rotuj(wz);
  end;
end;

PS wydaje mi się że możesz zignorować wszystko co dotyczy pola V węzła
Pozdrawiam

0

Dzieki wielkie za pomoc, troche zle rozpisalem warunki w swoich probach:(

ps. po odbytych laborkach zamieszcze caly kod programu
piss.. i jeszcze raz dzieki :]

1 użytkowników online, w tym zalogowanych: 0, gości: 1