IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Алгоритм Боуера-Мура. "c" -> "pascal"
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  0  +


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 ) );
}
}



Заранее спасибо!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






eprsteklmn
Плохо искал: Здесь лежит полностью работоспособная версия (только что проверил...)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  0  +


volvo
ПОльзовался я Поиском!!.... он как то неправильно простто ищет....
"или это просто неправильный мед" :thanks: Спасибо я Спасен!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  0  +


volvo
А можно для меня-как глупого и неопытного еще и начало с концом прописать...smile.gif??? Пожлста!!!!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






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.

 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 13
Пол: Мужской

Репутация: -  0  +


volvo
Пасиба...теперь все пучком!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


Посмотрел программку. И и не понял.
Можете немного прокометировать строки программы.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






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

Теория хорошо описана вот тут: Алгоритм грубой силы и простой вариант алгоритма Бойера-Мура.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


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

Вот ещё вопрос.
Поиск надо осуществить в файле. Ну допустим в обычном 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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

Чуть позже попробую пошаманить над своим вариантом, чтобы он читал данные из файла...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Гость






Вот то, что я нашаманил:
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


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);

А что мы тут делаем ? И куда мы чего переписываем ?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






Цитата(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 - для работы с длинными строками... Теорию читать здесь:
FAQ: Строки. Краткая теория


Цитата(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);
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


volvo, Спасибо большое. Всё работает.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


Кажись не всё понятно. Точнее опят туплю.
  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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


ну кто ни-будь !
Byte(p[i]) что это такое ?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






Цитата
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской

Репутация: -  0  +


А что получается из этого bmT[Byte(p[i])] ?
Код ASCII ?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






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

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

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 24.09.2020 2:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name