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


Гость






Цитата
2. Дан текстовый файл, содержащий текст из слов, разделенных пробелами и знаками препинания. Предложения разделены точками. Выяснить, встречается ли где-нибудь в тексте первое предложение. Если встречается, то указать с какой позиции.
Ты слово "еще" не забыл нигде? А то при подобной постановке задачи тебе вообще никакой алгоритм не понадобится: я тебе и так скажу: да, встречается. С первой позиции... То же самое касается и первой части задания: тебе все равно надо ПРОЧЕСТЬ второе предложение из файла, так? Ну, раз ты его прочел, то естественно, что оно встречается, и позиция известна...

Или у тебя предложения для поиска задаются отдельно, а не считываются из файла? Уточняй...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Вот, набросал решение первой подзадачи (ищет методом "грубой силы" все вхождения второго предложения в файле, включая, естественно, и первое его вхождение):

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 BruteForceSearch(const sFind: string;
var f: ft; p: longint; const file_len, str_len: longint): longint;
var
i: integer;
start: longint;
begin
start := p;
if file_len < str_len then begin
BruteForceSearch := -1; exit
end;

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

BruteForceSearch := -1;
end;

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

begin
assign(f, 'my.txt'); reset(f);
ch := #0;

while (not eof(f)) and not (ch in EndOf_Sent) do read(f, ch);
while (not eof(f)) and (ch in EndOf_Sent) do read(f, ch);

sent := '';
while (not eof(f)) and not (ch in EndOf_Sent) do begin
read(f, ch);
sent := sent + ch;
end;

writeln('second sentence: "', sent, '"');

reset(f);
repeat
found := BruteForceSearch(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
{ для теста выводим length(sent) символов, начиная с найденной позиции }
read(f, ch); write(ch);
end;
writeln;
end;

until found = -1;


close(f);
end.

(алгоритм пришлось немного подкорректировать для работы с файлами). Если что непонятно - спрашивай.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


Цитата(volvo @ 25.12.2008 12:10) *

Ты слово "еще" не забыл нигде? А то при подобной постановке задачи тебе вообще никакой алгоритм не понадобится: я тебе и так скажу: да, встречается. С первой позиции... То же самое касается и первой части задания: тебе все равно надо ПРОЧЕСТЬ второе предложение из файла, так? Ну, раз ты его прочел, то естественно, что оно встречается, и позиция известна...

Или у тебя предложения для поиска задаются отдельно, а не считываются из файла? Уточняй...



Да... Действительно условие поставлено неправильно. Это препод составлял. Я думаю первое вхождение считать не надо. Надо выяснить встречается ли еще где-нибудь это приедложение.

Добавлено через 6 мин.
Цитата(volvo @ 25.12.2008 13:39) *

Вот, набросал решение первой подзадачи (ищет методом "грубой силы" все вхождения второго предложения в файле, включая, естественно, и первое его вхождение):

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 BruteForceSearch(const sFind: string;
var f: ft; p: longint; const file_len, str_len: longint): longint;
var
i: integer;
start: longint;
begin
start := p;
if file_len < str_len then begin
BruteForceSearch := -1; exit
end;

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

BruteForceSearch := -1;
end;

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

begin
assign(f, 'my.txt'); reset(f);
ch := #0;

while (not eof(f)) and not (ch in EndOf_Sent) do read(f, ch);
while (not eof(f)) and (ch in EndOf_Sent) do read(f, ch);

sent := '';
while (not eof(f)) and not (ch in EndOf_Sent) do begin
read(f, ch);
sent := sent + ch;
end;

writeln('second sentence: "', sent, '"');

reset(f);
repeat
found := BruteForceSearch(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
{ для теста выводим length(sent) символов, начиная с найденной позиции }
read(f, ch); write(ch);
end;
writeln;
end;

until found = -1;
close(f);
end.

(алгоритм пришлось немного подкорректировать для работы с файлами). Если что непонятно - спрашивай.


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





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

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


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


Гость






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





Группа: Пользователи
Сообщений: 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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






М-да, это была устаревшая версия программы... Вот эту строку добавь:

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;

if p + str_len >= file_len then break; { <--- !!! }

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





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

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


ok! Спасибо! good.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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