Here is a collection of basic algorithms, which can easily be rewritten into any language. I enclose various types of sorting, searching, work on texts, stacks, queues, lists, bi-directional and trees.

#bubblesort – sortowanie bąbelkowe

==================
procedure bubblesort(n:integer;var A:tab);
var
i,k,z:integer;

begin

for i:=1 to n-1 do
for k:=n downto (i+1) do
begin
if A[k]<A[k-1] then
begin
z:= A[k];
A[k]:= A[k-1];
A[k-1]:=z;
end;
end;
end;
==================

#insertsort – Sortowanie przez wstawianie

==================
procedure insert_sort(n:integer; var a:tab);
var
j,p:integer;
begin
i:=2;
while (i<=n) do
begin
j:=i;
p:=a[i];
while (a[j-1]>p)and(j>0) do
begin
a[j]:=a[j-1];
j:=j-1;
end;

a[j]:=p;
i:=i+1;
end;
end;
==================

#binsort – Sortowanie binarne

==================
procedure Binsort(l,p : integer; var t:tab; var d:tab );
var
s,i1,i2,i : integer;
begin
s := (l + p + 1) div 2;
if s – l > 1 then Binsort(l, s – 1,t,d);
if p – s > 0 then Binsort(s, p,t,d);
i1 := l;
i2 := s;
for i := l to p do
if (i1 = s) or ((i2 <= p) and (d[i1] > d[i2])) then
begin
T[i] := d[i2];
i2:=i2+1;
end
else
begin
T[i] := d[i1];
i1:=i1+1;
end;
for i := l to p do d[i] := T[i];  // przeladowanie tablicy
end;
==================

#quicksort

==================

procedure quicksort(L, P : integer);
var
i,j,s,x : integer;
begin
i := (L + P) div 2;
s := a[i]; a[i] := a[P];
j := L;
for i := L to P – 1 do
if a[i] < s then
begin
x := a[i]; a[i] := a[j]; a[j] := x;
inc(j);
end;
a[P] := a[j]; a[j] := s;
if L < j – 1  then quicksort(L, j – 1);
if j + 1 < P then quicksort(j + 1, P);
end;
==================

#flaga polska 01

==================

procedure sort01 (n:integer; var A:tab);
var
x,l,p: integer;

begin
p:=n;
l:=1;
while (l<p) do
begin
while (a[l]=0) do
begin
if (l<p)then l:=l+1;
end;
while (a[p]=1) do
begin
if (l<p)then p:=p-1;
end;
x:=a[p];
a[p]:=a[l];
a[l]:=x;
l:=l+1;
p:=p-1;

end;
==================

#flaga francuska 123

==================
procedure sort123 (n:integer; var A:tab);
var
x,p,n1,n2,n3: integer;

begin
n1:=0;
n2:=1;
n3:=n+1;
while (n2<n3) do
begin
p:=a[n2];
if (p=1)then
begin
n1:=n1+1;
x:=a[n1];
a[n1]:=a[n2];
a[n2]:=x;
n2:=n2+1;
end
else if (p=2) then n2:=n2+1
else
begin
n3:=n3-1;
x:=a[n2];
a[n2]:=a[n3];
a[n3]:=x;
end;
end;
end;
==================

#maxsort

==================

procedure maxsort (n:integer; var A:tab);
var
p,k,dc,i: integer;

begin
dc:=n;

while(dc>1) do
begin
p:=a[1];
k:=1;
i:=2;
while(i<=dc) do
begin
if a[i]>p then
begin
p:=a[i];
k:=i;
end;
i:=i+1;
end;
a[k]:=a[dc];
a[dc]:=p;
dc:=dc-1;
end;

end;
==================

#sortowanie przez porównanie

==================
procedure porownanie (n:integer; var A:tab);
var
dc,i,x: integer;

begin
dc:=n;

while(dc>1) do
begin
i:=2;
while(i<=n) do
begin
if a[i-1]>a[i] then
begin
x:=a[i-1];
a[i-1]:=a[i];
a[i]:=x;
end;
i:=i+1;
end;
dc:=dc-1;
end;

end;
==================

#line seek – wyszukiwanie liniowe

==================
function line_seek(n:integer; A:tab; x:integer):integer;
var
i,B:integer;
begin
i:=1;
B:=1;
while (i<=n) AND (b=1) do begin
if  A[i]=x then B:=0 else i:=i+1;
end;
if B=0 then seek:=i else seek:=0;
end;
==================

#bis.iteracyjnie – wyszukiwanie bisekcyjne interacyjne

==================
function seek (n:integer; var A:tab; t:integer):integer;
var
s,l,p: integer;

