Алгоритм Боуера-Мура. "c" -> "pascal" Опции

[eprsteklmn]

SOS Народ!! дайте пожалуйста у кого естя Алгоритм Боуера-Мура НА ПАСКАЛЕ!!!
Я в инете находил... но они все не работают (2).... ...(а у меня осталось всего три дня!!!!)
Или переведите вот с языка СИ на Паскаль:) с комментариями, если можно, пожалуйста!!!
:thanks:

/* Preprocessing of the Bad Character function shift */
PRE_BC( char *x, int m, int bm_bc[] ) {
   int a, j; 
   
   for ( a=0; a < ASIZE; a++ ) bm_bc[ a ] = m; 
   for ( j=0; j < m-1;  j++ ) bm_bc[ (unsigned char)x[ j ] ] = m - j - 1; 
  }
 
 /* Preprocessing of the Good Suffix function shift  */
 PRE_GS( char *x, int m,  int bm_gs[] ) {
   int i, j, p, f[XSIZE];
   
   memset( bm_gs, 0, ( m + 1 ) * sizeof( int ) );
   f[ m ] = j = m + 1; 
   for (i=m; i > 0; i-- ) {
	  while ( j <= m && x[ i - 1 ] != x[ j - 1 ] ) {
		if ( bm_gs[ j ] == 0 ) bm_gs[ j ] = j - i;
	   j = f[ j ];
	 }
	 f[ i - 1 ] = --j; 
   }
   p=f[ 0 ]; 
   for ( j=0; j <= m; ++j ) {
	  if ( bm_gs[ j ] == 0 ) bm_gs[ j ] = p; 
	 if ( j == p ) p = f[ p ]; 
   }
}

/* Boyer-Moore string matching algorithm */
void BM( char *x, char *y, int n, int m ) {
  int i, j, bm_gs[XSIZE], bm_bc[ASIZE];
  
  /* Preprocessing */
  PRE_GS( x, m, bm_gs ); 
  PRE_BC( x, m, bm_bc );
  i=0; 
  while ( i <= n-m ) {
	 for ( j=m-1; j >= 0 && x[j] == y[ i+j ];  --j ); 
	if ( j < 0 ) {
	   OUTPUT(i); 
	  i += bm_gs[ j+1 ]; 
	}
	else i += MAX(( bm_gs[ j+1 ]), ( bm_bc[ (unsigned char)y[ i+j ] ] - m + j + 1 ) ); 
   }	
}

Заранее спасибо!

[volvo]

eprsteklmn
Плохо искал: Здесь лежит полностью работоспособная версия (только что проверил...)

[eprsteklmn]

volvo
ПОльзовался я Поиском!!.... он как то неправильно простто ищет....
"или это просто неправильный мед" :thanks: Спасибо я Спасен!!!

[eprsteklmn]

volvo
А можно для меня-как глупого и неопытного еще и начало с концом прописать...??? Пожлста!!!!!!

[volvo]

eprsteklmn

Я оставил {result}, т.к. не имею понятия, для какой это среды. Если Дельфи - оставь Result, если ТР - оставь имя функции, как сейчас...

function BMSearch(StartPos: Integer; const S, P: String): Integer;
type
TBMTable = array[0..255] of Integer;
var
Pos, lp, i: Integer;
BMT: TBMTable;
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;

lp := Length(P);
Pos := StartPos + lp -1;
while Pos <= Length(S) do
if P[lp] <> S[Pos] then Pos := Pos + BMT[Byte(S[Pos])] else
if lp = 1 then begin bmsearch{Result} := Pos; Exit; end 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}bmsearch := Pos - lp + 1;
           Exit;
            end;
            {Result}bmsearch := 0;

            end;

var i: integer;
begin
  i := bmsearch(1, 'this is a very long string to find the word in', 'is')
end.

[eprsteklmn]

volvo
Пасиба...теперь все пучком!!!

[Dron671]

Посмотрел программку. И и не понял.
Можете немного прокометировать строки программы.

[volvo]

Что тут комментировать?

Теория хорошо описана вот тут: Алгоритм грубой силы и простой вариант алгоритма Бойера-Мура.

[Dron671]

Хех.
Как быстро. Описание подробнее не куда.

Вот ещё вопрос.
Поиск надо осуществить в файле. Ну допустим в обычном TXT. C английским текстом. (700 символов). Образ до 10 символов.

Наверное проще будет скопировать файлик в массив of char , а потом уже искать в массиве ?
Как бы проще скопировать ? Если можно сразу текстом программы.

Вот нашёл ещё один вариант программы.

Program BM;
const
		Mmax = 100; Nmax = 10000;
var
		i, j, k, M, N: integer;
		ch: char;
		p: array[0..Mmax-1] of char; {слово}
		s: array[0..Nmax-1] of char; {текст}
		d: array[' '..'z'] of integer;
begin
{Ввод текста s и слова p}
Write('N:'); Readln(N);
Write('s:'); Readln(s);
Write('M:'); Readln(M);
Write('p:'); Readln(p);
{Заполнение массива d}
for ch:=' ' to 'z' do d[ch]:=M;
for j:=0 to M-2 do d[p[j]]:=M-j-1;
{Поиск слова p в тексте s}
i:=M;
repeat
		  j:=M; k:=i;
		  repeat {Цикл сравнения символов }
					 k:=k-1; j:=j-1; {слова, начиная с правого.}
		  until (j<0) or (p[j]<>s[k]); {Выход, если сравнили все}
		  {слово или несовпадение. }
		  i:=i+d[s[i-1]]; {Сдвиг слова вправо }
