Dwukierunkowa

type lista =^elem ent;

element=record

dana:word;

poprz:lista;

nast:lista;

end;

Procedure DopiszPrzedBiez

(var pocz,biez:lista var dana:word);

var pom : lista;

begin

new(pom);

pom ^.dane: = dana;

if biez = NIL then

begin

pom^.porz : = NIL;

pom^.nast: = NIL;

biez : = pom;

pocz : =pom;

end

else

begin

pom^.nast: =biez;

pom^.poprz : =biez^.poprz;

if biez ^.poprz = NIL then

pocz : =pom

else

biez^.poprz^.nast: =pom;

biez ^.poprz : =pom;

biez : = pom;

end; end;

type Plist =^Tlist;

Tlist = record;

dane : word

nast : Plist;

end;

var P,K, B : Plist;

Procedure DopiszZaBiez

(dane: word);

var wsk : Plist;

begin

new (wsk);

wsk^.dane : = dane;

if P = NIL then

begin

P : = wsk;

B : = wsk;

K : = wsk;

wsk ^.nast : = NIL;

wsk ^.poprz : = NIL;

end

else

if B = K then

begin

wsk^.nast : = NIL;

wsk^.poprz : = B;

B^.nast : = wsk;

K: =wsk;

end else

begin

wsk^.nast : =B^.nast;

wsk^.poprz : = B;

B^.nast.^.poprz : = wsk;

B^.nast : = wsk;

end; end;

TYP j1/w

Procedure UsunZListy

(var biez : lista var dana : word );

var pom : lista;

begin

dana : =biez^.dana;

pom : = biez;

if biez^.poprz < > NIL then

biez^.poprz^.nast : = biez^.nast;

if biez^.nast. < > NIL then begin

biez^.nast^.poprz : = biez^.poprz;

biez : = biez^.nast;

end else

biez : =biez^.poprz;

dispose(pom);

end;

Lista cykliczna dwukier

type lista =^cykl;

cykl =record

dana:word;

poprz:lista;

nast:lista;

end;

Procedure DodajPrzedDwuk

(var biez : lista dana: word);

var nowy : lista ;

begin

new (nowy );

nowy^.dana : = dana;

if biez = NIL then begin

biez : = nowy;

nowy^.poprz : = nowy;

nowy^.nast : = nowy;

end else

begin

nowy^.nast : = biez;

nowy^.poprz : =biez^.poprz;

biez^.poprz^.nast : =nowy;

biez^.poprz : = nowy;

biez : = nowy;

end; end;

Lista cykliczna jednokier

type WskList = ^Llist

Llist = record

dane: word;

nast : WskList ;

end;

Procedure WstawPrzed

(dane:word var B:WskList);

var pom ,pom1: WskList;

begin

new(pom) ;

pom^.dane : = dane;

if B = NIL then begin

B : = pom ;

B^.nast. : = B;

end else

begin

pom1 : = B;

while pom1^.nast < > B do

pom1 : = pom1^.nast;

pom ^.nast : = B ;

end; end;

type WskList =^SkladList;

SkladList = record

wsk1,wsk2 : WskList;

num : integer;

dane : word;

end;

Procedure UsunZListyCyklicz

(var elem : word var biez : WskList);

var poprz ,nast: WskList;

K : integer;

begin

if biez < > Nil then begin

with biez^ do begin

poprz : = wsk1;

elem : = dane;

K : = num;

nast : =wsk2;

poprz^ .wsk2 : = wsk2;

nast^.wsk1 : =wsk1;

end;

dispose (biez);

if (poprz = nast ) and

(K = nast^.num) then

biez : = Nil else begin

biez : =poprz ;

if nast ^.num < > 1 then repeat

nast ^.num : = K;

K : = K+1;

nast : = nast^.wsk2;

until nast^.num = 1

end; end; end;

Drzewa

type drzewo = ^ element

element = record

dane: word;

L,P : drzewo;

end;

Procedure Dodaj

(var wezel : drzewo ; dane: word);

var nowy : drzewo ;

begin

if wezel < > Nil then begin

if wezel ^.dane >= dane then

if wezel^.L < > Nil then

dodaj (wezel^. L ,dane)

else begin

new (nowy);

nowy^.dane : = dane;

nowy^. P : = Nil;

nowy^. L : = Nil;

wezel^. L : = nowy;

end else

if wezel ^. P < > Nil then

dodaj (wezel^. P,dane )

else begin

new (nowy);

nowy^.dane : = dane;

nowy^. P : = NIL;

nowy^. L : = Nil;

wezel ^. P: = nowy;

end; end else

begin

new (wezel);

wezel^.dane: =dane;

wezel^. L: =Nil;