begin
p:=n;
l:=1;
while (l<p) do
begin
s:=(l+p)DIV 2;
if t<=a[s] then
p:=s
else
l:=s+1;
end;
if a[l]=t then    seek:=l
else seek:=0;
end;
// i:=seek(n,A,x);
// writeln(‘szukana wartosc ‘,x,’ znajduje sie na ‘,i,’. miejscu’);
==================

#bis.rekurencyjnie – wyszukiwanie bisekcyjne rekurencyjne

==================
function seek1(l:integer; p:integer; var A:tab; t:integer):integer;
var
s: integer;

begin

if l=p then
begin
if t=a[l]then
seek1:=l
else seek1:=0;
end
else
begin
s:=((l+p) DIV 2);
if t>a[s] then
seek1:=seek1(s+1,p,a,t)
else seek1:=seek1(l,s,a,t);
end;
end;
// j:=seek1(1,n,A,x);
// writeln(‘szukana wartosc ‘,x,’ znajduje sie na ‘,j,’. miejscu’);
==================

Wyszukiwanie wzorca w tekście

Algorytm Naiwny

#naiwny-dekl

==================
program Algorytm_Naiwny;

uses
SysUtils;

type
tab=array[1..100] of integer;

var
t,w:string;
dt,dw,snr:integer;
pnr:tab;
==================
#naiwny-wczyt
==================
procedure wczytaj(var t,w:string; var dt,dw:integer);
begin
writeln (‘Podaj wzorzec :’);
readln(w);
writeln (‘Podaj tekst :’);
readln(t);
dw:=Length(w);
dt:=Length(t);
end;
==================
#naiwny-procedura
==================
procedure naiwny (dw,dt:integer; t,w:string; var s:integer; var p:tab);
var
i,j:integer;
ok:boolean;

begin
s:=0;
for i:=1 to (dt-dw+1) do
begin
j:=0;
ok:=TRUE;
while (j<dw) and ok do
begin
ok:=(t[i+j]=w[j+1]);
j:=j+1;
end;
if ok then
begin
s:=s+1;
p[s]:=i;
end;
end;
end;
==================
#naiwny-print
==================
procedure wypisz (s:integer; p:tab);
var
i:integer;
begin
writeln(‘Indeksy wystapienia wzorca’);
for i:=1 to s do
write(p[i],’, ‘);
end;

begin
wczytaj(t,w,dt,dw);
naiwny(dw,dt,t,w,snr,pnr);
wypisz(snr,pnr);
readln;

end.
==================

Wyszukiwanie wzorca w tekście

Algorytm Karpa Rabina

#KR
==================
program algorytm_KR;

uses
SysUtils;

// GŁÓWNY PROGRAM
var
t,w:string;
i,j,Ht,Hw,p,dt,dw:integer;

begin
writeln (‘Podaj TEKST w którym  szukamy wzorca.’);
readln(t);
writeln (‘Podaj WZORZEC.’);
readln(w);
dw:=Length(w);
dt:=Length(t);               // ord (arg) zwraca kod ASCI parametru
Ht:= ord(t[1]);              // Funkcja ta działa odwrotnie do Chr
Hw:= ord(w[1]);
p:=1;                                         // mnożnik

for i:=2 to dw do              // dt- dlugosc tekstu
begin                          // dw dlugosc wzorca
Ht:= Ht*10+ord(t[i]);
Hw:= Hw*10+ord(w[i]);
p:=p*10;
end;

i:=1;

writeln(‘_____________________________________________________’);
writeln(‘Indeksy tekstu w ktorych powtarza sie  nasz Wzorzec :’);
writeln;

while (i<=(dt-dw+1)) do
begin
if (Hw=Ht) then
begin
j:=0;
while (t[i+j]=w[j+1]) and (j<dw) do j:=j+1;
if j=dw then writeln(‘-> ‘,i);
end;
ht:= (ht-ord(t[i])*p)*10+ord(t[i+dw]);
i:=i+1;
end;

writeln;
writeln(‘___________________________________’);
writeln(‘Program zakonczyl sie powodzeniem !’);
readln;
end.

==================

Stos

#stos-deklaracje
==================
program stos_by_aras88;
{$APPTYPE CONSOLE}
type
Pstos=^stos;
stos=record
dana:integer;
adres:Pstos;
end;

