Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
PROGRAM
mrgsort;
USES
crt;
TYPE
tablica=ARRAY[1..100] of integer; {tablica do liczb}
VAR
tab:tablica;
wiersze:integer;
procedure polacz(var tab:tablica; p,sr,k:integer);
var
temp:tablica;
i,k1,k2,p1,p2:integer;
begin
p1:=p;
k1:=sr;
p2:=sr+1;
k2:=k;
i:=p1;
while ((p1<=k1) and (p2<=k2)) do
begin
if(tab[p1]<tab[p2]) then
begin
temp[i]:=tab[p1];
p1:=p1+1;
end
else
begin
temp[i]:=tab[p2];
p2:=p2+1;
end;
i:=i+1;
end; {koniec petli while}
while(p2<=k2) do
begin
temp[i]:=tab[p2];
p2:=p2+1;
i:=i+1;
end;
while(p1<=k1) do
begin
temp[i]:=tab[p1];
p1:=p1+1;
i:=i+1;
end;
for i:=p to k do
tab[i]:= temp[i];
end;
procedure mergesort(var tab:tablica; p,k:integer);
var
sr:integer;
begin
if (p<k) then
begin
sr:=(p+k) div 2;
mergesort(tab,p,sr);
mergesort(tab,sr+1,k);
polacz(tab,p,sr,k);
end;
end;
procedure wypelnij_tablice(var t:tablica;l_w:integer);
var
i:integer;
begin
for i:=1 to l_w do {wiersze}
begin
t[i]:=random(10);
end;
writeln('Tablica zostala wypelniona liczbami pseudolosowymi.');
writeln;
end;
procedure wyswietl_tablice(t:tablica;l_w:integer);
var
i:integer;
begin
for i:=1 to l_w do {wiersze}
begin
writeln(t[i]);
end;
end;
BEGIN
randomize;
clrscr;
writeln('Oto program sortujacy tablice metoda sortowania przez scalanie.');
writeln;
write('Podaj, ile wierszy ma zawierac tablica (liczba wierszy musi byc mniejsza niz 100): ');
readln(wiersze);
wypelnij_tablice(tab,wiersze);
writeln('Oto tablica wypelniona losowymi liczbami:');
wyswietl_tablice(tab,wiersze);
writeln;
writeln('Teraz nastapi sortowanie.');
readln;
mergesort(tab,0,wiersze);
writeln('Oto posortowana tablica:');
wyswietl_tablice(tab,wiersze);
readln;
END.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment