Drzewo [turbo Pascal]

[koparka]

Napisalem ostatnio drzewo (dodawanie dziala idealnie) i postanowilem zrobic tez

usuwanie. Troche sie pomeczylem z moja wyobraznia i karta i wpadlem na pewnien

algorytm:

- bedzie jedna funckja co usunie podanego "ojca" i go uporzodkuje

i zwroci przez wartosc adres tego elementu, ktory wszedl za ojca,

co bedzie przydatne dla powrotnego laczenia ['usunojca']

- druga funckja bedzie znajdzywala element tuz nad elementem usuwanym,

aby zarzucic na niego wczesniejsza procedure i podlaczyc jej wynik do siebie ['znajdz']

- trzecia jest pomocnicza co sprawdza warunki i uruchamia odpowiednio

funckje usuwajace ['usun']

 

niby sie usuwa, ale jednak nie zawsze i jak podamy cos co nie jest to tez potrafi sie wykrzaczyc :[

 

moglby ktos sprobowac skompilowac i powiedziec mi co jest nie tak?

oto kod zrodlowy

program drzewo;uses crt;type	wskaznik=^Trekord;	Trekord=record				   liczba:integer;				   lewy:wskaznik;				   prawy:wskaznik;	end;var   glowa:wskaznik;{---------------------------------------------------------------------------}function wyszukaj(liczba:integer; gora:wskaznik):wskaznik;var   x:wskaznik;begin	 x:=gora;	 if (X^.liczba>=liczba) and (X^.lewy<>nil) then		X:=wyszukaj(liczba,gora^.lewy)	 else	 if (X^.liczba<liczba) and (X^.prawy<>nil) then		 X:=wyszukaj(liczba,gora^.prawy);	 wyszukaj:=x;end;{---------------------------------------------------------------------------}procedure dodaj(liczba:integer);var   N,x:wskaznik;begin	 new(N);	 N^.liczba:=liczba;	 if glowa=nil then		glowa:=N	 else		 begin			  X:=wyszukaj(liczba,glowa);			  if X^.liczba>=liczba then				 X^.lewy:=N			  else				  X^.prawy:=N;		 end;end;{---------------------------------------------------------------------------}function znajdz(liczba:integer; gora:wskaznik):wskaznik;var   x:wskaznik;begin	 x:=gora;	 if (X^.prawy<>nil) and (X^.prawy^.liczba=liczba) then		znajdz:=x	 else	 if (X^.lewy<>nil) and (X^.lewy^.liczba=liczba) then		znajdz:=x	 else	 if (X^.liczba>liczba) and (X^.lewy<>nil) then		X:=wyszukaj(liczba,gora^.lewy)	 else	 if (X^.liczba<liczba) and (X^.prawy<>nil) then		 X:=wyszukaj(liczba,gora^.prawy)	 else	 x:=nil;	 znajdz:=x;end;{---------------------------------------------------------------------------}function usunojca(miejsce:wskaznik):wskaznik;var   x,y,z:wskaznik;begin	 y:=miejsce^.lewy;	 if miejsce^.prawy<>nil then		begin			 x:=miejsce^.prawy;			 if y<>nil then				begin					 z:=wyszukaj(y^.liczba,x);					 if z^.liczba>=y^.liczba then						z^.lewy:=y					 else						z^.prawy:=y;				end;				dispose(miejsce);				usunojca:=x;		end	 else	 if y<>nil then		begin			 dispose(miejsce);			 usunojca:=y;		end	 else		 usunojca:=nil;end;{---------------------------------------------------------------------------}procedure usun(liczba:integer);var   x:wskaznik;begin	 if glowa<>nil then		begin			 if glowa^.liczba=liczba then				 glowa:=usunojca(glowa)			 else				 begin					  x:=znajdz(liczba,glowa);					  if X<>nil then						   if(X^.lewy^.liczba=liczba) then							  X^.lewy:=usunojca(X^.lewy)						   else						   if(X^.prawy^.liczba=liczba) then							  X^.prawy:=usunojca(X^.prawy);				 end		end;end;{---------------------------------------------------------------------------}procedure wypisz(wsk:wskaznik);begin	 if wsk<>nil then	 begin		  wypisz(wsk^.lewy);		  write(wsk^.liczba,' ');		  wypisz(wsk^.prawy);	 end;end;{---------------------------------------------------------------------------}procedure menu;var   z:char;   licz,a:integer;   t:string;begin	 clrscr;	 writeln;	 wypisz(glowa);	 gotoxy(3,7); write('1.Dodaj liczbe');	 gotoxy(3,8); write('2.Usun');	 gotoxy(3,9); write('3.Koniec');	 repeat		   z:=readkey;	 until z in['1','2','3'];	 if (z='1') or (z='2') then	 begin			  gotoxy(10,10); write('Podaj liczbe: ');			  readln(t);			  val(t,licz,a);					if (a<>0) or ((licz*licz)>1000000) then					begin					   textcolor(red);					   gotoxy(10,11); write('Podaj liczbe od -1000 do 1000');					   delay(1500);					end			  else			  begin				   if z='1' then					  dodaj(licz);				   if z='2' then					  usun(licz);			  end;		 end	 else	 if z='3' then halt;end;{---------------------------------------------------------------------------}begin	 textbackground(3);	 glowa:=nil;	 repeat		   textcolor(black);		   menu;	 until false;end.

Dziekuje i pozdrawiam

 

EDIT: Wydaje mi sie ze to moze byc STACK OVERFLOW problemem.

Jak sprawdzic czy to rzeczywiscie tylko to jest zamieszane w ta sprawe i jesli

tak to jak temu zaradzic?

Edytowane 8 Kwietnia 2006 przez koparka