Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Алгоритм Боуера-Мура. "c" -> "pascal"

Автор: eprsteklmn 10.12.2004 0:01

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 10.12.2004 0:36

eprsteklmn
Плохо искал: http://forum.pascal.net.ru/index.php?showtopic=1507&view=findpost&p=12464 лежит полностью работоспособная версия (только что проверил...)

Автор: eprsteklmn 10.12.2004 0:52

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

Автор: eprsteklmn 10.12.2004 1:55

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

Автор: volvo 10.12.2004 2:00

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 10.12.2004 2:05

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

Автор: Dron671 17.02.2006 5:52

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

Автор: volvo 17.02.2006 5:55

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

Теория хорошо описана вот тут: http://rsdn.ru/article/alg/textsearch.xml#EDA

Автор: Dron671 17.02.2006 6:06

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

Вот ещё вопрос.
Поиск надо осуществить в файле. Ну допустим в обычном 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 17.02.2006 16:54

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

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

Автор: volvo 17.02.2006 19:45

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

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 18.02.2006 1:46

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 18.02.2006 1:57

Цитата(Dron671 @ 17.02.2006 20:46)
1. А где мы задаём образ для поиска ?

function bmSearch(start: integer;
         const s: pchar; const p: string): integer;
Параметр P это и есть образ для поиска...


Цитата(Dron671 @ 17.02.2006 20:46)
2 where: pchar; а что это ?

А это PChar - для работы с длинными строками... Теорию читать здесь:
http://forum.pascal.net.ru/index.php?s=&showtopic=2361&view=findpost&p=19856


Цитата(Dron671 @ 17.02.2006 20:46)
3. uses strings; и где мы это используем эту библиотеку ?
А вся работа с типом PChar (все процедуры и функции) реализована в модуле Strings, поэтому как только я в программе использую тип PChar, я сразу добавляю в список модулей и Strings тоже...


Цитата(Dron671 @ 17.02.2006 20:46)
А что мы тут делаем ? И куда мы чего переписываем ?

  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 19.02.2006 7:24

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

Автор: Dron671 1.03.2006 5:50

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

  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.xml#EDA

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


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



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

Автор: Dron671 2.03.2006 5:13

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

Автор: volvo 2.03.2006 5:56

Цитата
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 2.03.2006 15:55

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

Автор: volvo 2.03.2006 16:18

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

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