VAR
aktualny:Pstos;
e,a,le:integer;
==================
#stos-push
==================
procedure push(var e:integer; var aktualny:Pstos);
VAR
nowy:Pstos;
begin
new(nowy);
nowy^.dana:=e;
nowy^.adres:=aktualny;
aktualny:=nowy;
end;
==================
#stos-pop
==================
procedure pop(var aktualny:Pstos);
var
poprzedni:Pstos;
begin
if aktualny<>NIL then
begin
poprzedni:=aktualny^.adres;
dispose(aktualny);
aktualny:=poprzedni;
end
else
writeln(‘stos jest pusty’);
end;
==================
#stos-print
==================
procedure print(aktualny:Pstos);
begin
if aktualny=NIL then writeln(‘stos jest pusty’);

while (aktualny<>NIL) do
begin
writeln(aktualny^.dana,’ <-> ‘);
aktualny:=aktualny^.adres;
end;
end;
==================
#stos-count
==================
procedure count(var le:integer; aktualny:Pstos);
begin
le:=0;
while (aktualny<>NIL) do
begin
aktualny:=aktualny^.adres;
le:=le+1;
end;
end;
==================
#stos-main
==================
BEGIN
aktualny:=NIL;

repeat
writeln(‘=================’);
writeln(‘1. dodaj do stosu’);
writeln(‘2. usun ze stosu’);
writeln(‘3. wyswietl stos’);
writeln(‘4. liczba elementow’);
writeln(‘5. wyjscie’);
writeln(‘=================’);
readln(a);

case a of
1: begin
writeln(‘=================’);
writeln(‘Podaj element, ktory chcesz dodac’); readln(e);
push(e,aktualny);
end;
2: begin
writeln(‘=================’);
pop(aktualny);
end;
3: begin
writeln(‘=================’);
print(aktualny);
end;
4: begin
writeln(‘=================’);
count(le,aktualny);
writeln(‘liczba elementow: ‘,le);
end

else
begin
writeln(‘=================’);
writeln(‘podales zla cyfre, wybierz (1-5)’);
end;
end;

until a=5;

END.

==================

Kolejka

#kolejka FIFO-dekl
==================
program kolejka_by_aras88;
{$APPTYPE CONSOLE}
//kolejka (bufor typu FIFO, First In, First Out)
// (pierwszy na wejściu, pierwszy na wyjściu)

uses
SysUtils;

type Pkolejka=^element;
element = record
dane:integer;
nast_k:Pkolejka;
end;

var
pocz_k,koniec_k:Pkolejka;
le,e,a:integer;
==================
#kolejka enqueue(kon)
==================
procedure enqueue(var pocz_k,koniec_k:Pkolejka; e:integer);

var temp:Pkolejka;

begin
temp:=koniec_k;
new(koniec_k);
koniec_k^.dane:=e;
koniec_k^.nast_k:=NIL;
if (tempNIL) then
temp^.nast_k:=koniec_k else
pocz_k:=koniec_k;
end;
==================
#kolejka dequeue(pocz)
==================
procedure dequeue( var pocz_k,koniec_k:Pkolejka; var dane:integer);

var temp:Pkolejka;

begin
if pocz_kNIL then begin
temp:=pocz_k;
pocz_k:=pocz_k^.nast_k;
dispose(temp);
end

else
begin
koniec_k:=NIL;
writeln(‘kolejka jest pusta’);
end;

end;
==================
#kolejka print
==================
procedure print( pocz_k,koniec_k:Pkolejka);

begin
while pocz_kkoniec_k do begin
writeln(pocz_k^.dane);
pocz_k:=pocz_k^.nast_k;
end;
if koniec_kNIL then writeln(koniec_k^.dane)
else writeln(‘kolejka jest pusta’);
end;

==================
#kolejka count
==================
procedure count(var le:integer; pocz_k:Pkolejka);
begin
le:=0;
while (pocz_kNIL) do
begin
pocz_k:=pocz_k^.nast_k;
le:=le+1;
end;
end;
==================
#kolejka main
==================
BEGIN
pocz_k:=NIL;
koniec_k:=NIL;

repeat
writeln(‘=================’);
writeln(‘1. dodaj do kolejki’);
writeln(‘2. usun ze kolejki’);
writeln(‘3. wyswietl kolejke’);
writeln(‘4. liczba elementow’);
writeln(‘5. wyjscie’);
writeln(‘=================’);
readln(a);

case a of
1: begin
writeln(‘=================’);
writeln(‘Podaj element, ktory chcesz dodac’); readln(e);
enqueue(pocz_k, koniec_k,e);
end;
2: begin
writeln(‘=================’);
dequeue(pocz_k,koniec_k,e);
end;
3: begin
writeln(‘=================’);
print(pocz_k,koniec_k);
end;
4: begin
writeln(‘=================’);
count(le,pocz_k);
writeln(‘liczba elementow: ‘,le);
end

