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

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

Форум «Всё о Паскале» _ Задачи _ строки

Автор: marwell 3.04.2010 21:22

Найти множество всех слов, которые встречаются в каждом из двух заданных предложений. вот что получилось

 var s1,s2,str:string;
    i,x:integer;
begin
  write ('vvedite predlozenie 1: ');
  readln (s1);
  write ('vvedite predlozenie 2: ');
  readln (s2);
  x:=1;
  for i:=1 to Length(s1) do
   if s1[i]=' ' then
                    begin
                    str:=copy(s1,x,i-1);
                    if pos(str,s2)<>0 then writeln (str);
                    end;
                    x:=i+1;
  readln;
end.
но верно работает только если нужное слово стоит в начале первого предложения. не могу понять в чем ошибка((

Автор: marwell 3.04.2010 22:06

ааа, я забыл очищать str от предыдущего слова! и еще программа не рассматривает последнее слово, если после него нет пробела

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

  var s1,s2,str:string;
    i,x:integer;
begin
  write ('vvedite predlozenie 1: ');
  readln (s1);
  write ('vvedite predlozenie 2: ');
  readln (s2);
  x:=0;
  for i:=1 to Length(s1) do begin
   if s1[i]=' ' then
                    begin
                    str:=copy(s1,x+1,i-x);
                    if pos(str,s2)<>0 then begin writeln (str);
                    x:=i;
                    Delete(str,1,i-x);
                    end;
                    end;
    if s1[i]='.' then begin str:=copy(s1,x+1,i-x);
                      if pos(str,s2)<>0 then writeln (str);
                      end;
                      end;

  readln;
end.
но все равно не помогло((

Автор: Client 3.04.2010 22:30

Цитата
забыл очищать str
Нет сысла, ты ведь все равно новое значение присваиваешь.
uses crt;

var s1,s2,str:string;
    i,x:integer;
begin

  write ('vvedite predlozenie 1: ');
  readln (s1);
  write ('vvedite predlozenie 2: ');
  readln (s2);
  while pos('  ',s1) > 0 do delete(s1,pos('  ',s1),1); //вдруг 2 пробела подряд
  if s1[length(s1)]<>' ' then s1:=s1+' '; //добавление в конец пробела

  while pos(' ',s1) > 0 do begin
     str:=copy(s1,1,pos(' ',s1)-1);
     if pos(str,s2) >0 then writeln(str);
     delete(s1,1,pos(' ',s1))
  end;

  readln;
end.

Автор: marwell 3.04.2010 22:33

Цитата(Client @ 3.04.2010 18:30) *

Нет сысла, ты ведь все равно новое значение присваиваешь.
uses crt;

var s1,s2,str:string;
    i,x:integer;
begin

  write ('vvedite predlozenie 1: ');
  readln (s1);
  write ('vvedite predlozenie 2: ');
  readln (s2);
  while pos('  ',s1) > 0 do delete(s1,pos('  ',s1),1); //вдруг 2 пробела подряд
  if s1[length(s1)]<>' ' then s1:=s1+' '; //добавление в конец пробела

  while pos(' ',s1) > 0 do begin
     str:=copy(s1,1,pos(' ',s1)-1);
     if pos(str,s2) >0 then writeln(str);
     delete(s1,1,pos(' ',s1))
  end;

  readln;
end.


спасибо! good.gif