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

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

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

> Алгоритмы поиска. Помогите пожалуйста., Помогите пожалуйста.
сообщение
Сообщение #1





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

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


Помогите пожалуйста решить 2 задачки. Сидел целый день, все перечитал и всё равно не могу понять как написать. А у меня 30.12.2008 зачет и бойсь не сдать. Заранее благодарен!

У меня есть алгоритмы поиска, но я никак не могу разобратся(((

1. Дан текстовый файл, содержащий текст из слов, разделенных пробелами и знаками препинания. Предложения разделены точками. Выяснить, встречается ли где-нибудь в тексте второе предложение. Если встречается, то указать с какой позиции. Использовать алгоритм поиска «грубой силой».
2. Дан текстовый файл, содержащий текст из слов, разделенных пробелами и знаками препинания. Предложения разделены точками. Выяснить, встречается ли где-нибудь в тексте первое предложение. Если встречается, то указать с какой позиции. Использовать алгоритм поиска Рабина-Карпа.

Добавлено через 11 мин.
Алгоритмы:

Рабин-Карп

function Compare(s,p:^char; const m:integer):boolean;
var
i:integer;
s1,p1:^char;
res:boolean;
begin
s1:=s;
p1:=p;
res:=true;
for i:=1 to m do
if s1^<>p1^ then
begin
res:=false;
break;
end;
s1:=s1+1;
p1:=p1+1;
end;
compare:=res;
end;

function Hash(s:^char; m:integer):integer;
var
i,res:integer;
st:^char;
begin
res:=0;
st:=s;
for i:=1 to m do
begin
res:=res+integer(st^);
st:=st+1;
end;
hash:=res;
end;

function RabinKarpSearch(s,p:^char; const n,m:integer):integer;
var
hs,hp,res,i:integer;
s1,temp:^char;
begin
s1:=s;
res:=0;
hp:=hash(p,m);
hs:=hash(s1,m);
for i:=1 to n-m+1 do
begin
if hs=hp then
if Compare(s1,p,m) then
begin
res:=s1-s+1;
break;
end;
temp:=s1+m;
hs:=hs-integer(s1^)+integer(temp^;
s1:=s1+1;
end;
RabinKarpSearch:=res;
end;


Грубой силы
function Compare(s,p:^char; const m:integer):boolean;
var
i:integer;
s1,p1:^char;
res:boolean;
begin
s1:=s;
p1:=p;
res:=true;
for i:=1 to m do
if s1^<>p1^ then
begin
res:=false;
break;
end;
s1:=s1+1;
p1:=p1+1;
end;
compare:=res;
end;

function BruteForceSearch (s,p:^char; const n,m:integer):integer;
var
res,i:integer;
s1:^char;
begin
res:=0;
If n<m then
begin
BruteForseSearch:=res;
exit
end;
S1:=s;
for i:=1 to n-m+1 do
begin
If Compare(s1,p,m) then
begin
res:=s1-s+1;
break;
eend;
s1:=s1+1;
end;
BruteForseSearch:=res;
end;


М
Теги! (Правила, п.5)
Lapp

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





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

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


А может кто-нибудь знает как 2-ую задачу решить? smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Цитата(LECTOR @ 27.12.2008 11:15) *
А может кто-нибудь знает как 2-ую задачу решить? smile.gif
Знает smile.gif Аналогично первой:

процедуры Hash и RabinKarpSearch выглядят так:

function hash(const s: string): integer;
var i, res: integer;
begin
res := 0;
for i := 1 to length(s) do
res := res + ord(s[i]);
hash := res;
end;

function RabinKarpSearch(const sFind: string;
var f: ft; p: longint; const file_len, str_len: longint): longint;
var
start, i, hf, hs: integer;
fs: string;
ch: char;
begin
RabinKarpSearch := -1;
start := p;
if (file_len < str_len) or (p + str_len + 1 >= file_len) then exit;

seek(f, p); fs := '';
for i := 1 to str_len do begin
read(f, ch); fs := fs + ch;
end;
seek(f, p);

hf := hash(fs);
hs := hash(sFind);

for i := 1 to file_len - str_len + 1 do begin
if hs = hf then begin
if Compare(sFind, f, p, str_len) then begin
RabinKarpSearch := i + start - 1;
exit;
end;
end;

seek(f, p + str_len); read(f, ch); seek(f, p + 1);
inc(p);
hf := hf - ord(fs[1]) + ord(ch);
delete(fs, 1, 1); fs := fs + ch;
end;

end;

, а вызов - точно так же, как и в первом случае:
{ ... }
assign(f, 'my.txt'); reset(f);
sent := ''; ch := #0;
while (not eof(f)) and not (ch in EndOf_Sent) do begin
read(f, ch);
sent := sent + ch;
end;
writeln('first sentence: "', sent, '"');

reset(f);
repeat

found := RabinKarpSearch(sent, f,
filepos(f), filesize(f), length(sent));

if found >= 0 then begin
writeln('found at pos: ', found);

seek(f, found);
for i := 1 to length(sent) do begin
read(f, ch); write(ch);
end;
writeln;
end;

until found = -1;

close(f);
{ ... }
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


Цитата(volvo @ 27.12.2008 14:56) *

Знает smile.gif Аналогично первой:

процедуры Hash и RabinKarpSearch выглядят так:

function hash(const s: string): integer;
var i, res: integer;
begin
res := 0;
for i := 1 to length(s) do
res := res + ord(s[i]);
hash := res;
end;

function RabinKarpSearch(const sFind: string;
var f: ft; p: longint; const file_len, str_len: longint): longint;
var
start, i, hf, hs: integer;
fs: string;
ch: char;
begin
RabinKarpSearch := -1;
start := p;
if (file_len < str_len) or (p + str_len + 1 >= file_len) then exit;

seek(f, p); fs := '';
for i := 1 to str_len do begin
read(f, ch); fs := fs + ch;
end;
seek(f, p);

hf := hash(fs);
hs := hash(sFind);

for i := 1 to file_len - str_len + 1 do begin
if hs = hf then begin
if Compare(sFind, f, p, str_len) then begin
RabinKarpSearch := i + start - 1;
exit;
end;
end;

seek(f, p + str_len); read(f, ch); seek(f, p + 1);
inc(p);
hf := hf - ord(fs[1]) + ord(ch);
delete(fs, 1, 1); fs := fs + ch;
end;

end;

, а вызов - точно так же, как и в первом случае:
{ ... }
assign(f, 'my.txt'); reset(f);
sent := ''; ch := #0;
while (not eof(f)) and not (ch in EndOf_Sent) do begin
read(f, ch);
sent := sent + ch;
end;
writeln('first sentence: "', sent, '"');

reset(f);
repeat

found := RabinKarpSearch(sent, f,
filepos(f), filesize(f), length(sent));

if found >= 0 then begin
writeln('found at pos: ', found);

seek(f, found);
for i := 1 to length(sent) do begin
read(f, ch); write(ch);
end;
writeln;
end;

until found = -1;

close(f);
{ ... }



Спасибо огромное! good.gif

Добавлено через 11 мин.

type
ft = file of char;

function Compare(const sFind: string;
var f: ft; p: longint; const max_search: integer): boolean;
var
i: integer;
ch: char;
begin
compare := false;
for i:=1 to max_search do begin

if not eof(f) then read(f, ch) else ch := #0;

if sFind[i] <> ch then exit;
end;
compare := true;
end;

function hash(const s: string): integer;
var i, res: integer;
begin
res := 0;
for i := 1 to length(s) do
res := res + ord(s[i]);
hash := res;
end;

function RabinKarpSearch(const sFind: string;
var f: ft; p: longint; const file_len, str_len: longint): longint;
var
start, i, hf, hs: integer;
fs: string;
ch: char;
begin
RabinKarpSearch := -1;
start := p;
if (file_len < str_len) or (p + str_len + 1 >= file_len) then exit;

seek(f, p); fs := '';
for i := 1 to str_len do begin
read(f, ch); fs := fs + ch;
end;
seek(f, p);

hf := hash(fs);
hs := hash(sFind);

for i := 1 to file_len - str_len + 1 do begin
if hs = hf then begin
if Compare(sFind, f, p, str_len) then begin
RabinKarpSearch := i + start - 1;
exit;
end;
end;

seek(f, p + str_len); read(f, ch); seek(f, p + 1);
inc(p);
hf := hf - ord(fs[1]) + ord(ch);
delete(fs, 1, 1); fs := fs + ch;
end;

end;


const
EndOf_Sent = ['.', '!', '?'];
var
f: ft;
ch: char;
sent: string;
i, found: integer;

begin
assign(f, 'my.txt'); reset(f);
sent := ''; ch := #0;
while (not eof(f)) and not (ch in EndOf_Sent) do begin
read(f, ch);
sent := sent + ch;
end;
writeln('first sentence: "', sent, '"');

reset(f);
repeat

found := RabinKarpSearch(sent, f,
filepos(f), filesize(f), length(sent));

if found >= 0 then begin
writeln('found at pos: ', found);

seek(f, found);
for i := 1 to length(sent) do begin
read(f, ch); write(ch);
end;
writeln;
end;

until found = -1;

close(f);
end.

.

Все замечательно, но в конце работы программы выдаёт: Ошибка: Попытка чтения за концом файла (Рабин инет.pas, строка 57). Что-то необходимо подправить в 57 строке (забыл указать что мы проходим Паскаль на Pascal ABC).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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