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