else
begin
writeln(‘=================’);
writeln(‘podales zla cyfre, wybierz (1-5)’);
end;
end;

until a=5;

END.
==================

Lista dwukierunkowa

#lista2k deklaracje
==================
program Lista_dwukierunkowa_by_aras88;

{$APPTYPE CONSOLE}

uses
SysUtils;

type Plista2k=^lista2k;
lista2k=record
dana:integer;
nast:Plista2k;
poprz:Plista2k;
end;

var ml,y,tmp,x,il,poz_dod, poz_usun, el_usun, tmp_poz:integer;
start_l, koniec_l: Plista2k;
od, odk:boolean;

==================
#lista2k add_pocz
==================
procedure Zapis_pocz(var el:integer; var start,koniec:Plista2k);
var rob:Plista2k;
begin
rob:=start;
NEW(start);

start^.dana:=el;
start^.poprz:=nil;
start^.nast:=rob;
if robnil then rob^.poprz:=start
else koniec:=start;
end
==================
#lista2k add_kon
==================
procedure Zapis_kon(var el:integer; var start,koniec:Plista2k);
var rob:Plista2k;
begin
rob:=koniec;
NEW(koniec);

koniec^.dana:=el;
koniec^.poprz:=rob;
koniec^.nast:=NIL;
if robnil then rob^.nast:=koniec
else start:=koniec;
end;
==================
#lista2k add_poz
==================
procedure Zapis_poz(poz:integer; var el:integer; var start:Plista2k);
var rob,rob1:Plista2k;
tmp:integer;
begin
rob:=start;
for tmp:=1 to poz-1 do
rob:=rob^.nast;

NEW(rob1);
rob1.dana:=el;
rob1.poprz:=rob^.poprz;
rob1.nast:=rob;
(rob^.poprz).nast:=rob1;
rob.poprz:=rob1;

end;

==================
#lista2k del_pocz
==================
function Usun_pocz(var x:integer; var start,koniec:Plista2k):Boolean;
var
rob:Plista2k;
begin
If start=NIL then Usun_pocz:=false
else
begin
Usun_pocz:=true;
x:=start^.dana;
rob:=start;
start:=start^.nast;
dispose(rob);
end;
IF startNIL THEN
start^.poprz:=NIL
ELSE
koniec:=start;
end;
==================
#lista2k del_kon
==================
function usun_kon(var x:integer; var start,koniec:Plista2k):Boolean;
var
rob:Plista2k;
begin
If koniec=NIL then Usun_kon:=false
else
begin
Usun_kon:=true;
x:=koniec^.dana;
rob:=koniec;
koniec:=koniec^.poprz;
dispose(rob);
end;
IF koniecNIL THEN
koniec^.nast:=NIL
ELSE
start:=koniec;
end;
==================
#lista2k del_poz
==================
function Usun_poz(poz:integer; var start:Plista2k):integer;
var rob:Plista2k;
tmp:integer;
begin
rob:=start;
for tmp:=1 to poz-1 do
rob:=rob^.nast;

Usun_poz:=rob^.dana;
(rob^.poprz).nast:=rob^.nast;
(rob^.nast).poprz:=rob^.poprz;
dispose(rob);
end;
==================
#lista2k count
==================
function Podaj_ilosc(start:Plista2k):integer;
var rob:Plista2k;
tmp:integer;
begin
tmp:=0;
if start=NIL then Podaj_ilosc:=0
else
begin
rob:=start;
while rob NIL do
begin
tmp:=tmp+1;
rob:=rob^.nast;
end;
Podaj_ilosc:=tmp;
end;
end;
==================
#lista2k print
==================
procedure Wyswietl_liste(start:Plista2k);
var rob:Plista2k;
begin
rob:=start;
while rob NIL do
begin
writeln(rob^.dana);
rob:=rob^.nast;
end;
end;
==================
#lista2k pozycia
==================
function Spr_l(var poz:integer; var el:integer; start:Plista2k):boolean;
var rob:Plista2k;
jest:boolean;
begin
rob:=start;jest:=false; poz:=1;
while (rob NIL)and (not jest) do
begin
jest:=rob^.dana=el;
rob:=rob^.nast;
poz:=poz+1;
end;
poz:=poz-1;
spr_l:=jest;
end;

