Function Search (S: String; X: String; var Place: Byte): Boolean;
{ Функция возвращает результат поиска в слове S }
{ подслова X. Place - место первого вхождения }
var Res: Boolean; i: Integer;
Begin
Res:=FALSE;
i:=1;
While (i<=Length(S)-Length(X)+1) And Not(Res) do
If Copy(S,i,Length(X))=X then
begin
Res:=TRUE;
Place:=i
end
else i:=i+1;
Search:=Res
End;
Приложение 2
Реализация алгоритма Рабина
Function Search (S: String; X: String; var Place: Byte): Boolean;
{ Функция возвращает результат поиска в слове S }
{ подслова X. Place - место первого вхождения }
Var Res: Boolean; i: Byte; h,NowH,LenX:Integer; HowMany:Integer;
Begin
Res:=FALSE;
i:=1;
h:=Hash(x); {Вычисление хеш-функции для искомого слова}
NowH:=Hash(Copy(S,1,Length(x)));
HowMany:=Length(S)-Length(X)+1;
LenX:=Length(X);
While (i<=HowMany) And Not(Res) do
If (h=NowH) and (Copy(S,i,Length(X))=X) then
Begin
Res:=TRUE;
Place:=i
End
else
Begin
i:=i+1;
NextHash(s,i,NowH,LenX); {Вычисление следующего значения хеш-функции}
End;
Search:=Res
End;
Приложение 3
Алгоритм Кнута-Морриса-Пратта
Нахождение наибольшего искомого префикса.
Procedure PrefFunc(P:String; Var Fl:TMas);
Var n,i,j:Integer;
Begin
n:=Length(P);
Fl[1]:=0;
For i:=2 To n Do
Begin
j:=Fl[i-1];
While (j<>0) And (P[j]<>P[i-1]) Do j:= Fl[j];
Fl[i]:=j+1;
End;
End;
Приложение 4
Реализация алгоритма Кнута-Морриса-Пратта
Function KMPSearch(S,P:String):Integer;
{ Алгоpитм Кнута-Моpиса-Пpатта, устанавливающий }
{ вхождение непустой стpоки P в стpоку S }
Var Fl:TMas;
i,j,n,m:Integer;
Begin
n:=Length(S);
m:=Length(P);
PrefFunc(P,Fl);
j:=1;
For i:=1 To n Do
begin
While (j<>0) And (P[j]<>S[i]) do j:=Fl[j];
If j=m Then Break;
j:=j+1
end;
If (j=m) then Result:=i-j+1 Else Result:=0;
End;
Приложение 5
Алгоритм Бойера-Мура
Реализация процедуры, вычисляющая таблицу смещений для образца p.
Procedure MakeMBTable(var Bmt: TBMTable; Const p: string);
Var i: Integer;
Begin
For i:= 0 to 255 do Bmt[i]:= Length(p);
For i:= Length(p) Downto 1 Do
If Bmt[Byte(p[i])] = Length(p) Then
Bmt[Byte(p[i])]:= Length(p) – i;
End;
Приложение 6
Алгоритм Бойера-Мура
Функция, осуществляющая поиск.
function bmsearch(startpos: integer; const s, p: string;
const bmt: tbmtable: integer;)
var
pos, lp, i: integer;
begin
lp:= length(p);
pos:= startpos + lp –1;
while pos < length(s) do
if p[lp] <> s[pos] then pos:= pos + bmt[s[pos]]
else for i:= lp - 1 downto 1 do
if p[i] <> s[pos – lp + i] then
begin
inc(pos);
break;
end
else if i = 1 then
begin
result:= pos – lp + 1;
exit;
end;
result:= 0;
end;
Приложение 7
Реализация программного кода
program Poisk;
uses crt;
var
t,s,tex,t2:string; p,i,d1,d2,d3,x:integer; text:array [1..100] of string;
begin
clrscr; { }
textcolor(10);
writeln('Введите текст');
textcolor(15);
readln(t);
writeln;
textcolor(10);
writeln(‘Введите строку’);
textcolor(15);
readln(s);
writeln;
d3:=0;
repeat
textcolor(10);
p:=pos(s,t);
if p=0 then
if x>1 then
begin
writeln;
writeln('Конец поиска. Для выхода нажмите Enter.')
end
else
writeln('Такой строки в тексте не существует. Для выхода нажмите Enter.')
else
begin
tex:=tex+text[x];
d3:=length(tex);
writeln;
writeln('Образец входит в текст с ',p+d3,'-ого символа ');
writeln;
d1:=length(s);
textcolor(15);
write(tex);
for i:=1 to p-1 do
write(t[i]);
for i:=1 to d1 do
begin
textcolor(12);
write(s[i]);
end;
d2:=length(t);
for i:= d1+p to d2 do
begin
textcolor(15);
write(t[i]);
end;
readln;
x:=x+1;
text[x]:=copy(t,1,p+d1-1);
delete(t,1,p+d1-1);
end;
until p=0;
readln;
end.
Приложение 8
Фрагмент кода тестируемой программы
LoadFromFile('C:\String_250.txt');
{Происходит загрузка в массив}
Tick:=GetTickCount;
{Запоминаем текцщее значение переменной Tick}
Poisk;
{Процедура в которой происходит поиск 10000 раз}
Tick:=GetTickCount-Tick;
{Получаем разницу – время в миллисекундах}
WriteLn('Za vremja ',Tick, ' ms');
