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

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

Форум «Всё о Паскале» _ Задачи _ Алгоритмы поиска. Помогите пожалуйста.

Автор: LECTOR 24.12.2008 22:05

Помогите пожалуйста решить 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


Автор: volvo 25.12.2008 15:10

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

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

Автор: volvo 25.12.2008 16: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.

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

Автор: LECTOR 26.12.2008 16:08

Цитата(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.

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


Спасибо большое! Работает в идеале.

Автор: LECTOR 27.12.2008 16:15

А может кто-нибудь знает как 2-ую задачу решить? smile.gif

Автор: volvo 27.12.2008 17:56

Цитата(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);
{ ... }

Автор: LECTOR 27.12.2008 19:38

Цитата(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).

Автор: volvo 27.12.2008 19:59

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

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;

Автор: LECTOR 27.12.2008 23:38

ok! Спасибо! good.gif