Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.11.2017, 05:57   #1
victor13131
Пользователь
 
Регистрация: 12.06.2017
Сообщений: 12
По умолчанию Поиск словесной информации

Помогите оформить это как процедуру

Код:
Program n10;var s,x: string;
 i,j,n,m: integer;
 f: boolean;
begin
 writeln('Введите строку s: ');
 readln(s);
 writeln('Введите строку x: ');
 readln(x);
 n:=length(s); m:=length(x);{ Определение длин строк }
 i:=0;
 f:=False;                  { Признак того, что подстрока найдена}
 repeat
 j:=1;
 while (j<=m) and (s[i+j] =x[j]) do inc(j);
 if j=m+1 then f:=true else inc(i);
 until f or (i>n-m);
 if f then writeln(x,' является подстрокой ',s,' с позиции - ',i+1)
 Else writeln(x, ' не является подстрокой ',s);
 readln;
end.

И потом совместить  с этим 

procedure boyer_moore(const str,sub: string; var result: byte);
var
  i, j, k: byte;
  sub_len: byte;
  str_len: byte;
  a: array[char] of byte;
begin
 
  sub_len := length(sub);
  str_len := length(str);
 
  if sub_len < str_len then
  begin
    for i := 0 to 255 do
      a[chr(i)] := sub_len;
    for i := 1 to sub_len - 1 do
      a[sub[i]] := sub_len - i;
 
    i := sub_len;
    j := i;
    while (j > 0) and (i <= str_len) do
    begin
      j := sub_len; k := i;
      while (j > 0) and (str[k] = sub[j]) do
      begin
        dec(k);
        dec(j);
      end;
      i := i + a[str[i]];
    end;
 
    if k > str_len - sub_len then
      result := 0
    else
      result := k + 1;
 
  end
  else
    result := 0;
end;
 
var
  str, st: string;
  x: byte;
begin
  write('Vvedite text:');
  readln(str);
  write('Vvedite iskomuyu stroku:');
  readln(st);
  boyer_moore(str,st,x);
  if x=0 then writeln('Net iskomoi stroki v texte') else
    writeln('Iskomaya stroka na posicii ',x);
  readln;
end.
И получить программу с двумя процедурами и в конце тело программы где к этим процедурам обращаюсь. Очень надо , я не знаю как это реализовать.

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 13.11.2017 в 09:55.
victor13131 вне форума Ответить с цитированием
Старый 14.11.2017, 16:36   #2
victor13131
Пользователь
 
Регистрация: 12.06.2017
Сообщений: 12
По умолчанию поиск словесной информации

Вот я совместил , но программа не выводит второй поиск , работает только первое . Что нужно исправить что бы сначала выводила прямой поиск потом бойера-мура. Строка, что мы вводим для обоих одна и таже.
Код:
Program n10;
var 
 s,x: string;
 i,j,n,m: integer;
 f: boolean;
 function primoy_poisk(s,x:string; var i:integer):integer;
 var j,m:integer;
 begin
 n:=length(s); 
 m:=length(x);{ Определение длин строк }
 i:=0;
 f:=False;                  { Признак того, что подстрока найдена}
 repeat
 j:=1;
 while (j<=m) and (s[i+j] =x[j]) do inc(j);
 if j=m+1 then f:=true else inc(i);
 until f or (i>n-m);
 end;
 procedure boyer_moore(const str,sub: string; var result: byte);
var
  st:byte;
  i, j, k: byte;
  sub_len: byte;
  str_len: byte;
  a: array[char] of byte;
begin
 
  sub_len := length(sub);
  str_len := length(str);
 
  if sub_len < str_len then
  begin
    for i := 0 to 255 do
      a[chr(i)] := sub_len;
    for i := 1 to sub_len - 1 do
      a[sub[i]] := sub_len - i;
 
    i := sub_len;
    j := i;
    while (j > 0) and (i <= str_len) do
    begin
      j := sub_len; k := i;
      while (j > 0) and (str[k] = sub[j]) do
      begin
        dec(k);
        dec(j);
      end;
      i := i + a[str[i]];
    end;
 
    if k > str_len - sub_len then
      result := 0
    else
      result := k + 1;
 
  end
  else
    result := 0;
end;
var 
str,st:string;
x1:byte;
 begin 
 writeln('Введите строку s: ');
 readln(s);
 writeln('Введите строку x: ');
 readln(x);
 i:=1;
 primoy_poisk(s,x,i);
 if f then writeln(x,' является подстрокой ',s,' с позиции - ',i+1)
 Else writeln(x, ' не является подстрокой ',s) ;
   
boyer_moore(str, st, x1); 
  if x1 = 0 then  writeln('Нет искомой строки в тексте') else 
  writeln('Искомая строка на позиции ', x1);
  
   
end.
victor13131 вне форума Ответить с цитированием
Старый 14.11.2017, 17:05   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
Сообщение от victor13131 Посмотреть сообщение
Код:
a: array[char] of byte;
...
    for i := 0 to 255 do
Цитата:
Сообщение от victor13131 Посмотреть сообщение
Строка, что мы вводим для обоих одна и таже.
позвольте поинтересоваться:
- какой у Вас Паскаль?
- какие строки подаёте на вход? Надеюсь, на английском?
Serge_Bliznykov вне форума Ответить с цитированием
Старый 14.11.2017, 17:47   #4
victor13131
Пользователь
 
Регистрация: 12.06.2017
Сообщений: 12
По умолчанию

PascalABC.NET
Да на английском
victor13131 вне форума Ответить с цитированием
Старый 14.11.2017, 18:25   #5
victor13131
Пользователь
 
Регистрация: 12.06.2017
Сообщений: 12
По умолчанию

Должна быть одна и таже
victor13131 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск и суммирование информации manula Microsoft Office Excel 6 07.05.2013 14:24
число в словесной форме (java) SLana Помощь студентам 0 17.06.2012 10:55
Поиск информации по "поиску информации" poirty Помощь студентам 3 09.04.2012 12:12
Поиск информации. VeseloffS Помощь студентам 3 29.11.2011 01:25
Поиск информации в массиве dozor Общие вопросы C/C++ 3 10.12.2009 16:18