==================
#lista2k main
==================
begin
start_l:=nil;koniec_l:=start_l;
repeat
writeln(‘=================’);
writeln(‘1. Dodanie na poczatek listy’);
writeln(‘2. Dodanie na koniec listy’);
writeln(‘3. Dodanie na pozycje listy’);
writeln(‘4. Usuniecie z poczatku listy’);
writeln(‘5. Usuniecie z konca listy’);
writeln(‘6. Usuniecie z pozycji listy’);
writeln(‘7. Usuniecie danego elementu z listy’);
writeln(‘8. Wyswietlenie listy’);
writeln(‘9. Podanie ilosci elementow listy’);
writeln(’10. Sprawdzenie czy istnieje’);
writeln(’11. KONIEC’);
writeln(‘=================’);
readln(ml);
Case ml of
1:
begin
writeln(‘=================’);
writeln(‘Podaj dana: ‘);
readln(tmp);

Zapis_pocz(tmp,start_l,koniec_l);
end;
2:
begin
writeln(‘=================’);
writeln(‘Podaj dana: ‘);
readln(tmp);
Zapis_kon(tmp,start_l,koniec_l);
end;
3:
begin
writeln(‘=================’);
il:=podaj_ilosc(start_l);
writeln(‘Podaj na ktora pozycje chcesz dodac element: ‘);
readln(poz_dod);
writeln(‘Podaj dana: ‘);
readln(tmp);
if (poz_dod>il) then Zapis_kon(tmp,start_l,koniec_l)
else
if (poz_dod=1) then Zapis_pocz(tmp,start_l,koniec_l)
else Zapis_poz(poz_dod,tmp,start_l);
end;
4:
begin
writeln(‘=================’);
writeln(‘Nacisnij Enter by usunac element z poczatku listy…’);
readln;
od:=Usun_pocz(x,start_l,koniec_l);
if od then
writeln(‘Usunieto z listy: ‘,x)
else
writeln(‘Lista byla pusta’);
end;
5:
begin
writeln(‘=================’);
writeln(‘Nacisnij Enter by usunac element z konca listy!’);
readln;
od:=Usun_kon(x,start_l,koniec_l);
if od then
writeln(‘Usunieto z listy: ‘,x)
else
writeln(‘Lista byla pusta’);
end;
6:
begin
writeln(‘=================’);
il:=podaj_ilosc(start_l);
writeln(‘Podaj z ktorej pozycji chcesz usunac element: ‘);
readln(poz_usun);
if (poz_usun>=il) then
begin
od:=Usun_kon(x,start_l,koniec_l);
if od then
writeln(‘Usunieto z listy: ‘,x)
else
writeln(‘Lista byla pusta’);
end
else
if (poz_usun=1) then
begin
od:=Usun_pocz(x,start_l,koniec_l);
if od then
writeln(‘Usunieto z listy: ‘,x)
else
writeln(‘Lista byla pusta’);
end
else
begin
x:=Usun_poz(poz_usun, start_l);
writeln(‘Usunieto z listy: ‘,x);
end;
end;
7:
begin
writeln(‘=================’);
il:=podaj_ilosc(start_l);
writeln(‘Podaj dana do usuniecia: ‘);
readln(el_usun);
odk:=spr_l(tmp_poz,el_usun,start_l);
if (not odk) then writeln(el_usun,’ nie istnieje w liscie!’)
else begin
if (tmp_poz=il) then
begin
od:=Usun_kon(x,start_l,koniec_l);
writeln(‘Usunieto z listy: ‘,x);
end
else
if (tmp_poz=1) then
begin
od:=Usun_pocz(x,start_l,koniec_l);
writeln(‘Usunieto z listy: ‘,x);
end
else
begin
x:=Usun_poz(tmp_poz, start_l);
writeln(‘Usunieto z listy: ‘,x);
end;
end;
end;
8:
begin
writeln(‘=================’);
writeln(‘lista:’);
Wyswietl_liste(start_l);
end;
9:
begin
writeln(‘=================’);
il:=podaj_ilosc(start_l);
writeln(‘W liscie znajduje sie: ‘,il,’ elementow.’);
end;
10:
begin
writeln(‘=================’);
writeln(‘Podaj dana do sprawdzenia: ‘);
readln(y);
odk:=spr_l(tmp_poz,y,start_l);
if odk then writeln(y,’ istnieje w liscie, na: ‘,tmp_poz,’ pozycji.’)
else writeln(y, ‘ nie istnieje w liscie!’);
end;
11:
else begin
writeln(‘=================’);
writeln(‘podales zla cyfre, wybierz (1-11)’); end;
end;
until ml=11;
writeln(‘Nacisnij Enter aby zakonczyc ‘);
readln;

end.

==================

Drzewo binarne

#BST deklaracje
==================
program drzewo_BST_by_aras88;
{$apptype console}
uses
SysUtils;

