program SORTOWANIE;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
tab=array of integer;
var
a:tab;
n,i:integer;
odp:byte;
find,nr:integer;
(*==PROCEDURY=SORTUJACE==*)
PROCEDURE babelkowe(var x:tab; size:integer);
var
i,temp:integer;
begin
i:=0;
while i<(size-1) do
begin{while1}
while i<(size-1) do
begin{while2}
if x[i]>x[i+1] then
begin temp:=x[i]; x[i]:=x[i+1]; x[i+1]:=temp; end;
i:=i+1;
end;{while2}
size:=size-1;i:=0;
end;{while1}
end;
PROCEDURE wybieranie(var x:tab; size:integer);
var
i,j,temp,min,nrmin:integer;
begin
for i:=0 to (size-2) do
begin{for1}
min:=x[i];nrmin:=i;
for j:=i+1 to (size-1) do
begin{for2}
if x[j]<min then begin nrmin:=j; min:=x[j]; end;
end;{for2}
temp:=x[i]; x[i]:=x[nrmin]; x[nrmin]:=temp;
end;{for1}
end;
PROCEDURE wstawianie(var x:tab; size:integer);
var
i,j,temp:integer;
begin
if size>1 then
begin
for i:=1 to (size-1) do
begin{for}
temp:=x[i];j:=i-1;
while (x[j]>temp)and(j>=0) do begin x[j+1]:=x[j]; j:=j-1; end;
x[j+1]:=temp;
end;{for}
end;
end;
PROCEDURE quicksort(var x:tab; l,p:integer);
var
i,j,temp,t:integer;
begin
i:=(l+p)div 2;
temp:=x[i]; x[i]:=x[p];
j:=l;
for i:=l to p-1 do
if x[i]<temp then
begin
t:=x[i]; x[i]:=x[j]; x[j]:=t;
j:=j+1;
end;
x[p]:=x[j]; x[j]:=temp;
if l<j-1 then quicksort(x,l,j-1);
if j+1<p then quicksort(x,j+1,p);
end;
(*==PROCEDURY=WYSZUKUJACE==*)
PROCEDURE liniowe(x:tab; size:integer; value:integer; var position:integer);
var
i:integer;
begin
i:=0;
while (i<size-1)and(x[i]<value) do i:=i+1;
if x[i]=value then position:=i+1 else position:=-1;
end;
PROCEDURE bisekcyjne(x:tab; size:integer; value:integer; var position:integer);
var
l,p,s:integer;
begin
l:=0;p:=size-1;
while l<p do
begin
s:=(l+p)div(2);
if value>x[s] then l:=s+1 else p:=s;
end;
if x[p]=value then position:=p+1 else position:=-1;
end;
PROCEDURE interpolacyjne(x:tab; size:integer; value:integer; var position:integer);
var
l,p,s:integer;
begin
l:=0; p:=size-1;
while (l<p)and(x[p]<>value) do
begin
s:=trunc((value-x[l])/(x[p]-x[l])*(p-l)+l);
if value>x[s] then l:=s+1 else p:=s;
end;
if x[p]=value then position:=p+1 else position:=-1;
end;
BEGIN
randomize;
write('Wpisz rozmiar tablicy: '); readln(n); setlength(a,n);
for i:=0 to (n-1) do a[i]:=random(100);
writeln('Elementy tablicy nieposortowane:');
for i:=0 to (n-1) do write(' ',a[i]:2,' ');
writeln;
writeln;writeln('1 - BABELKOWE');writeln('2 - WYBIERANIE');writeln('3 - WSTAWIANIE');writeln('4 - QUICK SORT');
repeat
begin {repeat}
write('Wybierz rodzaj sortowania: ');
read(odp);
case odp of
1:begin writeln;
writeln('Wybrano sortowanie babelkowe:'); babelkowe(a,n);
end;
2:begin writeln;
writeln('Wybrano sortowanie przez wybieranie:'); wybieranie(a,n);
end;
3:begin writeln;
writeln('Wybrano sortowanie przez wstawianie:'); wstawianie(a,n);
end;
4:begin writeln;
writeln('Wybrano metode QuickSort:'); quicksort(a,0,n-1);
end;
else writeln('Nieprawidlowa wartosc!'); end;{case}
end;{repeat} until (odp=1)OR(odp=2)or(odp=3)or(odp=4);
for i:=0 to (n-1) do write(' ',a[i]:2,' ');writeln;writeln;
writeln('1 - LINIOWE');
writeln('2 - BISEKCYJNE');
writeln('3 - INTERPOLACYJNE');
repeat
write('Wybierz metode wyszukiwania: '); readln(odp);
case odp of
1:begin
write('Podaj wartosc szukanego elementu: '); readln(find);
liniowe(a,n,find,nr);
write('Wyszukiwanie liniowe. Pozycja: ');
end;
2:begin
write('Podaj wartosc szukanego elementu: '); readln(find);
bisekcyjne(a,n,find,nr);
write('Wyszukiwanie bisekcyjne. Pozycja: ');
end;
3:begin
write('Podaj wartosc szukanego elementu: '); readln(find);
interpolacyjne(a,n,find,nr);
write('Wyszukiwanie interpolacyjne. Pozycja: ');
end;
else writeln('Nieprawidlowa wartosc!'); end;{case}
until (odp=1)OR(odp=2)or(odp=3);
if nr=-1 then writeln('BRAK') else writeln(nr);
readln;
END.
program KR;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
tablica=array of integer;
var
wz,tab:string;
d,n,m:integer;
function potega(a:integer; b:integer):integer;
var
i,c:integer;
begin
c:=a;
i:=1;
while i<b do begin
c:=c*a;
i:=i+1;
end;
potega:=c;
end;
procedure K_R(tab:string; wz:string; d:integer);
var
i,j,ht,hw:integer;
t:tablica;
begin
SetLength(t,n-m+1);
ht:=0;
hw:=0;
for i:=1 to m do begin
hw:=(d*hw+ord(wz[i]));
ht:=(d*ht+ord(tab[i]));
end;
for i:=1 to n-m do begin
if hw=ht then begin
j:=0;
while j<m do
if wz[j+1]=tab[i+j] then j:=j+1
else j:=m+1;
if j=m then writeln('wzorzec rozpocza sie na ',i,' pozycji');
end;
if i<n-m then ht:=d*(ht-ord(tab[i])*potega(d,m-1))+ord(tab[i+m]);
end;
end;
begin
wz:='kot';
tab:='Ala ma kota a kot ale.';
n:=length(tab);
m:=length(wz);
d:=256;
K_R(tab,wz,d);
readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.
program kmp;
{$APPTYPE CONSOLE}
uses
SysUtils;
Type
tablica=array of integer;
var
wz,tab:string;
i,j,n,m:integer;
P:tablica;
function max(a:integer; b:integer):integer;
begin
if a>b then max:=a
else max:=b;
end;
procedure prefix(var P:tablica; m:integer; wz:string);
var
i,k:integer;
begin
P[0]:=0;
P[1]:=0;
for i:=2 to m do
begin
k:=P[i-1];
while (k>0) and (wz[k+1]<>wz[i]) do k:=P[k];
if wz[k+1]=wz[i] then P[i]:=k+1
else P[i]:=0;
end;
end;
begin
writeln('Podaj tekst');
readln(tab);
writeln('Podaj wzorzec');
readln(wz);
n:=length(tab);
m:=length(wz);
SetLength(P,m+1);
prefix(P,m,wz);
j:=0;
i:=1;
while i<=n-m+1 do begin
j:=P[j];
while (wz[j+1]=tab[i+j]) do
j:=j+1;
if j=m then writeln('wzorzec wystapil na ',i,' pozycji');
i:=i+max(1,j-P[j]);
end;
readln;
readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.
program naiwny;
{$APPTYPE CONSOLE}
uses
SysUtils;
const
TAB = 'Turbo Pascal to bomba';
var
wz:string;
i,j,n,m:integer;
begin
writeln('pdaj wzorzec');
readln(wz);
n:=length(TAB);
m:=length(wz);
for i:=1 to (n-m) do begin
j:=0;
while j<m do
if wz[j+1]=TAB[i+j] then j:=j+1
else j:=m+1;
if j=m then writeln('wzorzec "',wz,'" wystapil na ',i,' pozycji');
end;
writeln('tekst: ',TAB);
readln;
{ TODO -oUser -cConsole Main : Insert code here }
end.