Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.01.2020, 13:09   #1
APTEMKA0704
 
Регистрация: 27.01.2020
Сообщений: 4
По умолчанию Модификация алгоритмов поиска слова в тексте( Прямой поиск, КМП, БМ)

Здравствуйте. Есть код трёх видов поиска(Прямой поиск, КМП, БМ).Однако данные алгоритмы ведут поиск до первого совпадения с словом. Необходимо модифицировать алгоритмы так,чтобы выдавало позиции всех слов,которые совпадают с заданным словом,а не останавливалось на первом попавшемся.
Преподаватель сказал,что нужно добавить всего пару строчек.Прошу помочь.
Код:
//Прямой поиск
function DirectTxtSearch(Wrd:String;Txt:String;var Position: integer): boolean;
{Функция поиска слова Wrd в тексте Txt,}
{если слово найдено, то возвращает значение true}
{и позицию Position начала первого слова Wrd,}
{иначе - false и Position не изменяется}
var M,N,i,j: integer;
begin
M:=Length(Wrd);
N:=Length(Txt);
i := 0;
repeat
j := 1; i := i + 1;
{Осуществляем посимвольное сравнение}
while (j <= M) and
(Txt[i+j-1] = Wrd[j]) do j := j+1; until (j = M+1) or {Совпало все слово}
(i >= N-M+1); {Конец слова за концом текста} {Оценка результатов поиска}
if j = M+1 then begin
DirectTxtSearch := true;
Position := i; end else begin
DirectTxtSearch := false; end; end;
Код:
//КМП поиск
function KMPTxtSearch(Wrd: String ;Txt: String;var Position: integer): boolean;
{Функция поиска слова Wrd в тексте Txt,} {если слово
найдено, то возвращает значение true}
{и позицию Position начала первого слова Wrd,}
{иначе - false и Position не изменяется}
var
M,N,i,	{Индекс начала слова в тексте}
j,	{Индекс текущ.символа слова}
k,	{Индекс текущ.символа суффикса слова}
LenSuff: integer; {Длина суффикса}
Equal: boolean;  {Признак совпадения суффикса с началом}
Shift: array[1..256] of integer;{Массив смещений}
begin
M:=Length(Wrd);
N:=Length(Txt);
{Заполнение массива Shift}
Shift[1] := 1; Shift[2] := 1; {Для первых двух смещение 1}
{Вычисляем смещение для остальных M-2 символов слова} for j := 3 to M do begin
Shift[j] := 1;  {Предопределенное значение} {Перебираем все возможные длины суффиксов}
for LenSuff := 1 to j-2 do begin Equal:=true;
{Сравниваем посимвольно суффикс с началом слова} for k := 1 to LenSuff do begin if Wrd[k] <>
Wrd[j-LenSuff+k-1] then Equal:=false; end; {Если суффикс совпал, то Shift - это смещение
от начала слова до начала суффикса} if Equal then
Shift[j] := j - LenSuff - 1; end; end; {Поиск слова Wrd в тексте Txt, аналогичный прямому,
только смещение не на 1, а на переменный шаг Shift} i := 0; j := 1;  {Начальные значения} repeat
{Смещение слова}
i := i + Shift[j];
j := 1;
{Посимвольное сравнение}
while (j <= M) and
(Txt[i+j-1] = Wrd[j]) do j := j+1; until (j = M+1) or (i >= N-M+1);
{Оценка результатов поиска} if j = M+1 then begin
KMPTxtSearch := true;
Position := i; end else begin
KMPTxtSearch := false; end; end;
Код:
//БМ алгоритм
function BMTxtSearch(Wrd: String; Txt: String;var Position: integer): boolean;
{Функция поиска слова Wrd в тексте Txt,}
{если слово найдено, то возвращает значение true}
{и позицию Position начала первого слова Wrd,}
{иначе - false и Position не изменяется}
var