type
TDana = integer; // deklaracja jakiejś danej
Drzewo = ^TDrzewo; // typ wskazujący na drzewko
TDrzewo = record // drzewko
etykieta: TDana;
lewy, prawy: Drzewo; // potomkowie
end;

var
i, a, n: integer;
drzewko: Drzewo;

==================
#BST add
==================
// procedura wstawiania
procedure Wstaw(var W : Drzewo; Co : TDana);
begin
if W = nil then
begin
new(W);
if W = nil then
exit;
W^.lewy:=nil;
W^.prawy:=nil;
W^.etykieta:=Co;
end
else
if W^.etykieta > Co then
Wstaw(W^.lewy,Co)
else
if W^.etykieta
Wstaw(W^.prawy,Co);
end;

==================
#BST del_co
==================
procedure Usun(var W : Drzewo; Co : TDana);
var
T,X,Y,Z: Drzewo; {X-rodzic, Y-usuwany, Z-dziecko}
begin
X:=nil;
Y:=W;
while Ynil do
begin
if Y^.etykieta = Co then
break
else
begin
X:=Y;
if Y^.etykieta > Co then
Y:=Y^.lewy
else
Y:=Y^.prawy;
end;
end;
if Ynil then
if (Y^.lewy= nil) or (Y^.prawy=nil) then
begin
if (Y^.lewy = nil) and (Y^.prawy = nil) then
Z:=nil
else
if (Y^.lewy =nil) then
Z:=Y^.prawy
else
Z:=Y^.lewy;
if X=nil then
W:=Z
else
if Y=X^.lewy then
X^.lewy:=Z
else
X^.prawy:=Z;
dispose(Y);
end
else
begin
Z:=Y^.prawy;
if Z^.lewy=nil then
Y^.prawy:= Z^.prawy
else
begin
repeat
T:=Z;
Z:=Z^.lewy;
until
Z^.lewy=NIL;
T^.lewy:=Z^.prawy;
end;
Y^.etykieta:= Z^.etykieta;
dispose(Z);
end;
end;

==================
#BST inorder
==================
//Inorder (lewe dziecko, dana, prawe dziecko)
procedure inorder(W : Drzewo);
begin
if W nil then
begin
inorder(W^.Lewy);
Writeln(W^.Etykieta);
inorder(W^.Prawy);
end;
end;
==================
#BST preorder
==================
//Preorder (dana, lewe dziecko i prawe dziecko).
procedure preorder(W : Drzewo);
begin
if W nil then
begin
Writeln(W^.Etykieta);
preorder(W^.Lewy);
preorder(W^.Prawy);
end;
end;
==================
#BST postorder
==================
//Postorder (lewe dziecko, prawe dziecko, dana)
procedure postorder(W : Drzewo);
begin
if W nil then
begin
postorder(W^.Lewy);
postorder(W^.Prawy);
Writeln(W^.Etykieta);
end;
end;
==================
#BST search
==================
// procedura szukania
procedure szukaj(W : Drzewo; dana: tdana);

begin
if W nil then
begin
szukaj(W^.Lewy, dana);
if W^.etykieta = dana then
begin
Writeln(‘znaleziona: ‘, W^.etykieta);
Exit;
end;
szukaj(W^.Prawy, dana);
end;
end;

==================
#BST main
==================
begin

// menu

repeat
writeln(‘=================’);
writeln(‘ DRZEWO BST MENU: ‘);
writeln(‘=================’);
writeln(‘1. Dodaj’);
writeln(‘2. Usun’);
writeln(‘3. Wyszukaj’);
writeln(‘4. Wyswietl lisc – postorder’);
writeln(‘5. Wyswietl lisc – inorder’);
writeln(‘6. Wyswietl lisc – preorder’);
writeln(‘0. Wyjdz z programu’);
///// koniec menu
readln(a);

///////CASE
case a of
1: begin
writeln(‘=================’);
Writeln(‘Podaj lisc jaki chcesz dodac do drzewa’);
Readln(n);
Wstaw(drzewko, n);

end;

2: begin writeln(‘=================’);
Writeln(‘podaj wartosc do usuniecia’);
readln(a);
usun(drzewko, a);
end;
3: begin writeln(‘=================’);
Writeln(‘podaj szukana wartosc:’);
Readln(a);
szukaj(Drzewko, a);
end;
4: begin writeln(‘=================’);
writeln(‘Drzewo wyswietlone metoda postorder:’);
postorder(drzewko);
end;

5: begin writeln(‘=================’);
writeln(‘Drzewo wyswietlone metoda inorder:’);
inorder(drzewko);
end;

6: begin writeln(‘=================’);
writeln(‘Drzewo wyswietlone metoda preorder:’);
preorder(drzewko);
end;