wezel^. P: =Nil;

end; end;

procedura poszukiwania adresu

skladnika drzewa

procedure Adres

(var elem1: string var korzen ,biez : wskdrz);

begin

if korzen < > Nil then begin

biez : = korzen ;

if elem1 < > korze^.dane1

then repeat

if elem1 < biez^.dane1 then

biez : = biez^.wsk1

else biez : = biez^.wsk2;

until (elem1 = biez^.dane1) or (biez = Nil)

end; end;

Procedura usuwajaca drzewo

o adresie korzenia

Procedure UsunDrzewo

(var korzen ,poprz,nast. : wskdrz);

begin

if korzen < > Nil then begin

repeat nast.: = korzen ;

while nast^wsk1 < > Nil do

begin

poprz : =nast;

nast : =nast^.wsk1;

end;

while nast^.wsk2 < > Nil do begin

poprz : = nast;

nast. : = nast^.wsk2;

end;

if poprz^.wsk1 = nast then

poprz ^wsk1 : = Nil

else poprz^.wsk2 : = Nil

dispose (nast);

until nast. = korzen;

korzen : = Nil ;

end; end;

program Kolejka_do_tylu;

uses crt;

type kolejka=^element;

element=record

dana:word;

wsk:kolejka;

end;

var pocz,kon:kolejka;

procedure dodaj(dana:word);

var pom:kolejka;

begin

pom:=kon;

new(kon);

kon^.dana:=dana;

kon^.wsk:=nil;

if pom<>nil then pom^.wsk:=kon;

if pom=nil then pocz:=kon;

end;

procedure usun;

var pom:kolejka;

begin

if pocz<>nil then

begin

pom:=pocz;

pocz:=pom^.wsk;

dispose(pom);

end;

end;

procedure wyswietl;

var pom:kolejka;

begin

if kon<>nil then

begin

pom:=pocz;

while pom<>nil do

begin

writeln(pom^.dana);

pom:=pom^.wsk;

end;

end;

end;

begin

clrscr;

dodaj(1);

dodaj(2);

dodaj(3);

dodaj(4);

wyswietl;

readkey;

writeln;

usun;

wyswietl;

readkey;

writeln;

usun;

wyswietl;

readkey;

end.

program Sstos;

uses crt;

type stos=^element;

element=record

dana:word;

wsk:stos;

end;

var wierz:stos;

procedure dodaj(dana:word);

var nowy:stos;

begin

new(nowy);

nowy^.dana:=dana;

nowy^.wsk:=wierz;

wierz:=nowy;

end;

procedure usun;

var pom:stos;dana:word;

begin

if wierz<>nil then

begin

pom:=wierz;

dana:=wierz^.dana;

wierz:=wierz^.wsk;

dispose(pom);

end; end;

procedure wyswietl;

var pom:stos;

begin

if wierz<>nil then

begin

pom:=wierz;

while pom<>nil do

begin

writeln(pom^.dana);

pom:=pom^.wsk

end; end; end;

begin

clrscr;

dodaj(1);

dodaj(2);

dodaj(3);

wyswietl;

readkey;

usun;

writeln;

wyswietl;

readkey; end.

program lista_jednokierunkowa;

uses crt;

type lista=^element;

element=record

dana:word;

wsk:lista;

end;

var biez,pocz,kon:lista;

procedure dodaj(dana:word);

var nowy,pom:lista;

begin

new(nowy);

nowy^.dana:=dana;

if biez=pocz then

begin

pom:=biez;

nowy^.wsk:=pom;

biez:=nowy;

pocz:=nowy;

end

else

begin

pom:=pocz;

while pom^.wsk<>biez do pom:=pom^.wsk;

pom^.wsk:=nowy;

nowy^.wsk:=biez;

biez:=nowy;

end; end;

procedure usun;

var pom:lista;

begin

if pocz<>nil then

begin

pom:=pocz;

if pocz<>biez then

begin

while pom^.wsk<>biez do pom:=pom^.wsk;

pom^.wsk:=biez^.wsk;

dispose(biez);

if pom^.wsk<>nil then biez:=pom^.wsk

else

biez:=pom; end

else

begin

pocz:=pocz^.wsk;

dispose(biez);

biez:=pocz;

end; end; end;

procedure wyswietl;

var pom:lista;

begin

if pocz<>nil then

begin

pom:=pocz;

while pom<>nil do

begin

writeln(pom^.dana);

pom:=pom^.wsk;

end;

end;

end;

begin

clrscr;

dodaj(1);

dodaj(2);

dodaj(3);

wyswietl;

readkey;

writeln;

usun;

wyswietl;

readkey;

writeln;

usun;

wyswietl;

readkey;

end.

---