Полная версия: задача на множества
Дан текст, который состоит из слов, между которыми стоит промежуток. Напечатать те слова, в которых отсутствуют буквы первого слова.
Уже можно выполнять ? 
Не пробовал поиском воспользоваться и в FAQ заглянуть ?
Не пробовал поиском воспользоваться и в FAQ заглянуть ?
Попробовал поиском, подобных задач не нашёл.
FAQ тоже не помог. Кроме теории и задачи на выборку другого не увидел.
FAQ тоже не помог. Кроме теории и задачи на выборку другого не увидел.
разбиение на слова тоже не нашел? :-/
пользуйся, я свою переделал под твои нужды =)
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.
Задние вниматльно прочитал ? Если да, программу свою запускал ? Она выдает полную чушь.
Цитата(правила форума)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
фу, там чуть не доделано-то. если оч надо переделает, если нет, то плохо надо
Доделать и исправить чужие ошибки - это разные вещи, тебе не кажется ?
найди 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.
Код
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.
Ты издеваешсяь ?
Задачу решил через множества, но у неё есть небольшой недостаток: буквы слов, в которых отсутствуют буквы первого слова выводит в алфавитном порядке. Подскажите, если кто знает как это обойти, или как их вывести другим способом (в моём случае).
Вот программа:
Вот программа:
Код
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.
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.
а чего еще ждать, если ты делаешь:
естественно, она смотрит: есть а? ага, выводим. b? нет, не будем выводить...
for f:=ord('a') to ord('z') do
?естественно, она смотрит: есть а? ага, выводим. b? нет, не будем выводить...
Ой, я задание не так понял, извините. Я думал вывести слова без первой буквы.
Вот этот кусок (вывод на печать) убери:
а перед строчкой:
j:=y+1;
вставь вот такую строку:
WriteLn(Copy(s,j,y-j));
Тогда печать будет правильной. Но твоя прога все равно не совсем верно работает. Если в конце нет пробела, она не напечатает последнее слово..
И еще, если два или больше пробела подряд, то она будет думать, что между ними пустые слова и выводить их..
Сможешь исправить?
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 @ 16.11.2006 22:23) 
А зачем исправлять ? В условии четко написано, что есть текст, он состоит из слов, между которыми стоит промежуток в виде пробела. Я написал программу только для единичного случая. Если в условии все эти ньюансы не оговариваются, то зачем лезть дальше...
Я упомянул про множественные пробелы дополнительно. Основное - это то, что последнее слово не выводится, если в конце нет пробела. Поскольку пробел в конце не разделяет слова, то его наличие не обязательно по условию. Так что как ни крутись, а это ошибка. Я говорил именно про нее.
Сможешь исправить?
Самое простое что я могу предложить - так это добавить пробел к строке: s:=s+' '
Но буду рад выслушать твои варианты.
Но буду рад выслушать твои варианты.
Цитата(DruiD @ 17.11.2006 20:36)
Самое простое что я могу предложить - так это добавить пробел к строке: 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 @ 18.11.2006 15:02)
Но могу себя утешить, что ты не мой препод.
Намек понял
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.