7: begin
end;
else writeln(‘=================’);
writeln(‘podales zla cyfre, wybierz (1-7)’);
end;
until a=7;

///// koniec case’a
readln;
end.

==================

Zad.1.

 student

#program stud
==================
{uses crt;}

type student=record
nazwisko : string[30];
imie     : string[20];
ocena    : array[1..3] of integer;
srednia  : real;
end;
type student20=array[1..20] of student;

procedure sortoj_bombelkowo( n : integer; var s : student20);
var
i, j : integer;
temp : student;
begin
for i:=n downto 1 do
for j:=1 to i-1 do
begin
if s[j].srednia > s[j+1].srednia then
begin
temp   := s[j];
s[j]   := s[j+1];
s[j+1] := temp;
end;
end;
end;

procedure sortoj_przez_wstawianie( n:integer; var s : student20);
var
i, j   : integer;
x      : student;
begin
for i:=2 to n do
begin
x := s[i];
j := i;
while( s[j-1].srednia > x.srednia ) do
begin
s[j] := s[j-1];
j := j-1;
end;
s[j] := x;
end;

end;

==================
#program stud-main
==================
var
n, i, metoda : integer;
protokol     : student20;
begin
write( ‘Podaj liczbe studentow do wczytania: ‘);
readln( n );
for i:=1 to n do
with protokol[i] do
begin
write( ‘Podaj nazwisko ‘,i,’ studenta : ‘);
readln( nazwisko );
write( ‘Podaj imie ‘,i,’ studenta : ‘);
readln( imie );
write( ‘Podaj ocene z 1 egzaminu : ‘);
readln( ocena[1] );
write( ‘Podaj ocene z 2 egzaminu : ‘);
readln( ocena[2] );
write( ‘Podaj ocene z 3 egzaminu : ‘);
readln( ocena[3] );
srednia := (ocena[1]+ocena[2]+ocena[3]) / 3;
end;

writeln(‘Podaj metode sortowania’);
writeln(‘ 1 – przez wstawianie’);
writeln(‘ 2 – bombelkowe’);
readln( metoda );
if( metoda = 1 ) then
sortoj_przez_wstawianie( n, protokol )
else
sortoj_bombelkowo( n, protokol);

for i:=1 to n do
with protokol[i] do
begin
writeln( i, ‘. ‘, nazwisko , ‘ ‘ , imie , ‘ ‘ , srednia);
end;

end.
==================

Zad.2.

#move_to_front-tresc
==================
Dany jest typ stosu TStack i kolejki TQueue w Pascalu przechowujących dane typu TElement oraz operacje na nich jak poniżej: type  TElement  =   …;
TStack = …;
TQueue = …;
function empty_stack (var S : TStack) : boolean;
function pop (var S : TStack; var e : TElement) : boolean;
procedure push (var S : TStack; var e : TElement);
function empty_queue (var S : TQueue) : boolean;
function detach (var S : TQueue; var e : TElement) : boolean;
procedure attach (var S : TQueue; var e : TElement);
Operacje częściowe reprezentowane są jako funkcje o wartości logicznej. Używając tylko tych operacji, bez wiedzy o implementacji stosu i kolejki napisz procedurę pascalową przesuwającą ostatnio wstawiony element na początek danej kolejki move_to_front (var Q:  TQueue) ;
==================
#move_to_front-roz
==================
procedure move_to_front(var Q:TQueue);
var Rob:TQueue;e:TElement;
begin
while empty_queue(Q)=false do
begin
if (detach(Q,e)=true) and (empty_queue(Q)=false)
then attach(Rob,e);
end;
//w tym miejscu Q jest puste
//w e jest wciaz ostatni element z Q,a w Rob jest wszystko
//bez ostatniego elementu z pierwotnego Q
attach(Q,e);
while empty_queue(Rob)=false do
begin
if detach(R,e)=true then attach(Q,e);
end;
end;

==================

Zad.3.

#search in BST-tresc
==================
Drzewo BST jest to binarne uporządkowane drzewo, w którym lewy następnik każdego węzła ma klucz o wartości mniejszej niż ten węzeł, natomiast prawy następnik ma klucz o większej wartości. W Przykładzie przedstawionym na rysunku korzeń ma klucz 100, jego lewe poddrzewo zawiera klucze mniejsze od 100. a prawe większe od 100. Lewe poddrzewo węzła o kluczu 70 zawiera klucze mniejsze od 70. a prawe większe. Ta własność obowiązuje dla wszystkich węzłów drzewa.
Dane jest drzewo BST określone za pomocą wskaźnika do korzenia. Drzewo zawiera poprawne dane (nie trzeba go tworzyć ani sprawdzać). Elementy drzewa to:
type
PElementDrzewa=^ElementDrzewa; ElementDrzewa=record
klucz:nteger;
wskaznikDoDanych:PDane;      //wyjaśnione  niżej
lewy:PElementDrzewa;
prawy:PElementDrzewa; end;