M,N,i,	{Индекс начала слова в тексте}
j: integer;   {Индекс текущего символа слова} ch: char;
Shift: array[#0..#$FF] of integer;   {Массив смещений}
begin
M:=Length(Wrd);
 N:=Length(Txt);
{Заполнение массива Shift}
for ch:=#0 to #$FF do Shift[ch] := M;
for j:=1 to M do Shift[Wrd[j]] := M-j;
{Поиск слова Wrd в тексте Txt}
i := 1;   {Начало слова совпадает с началом текста}
repeat
j := M+1; {Сравнивать будем с последнего символа} {Посимвольное сравнение слова, начиная с правого символа}
repeat
j := j-1;
until (j < 1) or (Wrd[j] <> Txt[i+j-1]);
if j >= 1 then
i := i + (j + Shift[Txt[i+j-1]] - M); {Сдвиг слова вправо}
until (j < 1) or (i > N-M+1); {Оценка результатов поиска}
Result:=j<1;
If Result then Position:=i;
end;
APTEMKA0704 вне форума Ответить с цитированием
Старый 27.01.2020, 13:47   #2
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

простейший вариант.
1. добавить функциям еще один параметр
ОТКУДА в тексте начинать искать (индекс элемента начала поиска).
2. модифицировать код функций чтобы использовать вновь добавленный параметр.
3. вызов данных функций в цикле с модификацией параметра "начало поиска" до тех пор пока есть что искать (до первого "неуспеха")
4. ...
программа — запись алгоритма на языке понятном транслятору
evg_m вне форума Ответить с цитированием
Старый 27.01.2020, 13:59   #3
Алексей_2012
t45t
Участник клуба
 
Аватар для Алексей_2012
 
Регистрация: 20.03.2012
Сообщений: 1,849
По умолчанию

модификация к первому алгоритму убрал параметр позиции, а результат функции - строка либо ошибка

Код:

function DirectTxtSearch(Wrd: String; Txt: String): string;
var
  M, N, i, j: integer;
  s, s1: string;
  ok:boolean;
begin
  
  ok:=false;
  
  M := Length(Wrd);
  N := Length(Txt);
  i := 0;
  s := ''; s1 := '';
  repeat
    j := 1; 
    inc(i);
    
    while (j <= M) and (Txt[i + j - 1] = Wrd[j]) do inc(j); 
        
    if j = M + 1 then  
    begin
      ok:=true;
      str(i, s);
      s1 := s1 + ' ' + s;
    end;
    
    j := 1;
    
    
  until (j = M + 1) or (i >= N - M + 1); 
    
    if ok then
  result := s1 else result:='not search "'+Wrd+'"';
  
end;





var
  s, s1: string;

begin
  
  s := 'hello world  hello k world';
  s1 := DirectTxtSearch('rld', s);
  
  writeln(s1);
  
end.

второй алгоритм

Код:

function KMPTxtSearch(Wrd: String; Txt: String): string;
var
  M, N, i,	
  j,	
  k,	
  LenSuff: integer; 
  Equal: boolean; 
  s,s1:string;
  Shift: array[1..256] of integer;
begin
  M := Length(Wrd);
  N := Length(Txt);
  Shift[1] := 1; Shift[2] := 1;
  s:='';
  s1:='';
  for j := 3 to M do
  begin
    
    Shift[j] := 1;  
    
    
    for LenSuff := 1 to j - 2 do
    begin
      
      Equal := true;
      
      for k := 1 to LenSuff do     
        if Wrd[k] <> Wrd[j - LenSuff + k - 1] then
          Equal := false; 
      
      if Equal then   Shift[j] := j - LenSuff - 1; 
    end;
  end;
  
  Equal:=false;
  
  repeat  
    inc (i , Shift[j]);
    j := 1;
    
    while (j <= M) and (Txt[i + j - 1] = Wrd[j]) do inc(j); 
     
 
 
  if j = M + 1 then 
  begin
    Equal:=true;
   str(i,s);
   s1:=s1+' '+s; 
  end;
  j:=1;
 
   until (j = M + 1) or (i >= N - M + 1);
   
   if Equal then 
result:=Trim(s1) else result:='not search!';
 
end;


var
  s: string;
begin  
  s := 'hello world  hello k world'; 
  writeln(KMPTxtSearch('rld', s));  
end.
from dark to light)