until (j<0) or (i>N);
{Вывод результата поиска}
if j<0 then Writeln('Yes') {найден }
else Writeln('No'); {не найден}
Readln;
end.

Извиняюсь за наглость, но может кто ни-будь сразу внесёт изменения в программу
Что бы она искала в файле. (типа файл F.txt в корне диска)

И что бы в результате получать сразу все позиции в которых найден образ.
К примеру.
Совпадение с 25 символа, совпадение с 500-го символа и.т.д.

Сообщение отредактировано: volvo - 8.11.2009 13:01

[volvo]

Dron671, я конечно тоже извиняюсь, но я попробовал прогнать твою программу на нескольких тестах... Не находит она никаких совпадений, даже если они там есть...

Чуть позже попробую пошаманить над своим вариантом, чтобы он читал данные из файла...

[volvo]

Вот то, что я нашаманил:

uses strings;
type
  arrType = array[0 .. 10000] of char;

function bmSearch(start: integer;
         const s: pchar; const p: string): integer;
type
  TbmTable = array[0 .. 255] of integer;
var
  Pos, lp, i: integer;
  bmT: TbmTable;
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;

  lp := length(p);
  Pos := start + lp - 1;
  while Pos <= strlen(s) do
    if p[lp] <> s[Pos] then Pos := Pos + bmT[Byte(s[Pos])]
    else
      if lp = 1 then begin
        bmSearch := Pos; Exit
      end
      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
              bmSearch := Pos - lp + 1; Exit
            end;
  bmSearch := 0
end;

var
  f: file;
  s: arrType;
  n, next: integer;

  where: pchar;
begin
  assign(f, 'c:\f.txt'); reset(f, 1);
  n := filesize(f);

  getmem(where, succ(n));
  blockread(f, where[1], n);
  close(f);

  next := 0;
  repeat
    next := bmSearch(next + 1, where, 'th');
    if next <> 0 then begin
      writeln( 'position found: ', next );
    end;
  until next = 0;
  freemem(where, succ(n));
end.

[Dron671]

volvo, Интересно получилось.
Но больше пытаюсь понять, тем больше вопросов.

1. А где мы задаём образ для поиска ?
2 where: pchar; а что это ?
3. uses strings; и где мы это используем эту библиотеку ?

  assign(f, 'c:\f.txt'); reset(f, 1);
  n := filesize(f);

  getmem(where, succ(n));
  blockread(f, where[1], n);
  close(f);

А что мы тут делаем ? И куда мы чего переписываем ?

[volvo]

1. А где мы задаём образ для поиска ?

function bmSearch(start: integer;
         const s: pchar; const p: string): integer;

Параметр P это и есть образ для поиска...

2 where: pchar; а что это ?

А это PChar - для работы с длинными строками... Теорию читать здесь:
FAQ: Строки. Краткая теория

3. uses strings; и где мы это используем эту библиотеку ?

А вся работа с типом PChar (все процедуры и функции) реализована в модуле Strings, поэтому как только я в программе использую тип PChar, я сразу добавляю в список модулей и Strings тоже...

А что мы тут делаем ? И куда мы чего переписываем ?

  assign(f, 'c:\f.txt'); reset(f, 1);
  { размер файла - именно столько символов нужно для хранения строки }
  n := filesize(f);

  {
    тут запрашиваем динамическую память, достаточную для
    хранения строки + 1 символ - завершающий #0
  }
  getmem(where, succ(n));

  {
    Читаем блок даннях из файла (для доп. информации - TP Help) длиной N символов,
    то есть все содержимое файла в выделенную память начиная с первой позиции
  }
  blockread(f, where[1], n);

  { закрываем файл, он нам больше не нужен... }
  close(f);

[Dron671]

volvo, Спасибо большое. Всё работает.

[Dron671]

Кажись не всё понятно. Точнее опят туплю.

  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;

Здесь мы создаём таблицу смешений.
А что такое Byte(p[i]) ??
И почему мы всё сравниваем с длинной образа?

И вот вопрос по факу.
Алгоритм грубой силы и простой вариант алгоритма Бойера-Мура.

Таблица
http://rsdn.ru/article/alg/textsearch/image001.gif


http://rsdn.ru/article/alg/textsearch/image003.gif
Три символа образца совпали, а четвертый – нет. Сдвигаем образец вправо на одну позицию:

Почему на одну позицию ? На что сморим при сдвиге ?

Сообщение отредактировано: volvo - 2.11.2006 17:08

[Dron671]

ну кто ни-будь !
Byte(p[i]) что это такое ?

[volvo]

Byte(p[i]) что это такое ?

Ну что ты, про приведение типов (typecast) никогда не слышал? Тебе же Паскаль просто не позволит обращаться к массиву через индекс типа Char, а вдруг ошибка? Тип массива bmT как определен?

type
  TbmTable = array[0 .. 255] of integer; { индексы - целые (!!!) числа 0 .. 255 }

а не так:

type
  TbmTable = array[#0 .. #255] of integer; { Вот этот массив можно было бы индексировать символами }

А ты должен "убедить" компилятор, что ты действительно хочешь произвести подобную операцию, для этого ты заставляешь компилер рассматривать содержимое P[i] НЕ как Char, а как Byte.

[Dron671]

А что получается из этого bmT[Byte(p[i])] ?
Код ASCII ?

[volvo]

Byte(p[i]) = Ord(p[i])...

Кодом Ascii ты НЕ МОЖЕШЬ индексировать массив bmT... Ты ответы ЧИТАЙ, а не просто бегло просматривай. Второй раз на одни и те же вопросы я НЕ отвечаю... Учи Паскаль...