Witam,
Zrobilem program ktory prezentuje zasade dzialania Drzew Binarnych (na potrzeby wykladu) - jednak chcialbym zaimplementowac jeszcze zapis i odczyt nie bawilem sie jeszcze operacjami na plikach wiec mam problem jak zrobic to w przypadku takiego programu :
program drzewo_wyklad;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
wsk=^wezel;
wezel=record
dana:integer;
l,p:wsk;
end;
//******************************************************************************
// procedura do wpisywania elementow
procedure wstaw(dana:integer; var head:wsk);
var
nowy:wsk;
begin
if head=nil then
begin
new(nowy);
nowy^.dana:=dana;
nowy^.l:=nil;
nowy^.p:=nil;
head:=nowy;
end
else
if dana<head^.dana then
wstaw(dana,head^.l)
else
wstaw(dana,head^.p);
end;
//******************************************************************************
// procedura dopisujaca nastepny element z opisem sciezki
procedure wstaw_opis(dana:integer; var head:wsk);
var
nowy:wsk;
begin
if head=nil then
begin
new(nowy);
nowy^.dana:=dana;
nowy^.l:=nil;
nowy^.p:=nil;
head:=nowy;
end
else
if dana<head^.dana then
begin
writeln('ide w lewo');
wstaw(dana,head^.l);
end
else
begin
writeln('ide w prawo');
wstaw(dana,head^.p);
end;
end;
//******************************************************************************
// procedura zwracajaca liczbe elementow w drzewie
procedure Elementy(head:wsk; var ilosc:integer);
begin
if head <> nil then
begin
Inc(ilosc);
Elementy(head^.l,ilosc);
Elementy(head^.p,ilosc);
end;
end;
//******************************************************************************
//procedura tworzaca nowe drzewo, konczenie po wcisnieciu "0"
procedure utworz_drzewo(var head:wsk;var ilosc:integer);
var
dana:integer;
begin
writeln('Aby zakonczyc wpisz "0"');
readln(dana);
while dana<>0 do
begin
wstaw(dana,head);
readln(dana);
end;
Elementy(head,ilosc);
end;
//******************************************************************************
//procedura tworzaca nowe drzewo z opisem, konczenie po wcisnieciu "0"
procedure utworz_drzewo_opis(var head:wsk;var ilosc:integer);
var
dana:integer;
begin
writeln('Aby zakonczyc wpisz "0"');
readln(dana);
while dana<>0 do
begin
wstaw_opis(dana,head);
readln(dana);
end;
Elementy(head,ilosc);
end;
//******************************************************************************
//procedura tworzaca drzewo z podanej ilosci elementow
procedure utworz_drzewo_ilosc(var head:wsk;var ilosc:integer);
var
dana:integer;
i:integer;
begin
writeln('Podaj z ilu elementow ma sie skladac drzewo');
readln(ilosc);
for i:=1 to ilosc do
begin
readln(dana);
wstaw(dana,head);
end;
end;
//******************************************************************************
//procedura tworzaca drzewo z opisem sciezki z podanej ilosci elementow
procedure utworz_drzewo_ilosc_opis(var head:wsk;var ilosc:integer);
var
dana:integer;
i:integer;
begin
writeln('Podaj z ilu elementow ma sie skladac drzewo');
readln(ilosc);
for i:=1 to ilosc do
begin
readln(dana);
wstaw_opis(dana,head);
end;
end;
//******************************************************************************
//procedura do wyboru tworzenia drzewa
procedure utworz(var head:wsk;var ilosc:integer);
var
wybor:char;
begin
writeln('W jaki sposob chcesz utworzyc drzewo:');
writeln('[1] - podajesz dane, a na koniec wprowadzania podajesz zero');
writeln('[2] - podajesz ilosc danych');
readln(wybor);
case wybor of
'1' :utworz_drzewo(head,ilosc);
'2' :utworz_drzewo_ilosc(head,ilosc);
end;
writeln('Drzewo sklada sie z ',ilosc,' elementow');
end;
//******************************************************************************
//procedura do wyboru tworzenia drzewa
procedure utworz_opis(var head:wsk;var ilosc:integer);
var
wybor:char;
begin
writeln('W jaki sposob chcesz utworzyc drzewo:');
writeln('[1] - podajesz dane, a na koniec wprowadzania podajesz zero');
writeln('[2] - podajesz ilosc danych');
readln(wybor);
case wybor of
'1' :utworz_drzewo_opis(head,ilosc);
'2' :utworz_drzewo_ilosc_opis(head,ilosc);
end;
writeln('Drzewo sklada sie z ',ilosc,' elementow');
end;
//******************************************************************************
// procedura wyswietlajaca posortowana zawartosc drzewa
procedure wyswietl(head:wsk);
begin
if head<>nil then
begin
wyswietl(head^.l);
write(head^.dana,' ');
wyswietl(head^.p);
end;
end;
//******************************************************************************
// funkcja zwracajaca adres znalezionego elementu
function Wyszukaj(head : Wsk; dana : integer) : Wsk;
begin
if (head = nil) or (head^.dana = dana) then Wyszukaj:=head
else
if dana < head^.dana then Wyszukaj:=Wyszukaj(head^.l,dana)
else Wyszukaj:=Wyszukaj(head^.p,dana);
end;
//******************************************************************************
// procedura do dopisywania elementow
procedure dodaj(var head:wsk);
var
nowy:wsk;
dana:integer;
begin
writeln('Podaj wartosc');
readln(dana);
if head=nil then
begin
new(nowy);
nowy^.dana:=dana;
nowy^.l:=nil;
nowy^.p:=nil;
head:=nowy;
end
else
if dana<head^.dana then
wstaw(dana,head^.l)
else
wstaw(dana,head^.p);
end;
//******************************************************************************
// procedura usuwania elementu
procedure Usun_el(var head:wsk);
var
pomoc,rodzic,usuwany,potomek: wsk; {X?rodzic, Y-usuwany, Z-dziecko}
dana:integer;
begin
writeln('Podaj, ktory element chcesz usunac');
readln(dana);
rodzic:=nil;
usuwany:=head;
while usuwany<>nil do
begin
if usuwany^.dana = dana then break
else
begin
rodzic:=usuwany;
if usuwany^.dana > dana then usuwany:=usuwany^.l
else usuwany:=usuwany^.p;
end;
end;
if usuwany<>nil then
if (usuwany^.l= nil) or (usuwany^.p=nil) then
begin
if (usuwany^.l = nil) and (usuwany^.p = nil) then potomek:=nil
else
if (usuwany^.l =nil) then potomek:=usuwany^.p
else
potomek:=usuwany^.l;
if rodzic=nil then head:=potomek
else
if usuwany=rodzic^.l then rodzic^.l:=potomek
else
rodzic^.p:=potomek;
dispose(usuwany);
end
else
begin
potomek:=usuwany^.p;
if potomek^.l=nil then usuwany^.p:= potomek^.p
else
begin
repeat
pomoc:=potomek;
potomek:=potomek^.l;
until potomek^.l=nil;
pomoc^.l:=potomek^.p;
end;
usuwany^.dana:= potomek^.dana;
dispose(potomek);
end;
end;
//******************************************************************************
//procedura do usuwania calego drzewa
procedure usun_drzewo(var head:wsk);
var
pomoc,pomoc1,pomoc2,pomoc3,pomoc4:wsk;
//begin
//pomoc:=head;
//if head=nil then writeln('Drzewo jest puste')
//else
// begin
//while pomoc<>nil do
//while (pomoc^.l<>nil) and (pomoc^.p<>nil)do
// begin
// readln;
// if (pomoc^.p=nil) or (pomoc^.l=nil) then
// if (pomoc^.p=nil) and (pomoc^.l=nil) then pomoc1:=nil
// else
// if (pomoc^.l=nil) then
// begin
// readln;
// write('*');
// pomoc1:=pomoc^.p;
// usun_drzewo(pomoc1);
//end
//else
// begin
// readln;
// write('#');
// pomoc1:=pomoc^.l;
// usun_drzewo(pomoc1);
//end;
//pomoc2:=pomoc1;
// dispose(pomoc1);
//pomoc:=pomoc2;
//end;
// end;
begin
if head<>nil then
begin
readln;
write('* ');
usun_drzewo(head^.l);
pomoc1:=head^.l;
pomoc2:=pomoc1;
dispose(pomoc1);
head^.l:=pomoc2;
write('# ');
usun_drzewo(head^.p);
pomoc3:=head^.p;
pomoc4:=pomoc3;
dispose(pomoc3);
head^.p:=pomoc4
end;
head:=nil;
end;
// procedura wyswietlajaca posortowana zawartosc drzewa
//procedure wyswietl(head:wsk);
//begin
//if head<>nil then
//begin
//wyswietl(head^.l);
//write(head^.dana,' ');
//wyswietl(head^.p);
//end;
//end;
//******************************************************************************
// program glowny
var
head:wsk;
znak:char;
ilosc:integer;
begin
head:=nil;
repeat
if head<>nil then
begin
writeln('Posortowane elementy znajdujace sie w drzewie');
wyswietl(head);
end;
//else writeln('Drzewo jest puste');
writeln;
writeln;
writeln;
writeln('[1] :utworz drzewo');
writeln('[2] :utworz drzewo z opisem sciezki');
writeln('[3] :dodaj element do drzewa');
writeln('[4] :wypisz drzewo');
writeln('[5] :usun elenent z drzewa');
writeln('[6] :usun drzewo');
writeln('[7] :zapis drzewa do pliku');
writeln('[8] :odczytanie drzewa z pliku');
writeln('[9] :wyjscie');
writeln('Co wybierasz ?');
readln(znak);
case znak of
'1' :utworz(head,ilosc);
'2' :utworz_opis(head,ilosc);
'3' :dodaj(head);
'4' :wyswietl(head);
'5' :usun_el(head);
'6' :usun_drzewo(head);
//'7' :zapis(head);
//'8' :wczytaj(head);
end;
writeln;
writeln;
until znak ='9';
dispose(head);
end.