{giai thuat Brute-force}

uses crt;

type

st=string[255];

index=1..255;

var p,a:st;

d:char;

c:integer;

function Brutesearch(p,a:st):integer;

var i,j,m,n:integer;

begin

m:=length(p);

n:=length(a);

i:=1;

j:=1;

repeat if a[i]=p[j] then

begin

i:=i+1;j:=j+1;end

else

begin i:=i-j+2;j:=1;end

until (j>m) or (i>n);

if j>m then Brutesearch:=i-m

else Brutesearch:=0; c:=m*(n-m+1);

end;

{ begin clrscr; read(p);readln;read(a);readln;

write(brutesearch(p,a));readln;end. }

{ **************** }

{ giai thuat Knuth-morris-Pratt}

Function kmpsearch(p,a:st):integer;

var

i,j,m,n:integer;

next:array[index] of integer;

procedure initnext;

begin

i:=1;

j:=0;

next[1]:=0;

repeat

if(j=0) or (p[i]=p[j])then

begin

i:=i+1;

j:=j+1;

next[i]:=j;

end

else j:=next[j];

until i=m;c:=n+m;

end;

begin

m:=length(p);

n:=length(a);

{tao mang next}

initnext;

{bat dau tim kiem}

i:=1;

j:=1;

repeat

if (j=0) or (a[i]=p[j]) then

begin

i:=i+1;

j:=j+1;

end

else

j:=next[j];

until (j>m)or (j>n);

if j>m then kmpsearch:=i-m else kmpsearch:=0;

end;

begin

clrscr;

Write(' Nhap chuoi ban dau: ');writeln;read(a); readln;

Write(' Nhap Chuoi can tim: ');writeln;read(p);readln;

writeln(' De su dung pp tim kiem theo Brute-force an phim 1 ');

writeln(' De su dung pp tim kiem theo Knuth-morris-Prat an phim 2');

readln(d);

case d of

'1': begin write(' Vi tri tim thay chuoi : ');

writeln(Brutesearch(p,a));

writeln(' So lan so sanh lon nhat co the xay ra: ',c);

readln;

end;

'2': begin write(' Vi tri tim thay chuoi : ');

writeln(kmpsearch(p,a));

writeln(' So lan so sanh lon nhat co the xay ra: ',c);

readln;

end;

end;end.

{Thuc hien theo "chot" theo kieu Singleton thi doi voi day khoa

vi du trong bai "chot" se la khoa nao ? thuc hien sap xep theo khoa do

Theo kieu singleton thi doi voi day a[i,j] thi khoa se la a[(i+j)div 2]

Bai lam voi chot nay}

uses crt;

var a:array[1..100] of real;

doicho,i,n,k:integer;

procedure quick_sort ;

procedure sort(q,r:integer);

var i,j,t:integer;

x,y:real;

begin

i:=q;

j:=r;

x:=a[(i+j) div 2];

repeat

while a[i]<x do i:=i+1;

while a[j]>x do j:=j-1;

if i<=j then

begin

doicho:=doicho+1;

y:=a[i];

a[i]:=a[j];

a[j]:=y;

i:=i+1;

j:=j-1;

end;

writeln;

until i>j;

if q<j then sort(q,j);

if i<r then sort(i,r);

end;

begin

sort(1,n);

writeln('Day sau khi sap xep la : ');

for i:=1 to n do write(' ',a[i]:6:2);

writeln;

writeln('So lan doi cho la : ',doicho);

end;

begin

clrscr;

write('Nhap do dai cua day : ');readln(n);

writeln('Nhap vao cac so hang cua day : ');

for i:=1 to n do readln(a[i]);

doicho:=0;

clrscr;

quick_sort;

readln;

end.

{Bai 2: Thuc hien sap xep kieu hoa nhap hai duong tu nhien voi day khoa sau:

50 08 34 06 98 17 83 25 66 42 21 59 62 71 85 76

Chuong trinh Pascal nhu sau: }

Program Sap_xep;

Uses Crt;

Const n = 16;

Type item = record

key: integer;

info: integer;

End;

Var a:array[1.. 2*n] of Item;

i:integer;

Procedure Natural_Two_Way_Merge_Sort;

Var

Up:Boolean;

i,j,q,t,k:integer;

d,r:integer;

Begin

Up:=True;

Repeat

