Алгоритм Бойера-Мура

Алгоритмы, связанные с реализацией поиска информации.
Magok
Новичок
Новичок
 
Сообщения: 27
Зарегистрирован: 06.09.2005 (Вт) 16:59

Алгоритм Бойера-Мура

Сообщение Magok » 21.03.2008 (Пт) 18:44

Нет ли у кого алгоритма Бойера-мура (ну или ему подобных), для поиска строки в тексте?Желательно что бы в нем была возможность использования масок (регулярных выражений).
Реализация лучше всего на Visual Basic.

Matew
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 894
Зарегистрирован: 28.06.2004 (Пн) 17:44
Откуда: Дальний Восток, г. Ха

Сообщение Matew » 24.03.2008 (Пн) 4:51

Алкоголь и сканеры-ваши враги! Не верите-смотрите аватару :-)

Magok
Новичок
Новичок
 
Сообщения: 27
Зарегистрирован: 06.09.2005 (Вт) 16:59

Сообщение Magok » 24.03.2008 (Пн) 12:16

Matew, спасибо за ссылку. Но только это не совсем мне надо. На том языке, на котором я пишу всё это дело не поддерживает Microsoft VBScript Regular expressions 5.5. Он просто очень похож на бэйсик (перевести я сам смогу).

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Сообщение Хакер » 24.03.2008 (Пн) 15:41

Я не понял, ты что-ли хочешь исходник движка регэкспов?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

Magok
Новичок
Новичок
 
Сообщения: 27
Зарегистрирован: 06.09.2005 (Вт) 16:59

Сообщение Magok » 24.03.2008 (Пн) 17:34

Хакер, нет, хотя если он есть, то не откажусь :)
Вообщем, я нашёл на делфях этот алгоритм, но мне не понятны вот такие записи BMT^ (с ^) (я так понимаю, что это работа с динамической структурой, хотя может я неправельно понимаю). Дак вот, суть теперь всего вопроса: как это реализовать на VB без динамики (без ListBox и т.д).
Код: Выделить всё
function WCBeginsWith( const P, S : String) : Boolean;
var
  i, lp : Integer;
begin
  Result := False;
  lp := Length(P);
  if lp > Length(S) then Exit;
  for i := 1 to lp do
  if (P[i]<>S[i]) and (P[i]<>'?') and (S[i]<>'?') then Exit;
  Result := True;
end;
function WCFindRightmost( const S, P : String;
  l : Integer) : Integer;
var
  i, j, lp : Integer;
begin
  Result := 0;
  lp := Length(P);
  if lp > l then Exit;
  for i := l - lp + 1 downto 1 do
  for j := 1 to lp do
  if (P[j]<>S[i+j-1]) and (P[j]<>'?') and (S[i+j-1]<>'?')
  then Break
  else if j = lp then
  begin
    Result := i;
    Exit;
  end;
end;
procedure WCMakeBMTable( var BMT : PBMTable;
  const P : String);
var
  i, j, lp, MaxShift, CurShift, SufPos : Integer;
  Suffix : String;
begin
  lp := Length(P);
  GetMem(BMT, SizeOf(TIntVect)*lp);
  if P[lp] = '?' then
  for i := 0 to 255 do BMT^[lp-1][i] := 0
  else
  begin
    for i := 0 to 255 do BMT^[lp-1][i] := lp;
    for i := lp downto 1 do
    if BMT^[lp-1][Byte(P[i])] = lp then
    BMT^[lp-1][Byte(P[i])] := lp - i;
  end;
  MaxShift := lp;
  for i := lp - 1 downto 1 do
  begin
    SetLength(Suffix, lp - i);
    Move(P[i+1], Suffix[1], lp - i);
    if WCBeginsWith(Suffix, P) then MaxShift := i;
    if P[i] = '?' then for j := 0 to 255 do BMT^[i-1][j] := 0
    else for j := 0 to 255 do
    begin
      CurShift := MaxShift;
      SetLength(Suffix, lp - i + 1);
      Suffix[1] := Char(j);
      Move(P[i + 1], Suffix[2], lp - i );
      SufPos := WCFindRightmost(P, Suffix, lp - 1);
      if SufPos <> 0 then
      CurShift := i - SufPos;
      BMT^[i-1][j] := CurShift;
    end;
    BMT^[i-1][Byte(P[i])] := 0;
  end;
end;


Вернуться в Поиск

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0

    TopList