Задачка для разминки Опции

[Ivs]

Условие: Дана строка и некоторое слово. Напечатать те предложения строки, которые содержат данное слово.   :o

[mj]

Это не проверенный алгоритм написанный прям в форуме!

Предположем что str это строка, а word это искомое слово.
var писать тоже не буду, сами догадаетесь что есть что ;)

Код

str := str+'.';
while str<>'' do
begin
 p := pos('.', str);
 np := copy(str, 1, P);
 ep := np;
 delete(str, 1, p);
 fword = '';
 while ep<>'' do
 begin
   if ((ep[1]>='A'{eng}) and (ep[1]<='Z')) or ((ep[1]>='a'{eng}) and (ep[1]<='z')) or ((ep[1]>='А'{рус}) and (ep[1]<='Я')) or ((ep[1]>='а'{рус}) and (ep[1]<='я')) or (ep[1]='Ё') or (ep[1]<='ё') then
   begin
     fword := fword+ep[1];
     delete(ep, 1, 1);
   end
   else begin
     if fword<>word then
       fword := ''
     else begin
       writeln(np);
       ep = '';
     end;
   end;
 end;
end;

Кто нить проверьте его...

[Ivs]

идея конечно неплохая но к сожалению не без ошибок я её тут тебе подредактировал
вот что получилось(вроде бы работает):

Код

var
  str,np,fword,ep,word : string;
  p   : integer;

begin
  write('Введите строку -> ');
  readln(str);
  write('Введите слово -> ');
  readln(word);
  str := str+'.';
  while str<>'' do
  begin
     p := pos('.', str);
     np := copy(str, 1, P);
     ep := np;
     delete(str, 1, p);
     fword := '';
     while ep<>'' do
     begin
      if ((ep[1]>='A'{eng}) and (ep[1]<='Z')) or ((ep[1]>='a'{eng}) and (ep[1]<='z')) then
      begin
         fword := fword+ep[1];
         delete(ep, 1, 1);
      end
      else
      begin
          delete(ep,1,1);
          fword:='';
      end;
      if fword=word then
      begin
          writeln(np);
          fword := '';
      end;
      end;
 end;
 readln;
end.

[Ivs]

а вот мой способ, он не содержит стандартных паскалевских функции, здесь все делается с помощю циклов:

Код

var
  s,t,x,z:string;
  i,j:integer;
begin
  write('Введите строку -> ');
  readln(s);
  write('Введите предложение -> ');
  readln(x);
  i:=1;
  while i<=length(s) do
  begin
     t:='';
     while (s[i]<>'.') and (i<=length(s)) do
     begin
      t:=t+s[i];
      i:=i+1;
     end;
     j:=1;
     while j<=length(t) do
     begin
      z:='';
      while (t[j]<>' ') and (j<=length(t)) do
      begin
         z:=z+t[j];
         j:=j+1;
      end;
      if x=z then writeln(t);
      j:=j+1;
     end;
     i:=i+1;
  end;
  readln;
end.

в общем то это легкая задача (хотя в учебнике одна из последних) ну она и бала то для разминки......

[mj]

Я писал решение задачки прям в форуме в 3 часа ночи, отсюда и ошибки.
А ты?
Кстати твой вариант моей задачи (да и твоей тоже) не менее глючный чем мой
PS: Ты добавил кучу глюков в мою программу, которые я заметил с первого взгляда.
Например:
Предложение1: abc def ghi
Предложение2: abc defbad ghi
Искомая строка: def
Результат будет одинаковым

[Ivs]

Совершенно верно,я это знал, но больше из твоей проги мне ничего не удалось слепить, но мое то решение(2) работает правильно........

[Ivs]

Нет, все таки удалось. Там всего навсего надо заменить строчку:
if (fword=word) then
begin
  writeln(np);
   fword:='';
end;

На:  
if (fword=word) and ((ep[1]=' ') or (ep[1]='.')) then
      begin
          writeln(np);
          delete(ep,1,length(ep));
          fword := '';
      end;
И все работает нормально (пока нормально).......

[mj]

Если бы я для себя писал, я бы совсем по другому сделал. А то что мы слепили даже ****** не назовёшь...

[Ivs]

я конечно понимаю что совершенству нет предела но оно то нам тут и не надо......... ;D

[mj]

я конечно понимаю что совершенству нет предела но оно то нам тут и не надо......... ;D

Я слишком придирчив к мелким недочётам
Это наверное мой минус...