Последний раз редактировалось Алексей_2012; 27.01.2020 в 14:17.
Алексей_2012 вне форума Ответить с цитированием
Старый 27.01.2020, 15:41   #4
APTEMKA0704
 
Регистрация: 27.01.2020
Сообщений: 4
По умолчанию

Цитата:
Сообщение от Алексей_2012 Посмотреть сообщение
модификация к первому алгоритму убрал параметр позиции, а результат функции - строка либо ошибка

Код:

function DirectTxtSearch(Wrd: String; Txt: String): string;
var
  M, N, i, j: integer;
  s, s1: string;
  ok:boolean;
begin
  
  ok:=false;
  
  M := Length(Wrd);
  N := Length(Txt);
  i := 0;
  s := ''; s1 := '';
  repeat
    j := 1; 
    inc(i);
    
    while (j <= M) and (Txt[i + j - 1] = Wrd[j]) do inc(j); 
        
    if j = M + 1 then  
    begin
      ok:=true;
      str(i, s);
      s1 := s1 + ' ' + s;
    end;
    
    j := 1;
    
    
  until (j = M + 1) or (i >= N - M + 1); 
    
    if ok then
  result := s1 else result:='not search "'+Wrd+'"';
  
end;





var
  s, s1: string;

begin
  
  s := 'hello world  hello k world';
  s1 := DirectTxtSearch('rld', s);
  
  writeln(s1);
  
end.

второй алгоритм

Код:

function KMPTxtSearch(Wrd: String; Txt: String): string;
var
  M, N, i,	
  j,	
  k,	
  LenSuff: integer; 
  Equal: boolean; 
  s,s1:string;
  Shift: array[1..256] of integer;
begin
  M := Length(Wrd);
  N := Length(Txt);
  Shift[1] := 1; Shift[2] := 1;
  s:='';
  s1:='';
  for j := 3 to M do
  begin
    
    Shift[j] := 1;  
    
    
    for LenSuff := 1 to j - 2 do
    begin
      
      Equal := true;
      
      for k := 1 to LenSuff do     
        if Wrd[k] <> Wrd[j - LenSuff + k - 1] then
          Equal := false; 
      
      if Equal then   Shift[j] := j - LenSuff - 1; 
    end;
  end;
  
  Equal:=false;
  
  repeat  
    inc (i , Shift[j]);
    j := 1;
    
    while (j <= M) and (Txt[i + j - 1] = Wrd[j]) do inc(j); 
     
 
 
  if j = M + 1 then 
  begin
    Equal:=true;
   str(i,s);
   s1:=s1+' '+s; 
  end;
  j:=1;
 
   until (j = M + 1) or (i >= N - M + 1);
   
   if Equal then 
result:=Trim(s1) else result:='not search!';
 
end;


var
  s: string;
begin  
  s := 'hello world  hello k world'; 
  writeln(KMPTxtSearch('rld', s));  
end.
Да,спасибо,это то,что мне нужно! Есть соображения по поводу последнего алгоритма?
Всё,спасибо,разобрался

Последний раз редактировалось APTEMKA0704; 27.01.2020 в 16:58.
APTEMKA0704 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск слова в тексте P91 Qt и кроссплатформенное программирование С/С++ 0 07.12.2013 13:43
Поиск определённого слова в тексте lypyotr Помощь студентам 4 24.01.2012 13:45
Поиск самого короткого слова в тексте ZevS13 Общие вопросы C/C++ 3 07.06.2011 12:34
Поиск наименьшего слова в тексте Dizel!!! Общие вопросы C/C++ 3 14.04.2011 22:32
поиск слова в тексте shked1000 PHP 4 12.01.2011 13:42