задача на множества, вывести слова, в которых нет букв первого слова Опции

[DruiD]

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

[klem4]

Уже можно выполнять ?

Не пробовал поиском воспользоваться и в FAQ заглянуть ?

[DruiD]

Попробовал поиском, подобных задач не нашёл.
FAQ тоже не помог. Кроме теории и задачи на выборку другого не увидел.

[мисс_граффити]

разбиение на слова тоже не нашел? :-/

[InviZible]

пользуйся, я свою переделал под твои нужды =)

program lr4_19; { **** Father of Pascal **** }
uses crt;
var
 bukvi:set of char;
 f:text;
 slovo,c,s,possl:string;
 pslovo,i,k,j:integer;
 massl:array[1..100] of string;
begin
 clrscr;
 assign(f,'E:/tp7/bin/test/text.txt');
 reset(f);
 bukvi:=['A'..'Z','a'..'z'];
 j:=1;
 writeln('====Text=====================');
 while not eof(f) do
  begin
   readln(f,s);
   writeln(s);
   i:=1;
   while (i <=length(s)) do
    begin
     pslovo:=0;
     if not (s[i] in bukvi) then inc(i);
     slovo:='';
     while (i <=length(s)) and (s[i] in bukvi ) do
      begin
       pslovo:=1;
       slovo:=slovo+s[i];
       inc(i);
      end;
     if pslovo=1 then
      begin
       massl[j]:=slovo;
       inc(j);
      end;
    end;
  end;
 writeln('=============================');
 for i:=1 to j-1 do
  write(massl[i],' ');
  writeln;

 writeln('****last word****************');
 possl:=massl[j-1];
 writeln(possl);
 writeln('*****************************');

 for i:=1 to j do
  begin
   slovo:=massl[i];
   c:=slovo[1];
   delete(slovo,1,1);
   massl[i]:=slovo;
   writeln(slovo);

  end;
{ writeln(possl); esli nujno pechatat' possl }

 close(f);
 readln;
end.

[klem4]

Задние вниматльно прочитал ? Если да, программу свою запускал ? Она выдает полную чушь.

7. Проверяйте программы перед тем, как разместить их на форуме!!!

[InviZible]

фу, там чуть не доделано-то. если оч надо переделает, если нет, то плохо надо

[klem4]

Доделать и исправить чужие ошибки - это разные вещи, тебе не кажется ?

[InviZible]

найди 3 отличия (подсказка: вырезанных)

Код

program lr4_19; { **** Father of Pascal **** }
uses crt;
var
bukvi:set of char;
f:text;
slovo,c,s,possl:string;
pslovo,i,k,j:integer;
massl:array[1..100] of string;
begin
clrscr;
assign(f,'E:/tp7/bin/test/text.txt');
reset(f);
bukvi:=['A'..'Z','a'..'z'];
j:=1;
writeln('====Text=====================');
while not eof(f) do
  begin
   readln(f,s);
   writeln(s);
   i:=1;
   while (i <=length(s)) do
    begin
     pslovo:=0;
     if not (s[i] in bukvi) then inc(i);
     slovo:='';
     while (i <=length(s)) and (s[i] in bukvi ) do
      begin
       pslovo:=1;
       slovo:=slovo+s[i];
       inc(i);
      end;
     if pslovo=1 then
      begin
       massl[j]:=slovo;
       inc(j);
      end;
    end;
  end;
writeln('=============================');
writeln;
for i:=1 to j do
  begin
   slovo:=massl[i];
   c:=slovo[1];
   delete(slovo,1,1);
   massl[i]:=slovo;
   write(slovo,' ');

  end;

close(f);
readln;
end.

[klem4]

Ты издеваешсяь ?

[DruiD]

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

Код

program smartlytaken;
var s:string; D,mn1:set of char;
    f,p,j,y,i: byte;
begin
writeln ('vvedite stroku s');
readln (s);
D:=[];
i:=1;
while S[i]<>' ' do
      begin
      include (D,S[i]);
      i:=i+1;
      end;
j:=i+1;
for y:=i+1 to length(s) do
if s[y]=' ' then
  begin
  mn1:=[];
  for p:=j to y-1 do
  include (mn1,s[p]);
  j:=y+1;
  if D*mn1=[] then
   for f:=ord('a') to ord('z') do
   if chr(f) in mn1 then write(chr(f));
   writeln;
  end;
readln
end.

[мисс_граффити]

а чего еще ждать, если ты делаешь:

for f:=ord('a') to ord('z') do

?
естественно, она смотрит: есть а? ага, выводим. b? нет, не будем выводить...

[InviZible]

Ой, я задание не так понял, извините. Я думал вывести слова без первой буквы.

[Lapp]

Вот этот кусок (вывод на печать) убери:

  if D*mn1=[] then
   for f:=ord('a') to ord('z') do
   if chr(f) in mn1 then write(chr(f));
   writeln;

а перед строчкой:

j:=y+1;

вставь вот такую строку:

WriteLn(Copy(s,j,y-j));

Тогда печать будет правильной. Но твоя прога все равно не совсем верно работает. Если в конце нет пробела, она не напечатает последнее слово.. И еще, если два или больше пробела подряд, то она будет думать, что между ними пустые слова и выводить их..
Сможешь исправить?

[DruiD]

А зачем исправлять ? В условии четко написано, что есть текст, он состоит из слов, между которыми стоит промежуток в виде пробела. Я написал программу только для единичного случая. Если в условии все эти ньюансы не оговариваются, то зачем лезть дальше...

[Lapp]

А зачем исправлять ? В условии четко написано, что есть текст, он состоит из слов, между которыми стоит промежуток в виде пробела. Я написал программу только для единичного случая. Если в условии все эти ньюансы не оговариваются, то зачем лезть дальше...

Я упомянул про множественные пробелы дополнительно. Основное - это то, что последнее слово не выводится, если в конце нет пробела. Поскольку пробел в конце не разделяет слова, то его наличие не обязательно по условию. Так что как ни крутись, а это ошибка. Я говорил именно про нее.
Сможешь исправить?

[DruiD]

Самое простое что я могу предложить - так это добавить пробел к строке: s:=s+' '
Но буду рад выслушать твои варианты.

[Lapp]

Самое простое что я могу предложить - так это добавить пробел к строке: s:=s+' '
Но буду рад выслушать твои варианты.

Может быть это и самое простое (хотя я бы советовал добавлять пробел только в случае, когда его там нет, чтобы избежать вывода пустого слова между пробелами: if s[Length(s)]<>' ' then s:=s+' ' ), но есть одно маленькое "но" - программа все еще будет работать неправильно, если исходная строка s заполнена до конца, то есть имеет длину 255 символов. Я понимаю, что это достаточно редкий случай, но на месте твоего препа я бы не поленился и специально ввел бы строку именно такой длины на приеме задания..

Мой вариант: удлинни цикл на единицу и введи проверку на конец строки перед проверкой на пробел. То есть так:

  for y:=i+1 to length(s)+1 do
  if (y>Length(s))or(s[y]=' ') then

Согласен?

[DruiD]

Да согласен, хотя случай редкий. Но могу себя утешить, что ты не мой препод.

[Lapp]

Но могу себя утешить, что ты не мой препод.

Намек понял