If Up then

Begin

{ Vung 1 la vung tron, vung 2 la vung phan phoi}

i:=1;j:=n;

k:= n+1;q:=2*n;

End

Else

Begin

{Vung 1 la vung phan phoi,vung 2 la vung tron}

i:=n+1;j:=2*n;

k:=1;q:=n;

End;

d:=1;

r:=0;

While i<>j do

If a[i].key>a[j].key then

Begin

{Chep run j vao run k}

a[k]:= a[j];

k:=k+d;

j:=j-1;

If a[j+1].key>a[j].key then

Begin{Het run j}

{Chep phan con lai cua run i vao run k}

Repeat

a[k]:= a[i];

k:=k+d;

i:=i+1;

Until a[i-1].key> a[i].key;

{Dem so run da phan phoi len 1}

r:=r+1;

{Doi chieu vung phan phoi}

t:=q;q:=k;k:=t;

d:=-d;

End;

End

Else

Begin

a[k]:=a[i];

k:=k+d;

i:=i+1;

if a[i-1].key> a[i].key then

Begin{Het run i}

{ Chep phan con lai cua run j vao run k}

Repeat

a[k]:=a[j];

k:=k+d;

j:=j-1;

Until a[j].key<a[j+1].key;

{Dem so run da phan phoi len1}

r:=r+1;

{Doi chieu vung phan phoi}

t:=k;k:=q;q:= t;

d:=-d;

End;

End;

{Chep phan con lai cuoi cung vao run k}

a[k]:=a[i];

r:=r+1;

{Doi vung tron va vung phan phoi}

up:=not up

Until r=1;

If not up then

{ Chep day co thu tu trong vung 2 vao vung 1}

For i:=1 to n do a[i]:=a[n+i];

Writeln(' Day sap xep tang dan:');

Writeln;

For i:=1 to n do Write(a[i].key:4);

Writeln;

Writeln(' Day sap xep giam dan:');

Writeln;

For i:= n downto 1 do Write(a[i].key:4);

End;

{----------------------------------------------}

{Chuong trinh chinh}

BEGIN

Clrscr;

Textcolor(10);

Writeln('---------------- BAI 2 ------------------');

Writeln('Cho day tu khoa: 50 08 34 06 98 17 83 25 66 42 21 59 62 71 85 76');

Writeln('Sap xep theo kieu hao nhap hai duong tu nhien:');

Writeln('Nhap du lieu');

For i:=1 to n do

Begin

Write('Nhap cac phan tu a[',i,']:');Readln(a[i].key);

End;

Writeln;

Natural_Two_Way_Merge_Sort;

Readln;END.

program sap_xep_lua_chon_don_gian_2;

uses crt;

const n=8;

type danhsach=record

key:integer;

end;

var

i:integer;

a:array[1..n]of danhsach;

Procedure Heapsort;

var q,r:integer;

x:danhsach;

procedure sift;

var

i,j:integer;

cont:boolean;

begin

i:=q;

j:=2*i;

x:=a[i];

cont:=true;

while (j<=r)and cont do

begin

if j<r then

{tim phan tu co khoa nho nhat trong 3 phan tu:a[i],a[j],a[j+1]}

if a[j+1].key<a[j].key then j:=j+1;

if x.key<=a[j].key then cont:=false

else {di chuyen phan tu thu j len vi tri thu i}

begin

a[i]:=a[j];

i:=j;

j:=2*i;

end;

end;

a[i]:=x;

end;

Begin

{tao heap ban dau}

q:=n div 2+1;

r:=n;

while q>1 do

begin

q:=q-1;

sift;

end;

{tao day co thu tu giam dan}

r:=n;

while r>1 do

begin

{doi cho a[1] voi a[r]}

x:=a[1];

a[1]:=a[r];

a[r]:=x;

r:=r-1;

{tao a[1]...a[r] la mot heap}

sift;

end;

{tao day co thu tu tang dan}

for r:=1 to n div 2 do

begin

x:=a[r];

a[r]:=a[n-r+1];

a[n-r+1]:=x;

end;

End;

BEGIN

clrscr;

write('nhap danh sach:');

for i:=1 to n do readln(a[i].key);

Heapsort;

write('danh sach da sap xep co khoa nhu sau:');

for i:=1 to n do write(a[i].key:5);

Readln;

END.