Drzewo stanowi indeks ułatwiający wyszukiwanie w bazie danych. Każdy element drzewa zawiera, oprócz klucza, wskaźnik do rekordu z danymi. Dane (rekordy) bazy danych są przypadkowo rozrzucone w pamięci. Rekordy bazy danych są typu
type
PDane=^Dane; Dane=record;
klucz:integer;
//bardzo dużo innych danych,   których nie  warto umieszczać w drzewie end;
Napisać funkcję wyszukaj , która korzystając z drzewa znajdzie w bazie danych rekord o zadanym kluczu i zwróci wskaźnik do niego.
function wyszukaj(szukanyKlucz:integer):PDane; //wynikiem jest wskaźnik do rekordu bazy danych (NIE DO ELEMENTU DRZEWA)

==================
#search in BST-funkcja
==================
function wyszukaj (szukanyKlucz:integer;korzen:PElementDrzewa):PDane;
begin
if korzen=nil then wyszukaj:=nil
else
if szukanyKlucz=korzen^.klucz then wyszukaj:=korzen.wskaznikDoDanych
else
if szukanyKlucz<korzen^.klucz then
wyszukaj:=wyszukaj(szukanyKlucz,korzen^.lewy)
else
wyszukaj:=wyszukaj(szukanyKlucz,korzen^.prawy);
end;

==================

Zad.4.

#lista-tresc
==================

Dana jest lista jednokierunkowa, której elementami są wskaźniki do początków i końców list dwukierunkowych posortowanych rosnąco. Napisać procedurę, która stworzy jedną listę dwukierunkową zawierającą elementy posortowane niemalejąco z przedziału:

==================
#lista-rozwiazanie
==================
procedure tworz(lista:GElement listy var pocz:wskElListy;var koniec:wskElListy);
var robl:GElementListy;
pocz:wsk ElListy;min,max:integer;
koniec:wsk ElListy;temp:wskElListy;
begin
robl:=lista;
min:=robl.poczatek.dane;
max:=robl.koniec.dane;
while robl<>nil do
begin
if min<robl.poczatek.dane then min:=robl.poczatek.dane;
if max>robl.koniec.dane then max:=robl.koniec.dane;
robl:=robl.nast(//lub rast.nie moge rozczytac)
end;
==================
#del_prevlast
==================
procedure usun_przedostatni(var S:TStack);
VAR
warunek:boolean;
S2:TStack;
BEGIN
warunek:=false;

while (warunek=false) do begin
warunek:=pop(S,e);
push(S2,e);
warunek:=empty_stack(S);
end;

warunek:=pop(S2,e);
push(S,e);
warunek:=pop(S2,e); //usuniecie przedostatniego
warunek:=empty_stack(S2);

while (warunek=false) do begin
warunek:=pop(S2,e);
push(S,e);
warunek:=empty_stack;
end;
end;

==================

Zad.5. Dzielenie kolejki

#DzielQueue
==================
procedure podziel_kolejke(var biezacy:PElement; var biezacy1:PElement; var biezacy2:PElement);
VAR
i,j:integer;
rob:PElement;
BEGIN
rob:=biezacy;
i:=1;

while(rob^.nast=biezacy) do begin
rob:=rob^.nast;
i:=i+1;
end;
j:=iDIV2;

if (iMOD2)=1 then j:=(iDIV2)+1
else j:= i/2;

biezacy1:=biezacy;
biezacy2:=biezacy^.pop
rob:=biezacy;

for i=1 to (j-1) do begin
rob:=rob^.nast;
end;

biezacy2^.nast:=rob^.nast;
rob^.nast^.pop:=biezacy2;
rob^.nast:=biezacy1;
biezacy1^.pop=rob;

end;

==================

Zad.6. Łączenie kolejki

#JoinQueue
==================
procedure polacz_kolejki(var biezacy1: PElement; var biezacy2: PElement; var biezacy: PElement)
begin
biezacy:=biezacy1;
biezacy.pop:=biezacy2;
biezacy1^.pop^.nast:=biezacy2^.nast;
biezacy2^.nast^.pop:=biezacy1^.pop;
biezacy2.nast:=biezacy1;
biezacy.nas:=biezacy1.nast;

biezacy1:=nil;
biezacy2:=nil;
end;