Дана последовательность, содержащая от 2 до 50 слов, в каждом из которых от 1 до 8 строчных латинских букв; между соседними словами – запятая или не менее одного пробела, за последним словом - точка.
Напечатать те слова последовательности, которые отличны от последнего слова и
удовлетворяют следующему свойству:
- в слове гласные чередуются с согласными;
Напечатать те слова последовательности, которые отличны от последнего слова,
предварительно преобразовав каждое из них по следующему правилу:
- если слово нечетной длины, то удалить его среднюю букву.
напишите плиз
Полная версия: множества
Цитата(Sqrin @ 11.05.05 0:05)
напишите плиз
Помочь - пожалуйста, но писАть полностью :no:
Хоть что-нибудь уже начато?
Для начала можно прочитать здесь: FAQ: Множества, чтобы иметь представление о том, с чем придется иметь дело...
ето понятно ... вот тока определение согласные или не согласные ?
сделать отдельный блок данных с забитыми гласными и проверять? что не соглас то гласные ? или как лучше оформиь?
сделать отдельный блок данных с забитыми гласными и проверять? что не соглас то гласные ? или как лучше оформиь?
const
glas = ['a', 'e', 'i']; { и так далее }
soglas = ['a' .. 'z'] - glas;
как задатьмножество я понимаю
а вот....
Напечатать те слова последовательности, которые отличны от последнего слова и
удовлетворяют следующему свойству:
- в слове гласные чередуются с согласными;
Напечатать те слова последовательности, которые отличны от последнего слова,
предварительно преобразовав каждое из них по следующему правилу:
- если слово нечетной длины, то удалить его среднюю букву
сам алгоритм првореки не могу накатать
а вот....
Напечатать те слова последовательности, которые отличны от последнего слова и
удовлетворяют следующему свойству:
- в слове гласные чередуются с согласными;
Напечатать те слова последовательности, которые отличны от последнего слова,
предварительно преобразовав каждое из них по следующему правилу:
- если слово нечетной длины, то удалить его среднюю букву
сам алгоритм првореки не могу накатать
Цитата(Sqrin @ 15.06.05 9:19)
Напечатать те слова последовательности, которые отличны от последнего слова
Ну, для этого допустим надо разбивать строку на слова, это тоже уже было: FAQ: Строки
А потом вот так:
Count := GetWords(s, arr, []);
for i := 1 to pred(Count) do
If (arr[i] <> arr[Count]) and ({ здесь проверяй чередование })
then writeln(arr[i]);
Цитата(Sqrin @ 15.06.05 9:19)
если слово нечетной длины, то удалить его среднюю букву
Элементарно:If odd(length(s)) then delete(s, succ(length(s) div 2), 1);
о елки .. оболдеть... что то я запутолся...
ксати насчет katrin это девушка из соседнией группы....
Readln(Stroka);
ето вроде начало... как терь сюда прикрипить
разбиение строки по словам?
ксати насчет katrin это девушка из соседнией группы....
Program GlasSogas_lol;
Uses crt;
Const
n = 50;
Sogl : set of char = [,'Ь','Ъ','б','в','г', 'д','ж','з','й','к','л','м','н','п','р','с','т','ф',
'х','ц','ч','ш','щ','ь','ъ'];
Glas : set of char = ['а','е','и','о', 'у','ы','э','ю','я'];
Var
S, S_Glas, S_Sogl : string[n];
I : integer;
Begin
ClrScr;
Write('Введите строку (50 символов): ');
Readln(Stroka);
ето вроде начало... как терь сюда прикрипить
разбиение строки по словам?
1. не 50 символов в строке, а 50 слов. Поставь просто string.
2. создай wrds : array [1..50] of string[8];
3. загоняй слова в массив. Перебирай все символы(при этом wrds[j]:=wrds[j]+Stroka[i], i - счётчик цикла, j - счётчик слов), если символ не в множестве гласных и не в множестве согласных, значит разделитель(j++ :D ).
добавлено:
Начало должно выглядеть так
Uses crt;
Const
Glas = ['A','E','I','O','U','Y'];
Sogl = ['A'..'Z'] - Glas;
Var
S : string;
words : array [1..50] of string[8];
I,j : integer;
old : char;
Begin
ClrScr;
Write('Введите строку : ');
Readln(S);
old := ' '; {Тута пробел}
j := 1; {Первое слово}
For i := 1 to length(S) do {Сканируем строку}
Begin
if UpCase(S[i]) in Sogl + Glas then words[j] := words[j] + S[i]{если буква, добавляем к текущему слову}
else if UpCase(old) in Sogl + Glas then Inc(j);{Если не буква, а предыдущий символ - буква, увеличиваем номер слова}
old := S[i]; {Сохраняем символ, на следующем шаге он станет предыдущим}
End;
2. создай wrds : array [1..50] of string[8];
3. загоняй слова в массив. Перебирай все символы(при этом wrds[j]:=wrds[j]+Stroka[i], i - счётчик цикла, j - счётчик слов), если символ не в множестве гласных и не в множестве согласных, значит разделитель(j++ :D ).
добавлено:
Начало должно выглядеть так
Код
Uses crt;
Const
Glas = ['A','E','I','O','U','Y'];
Sogl = ['A'..'Z'] - Glas;
Var
S : string;
words : array [1..50] of string[8];
I,j : integer;
old : char;
Begin
ClrScr;
Write('Введите строку : ');
Readln(S);
old := ' '; {Тута пробел}
j := 1; {Первое слово}
For i := 1 to length(S) do {Сканируем строку}
Begin
if UpCase(S[i]) in Sogl + Glas then words[j] := words[j] + S[i]{если буква, добавляем к текущему слову}
else if UpCase(old) in Sogl + Glas then Inc(j);{Если не буква, а предыдущий символ - буква, увеличиваем номер слова}
old := S[i]; {Сохраняем символ, на следующем шаге он станет предыдущим}
End;
Если я все правильно понял, то 50 слов * (8 символов +1 разделитель) = 450 символов максимум. Стрингом никак 
Цитата(Malice @ 16.06.05 14:03)
Если я все правильно понял, то 50 слов * (8 символов +1 разделитель) = 450 символов максимум. Стрингом никак
что значит ? программа, описаная выше, видишь ? там объявлен массив строк по 8 символов
так что никаких проблем.
Цитата(klem4 @ 16.06.05 14:07)
что значит ? программа, описаная выше, видишь ? там объявлен массив строк по 8 символов
так что никаких проблем.
так что никаких проблем.
Массив заполняется при вводе ? Нет. Там readln (s).
:D :D :D :D :D :D :D
Можно
S : string;
заменить на
S : array [1..450] of char;
только вводить сложнее.
И вообще, нефиг придираться, там ещё написано:
Если пробелов ставить можно сколько угодно, нам придётся безразмерную строку делать что-ли? <_<
Можно
S : string;
заменить на
S : array [1..450] of char;
только вводить сложнее.
И вообще, нефиг придираться, там ещё написано:
Цитата
между соседними словами – запятая или не менее одного пробела
Если пробелов ставить можно сколько угодно, нам придётся безразмерную строку делать что-ли? <_<
Цитата(Archon @ 16.06.05 14:23)
Если пробелов ставить можно сколько угодно, нам придётся безразмерную строку делать что-ли? <_<
Зря ты так. Может в этом и суть
Описано уж больно все конкретно.Придется заполнять массив при вводе, используя что-то типа RLe компресии
и array [1..499] Ж)
Цитата(Malice @ 16.06.05 14:38)
Может в этом и суть Описано уж больно все конкретно.
Описано уж больно все конкретно.Что именно КОНКРЕТНО описано? Я например виже только то, что есть ограничение на длину слова... С остальным никаких проблем нет, но если тебе так хочется поумничать, то просто напиши свою функцию ввода строки посимвольно... 10 минут работы вместе с отладкой...
В чем проблемы?
Можно вводить сразу массив слов :
немного лагает, надо поправить
uses crt;
const limits=[' ',',','.'];
var
s:string;
ch:char;
posl:array[1..50] of string[8];
i,j,n:integer;
Begin
clrscr;
write('n='); readln(n);
j:=0;
repeat
s:='';
i:=0;
repeat
inc(i);
ch:=readkey;
write(ch);
if not (ch in limits) then
s:=s+ch;
until (ch in limits)or(i=8);
inc(j);
posl[j]:=s;
until j=n;
readln;
end.
немного лагает, надо поправить
Да ну вас... Мы же с Malice пошутили... :p2:
У нас для этого есть раздел "ЮМОР"...
А сюда люди когда приходят, им не до шуток...
Да, сэр, так точно, сэр!
У нас для этого есть раздел "ЮМОР"...
А сюда люди когда приходят, им не до шуток...
Да, сэр, так точно, сэр!
Не уверен что отрабатывает полностью правильно, так что не бейте , здесь вариант с фиксированным числом записей, взгляните :
если надо, можно сделать такойже ввод, только без фиксированного числа последовательностей
uses crt;
const
limits=[' ',',','.'];
glasn=['q','e','y','u','i','o','a'];
sogl=['a'..'z']-glasn;
var
s,ss:string;
ch:char;
posl:array[1..50] of string[8];
i,j,k,n:integer;
flag:boolean;
Begin
clrscr;
write('n='); readln(n);
j:=0;
repeat
s:='';
i:=0;
repeat
inc(i);
ch:=readkey;
write(ch);
if not (ch in limits) then
s:=s+ch;
until (ch in limits)or(i=8);
inc(j);
posl[j]:=s;
until j=n;
writeln;
for i:=1 to n do
if (posl[i]<>posl[n])or(n=1) then begin
ss:=posl[i];
if odd(length(ss)) then
delete(ss,length(ss) div 2 + 1,1);
flag:=true;
k:=1;
case ss[k] in glasn of
True : begin
while(k<=length(ss))and(flag) do
if not((ss[k] in glasn)and(ss[k+1] in sogl)) then
flag:=false
else inc(k,2);
if flag then
writeln('YES : ',posl[i]);
end;
False : begin
while(k<=length(ss))and(flag) do
if not((ss[k] in sogl)and(ss[k+1] in glasn)) then
flag:=false
else inc(k,2);
if flag then
writeln('YES : ',posl[i]);
end;
end;
end;
readln;
end.
если надо, можно сделать такойже ввод, только без фиксированного числа последовательностей
Цитата(volvo @ 16.06.05 14:55)
Что именно КОНКРЕТНО описано? Я например виже только то, что есть ограничение на длину слова... С остальным никаких проблем нет, но если тебе так хочется поумничать, то просто напиши свою функцию ввода строки посимвольно... 10 минут работы вместе с отладкой...
В чем проблемы?
В чем проблемы?
Нежнее, volvo, нежнее. Работа программиста приучает к буквоедству, если в задании возможны разночтения - я всегда уточняю. Эти цифры просто режут глаз. Почему именно 50, а на пример не 10 ? Сложнее программа от этого не становится, а за 255 выталкивает. И окончание ввода конкретным символом тоже подводит к посимвольному вводу (это к until ch='.'). И ни каких проблем в этом нет. Говорю-что думаю. Ни каких шуток - все серьезно.
Цитата(klem4 @ 16.06.05 16:35)
Не уверен что отрабатывает полностью правильно
Вот этот кусок вызывает сомнения:
clrscr;
write('n='); readln(n);
j:=0;
repeat
s:='';
i:=0;
repeat
inc(i);
ch:=readkey;
write(ch);
if not (ch in limits) then
s:=s+ch;
until (ch in limits)or(i=8);
inc(j);
posl[j]:=s;
until j=n;
writeln;
{ Добавлено мной }
for i := 1 to n do writeln(posl[i]);
Вот что я вводил:
n=3
start<пробел>finish<пробел><пробел>
... на этом ввод прерывается и мне распечатывает:
Цитата
start
finish
<пустая строка или пробел>
finish
<пустая строка или пробел>
А у меня получилось вот такое (для ввода слов):
uses crt;
const
maxlen = 8;
maxwords = 10;
var
words: array[1 .. maxwords] of
string[maxlen];
function get_words: integer;
const
_delimit = [' ', ','];
_endstr = ['.'];
var
ch: char;
word_count: integer;
begin
word_count := 1;
repeat
ch := readkey;
if not (ch in (_delimit+_endstr)) then begin
if length(words[word_count]) < maxlen then begin
words[word_count] := words[word_count] + ch; write(ch)
end;
end
else
if ch in _delimit then begin
write(ch);
while ch in _delimit do ch := readkey;
if not (ch in _endstr) then begin
inc(word_count); words[word_count] := ch; write(ch);
end;
end;
until ch in _endstr;
writeln;
get_words := word_count;
end;
var
i: integer;
begin
for i := 1 to get_words do
writeln(words[i])
{ и пошла обработка }
end.
А если так :
write('n='); readln(n);
j:=0;
repeat
s:='';
i:=0;
flag:=false;
repeat
inc(i);
ch:=readkey;
write(ch);
if not (ch in limits) then begin
flag:=true;
s:=s+ch;
end;
until (ch in limits)or(i=8);
if flag then begin
inc(j);
posl[j]:=s;
end;
until j=n;
klem4, а как тебе вот такой способ решения первого задания (насчет чередования)?
;)
const
glasn=['q','e','y','u','i','o','a'];
sogl=['a'..'z']-glasn;
type char_set = set of char;
const
arrset: array[boolean] of char_set =
(glasn, sogl);
var
flag, which:boolean;
...
for i := 1 to n-1 do begin
which := posl[i][1] in glasn;
flag := true; j := 1;
while (j <= length(posl[i])) and flag do begin
flag := posl[i][j] in arrSet[which xor odd(j)];
inc(j)
end;
if flag and (posl[i] <> posl[n])
then writeln(posl[i])
end;
;)
Цитата(volvo @ 17.06.05 13:58)
klem4, а как тебе вот такой способ решения первого задания (насчет чередования)?
...красиво :D
volvo, я твою функцию get_words чуток подправил и сделал более дотошной:
В старом варианте:
1. Можно было ввести меньше 2-х слов;
2. Если первым символом ввести разделитель, то возникало пустое слово, что противоречит условию;
3. Можно было ввести больше maxwords слов что приводило к некорректной обработке массива;
4. По условию все слова должны состоять из строчных латинских букв, а можно было набирать из любых символов кроме разделителей и точки.
Ну а теперь такого нет B)
uses crt;
const
maxlen = 8;
minwords = 2;
maxwords = 50;
var
words: array[1 .. maxwords] of
string[maxlen];
function get_words: integer;
const
_alphabet = ['a' .. 'z'];
_delimit = [' ', ','];
_endstr = ['.'];
var
ch: char;
word_count: integer;
begin
word_count := 1;
repeat
ch := readkey;
if (ch in _alphabet) then begin
if length(words[word_count]) < maxlen then begin
words[word_count] := words[word_count] + ch; write(ch)
end
end
else
if (ch in _delimit) and (words[word_count] <> '') then begin
if (word_count < maxwords) then begin
inc(word_count); write(ch)
end
end
until (ch in _endstr) and (word_count >= minwords);
write(ch);
writeln;
get_words := word_count;
end;
var
i: integer;
begin
ClrScr;
for i := 1 to get_words do
writeln(words[ i ]);
{ и пошла обработка }
end.
В старом варианте:
1. Можно было ввести меньше 2-х слов;
2. Если первым символом ввести разделитель, то возникало пустое слово, что противоречит условию;
3. Можно было ввести больше maxwords слов что приводило к некорректной обработке массива;
4. По условию все слова должны состоять из строчных латинских букв, а можно было набирать из любых символов кроме разделителей и точки.
Ну а теперь такого нет B)
volvo, оценил проверку на чередование.
Не знал, что можно задавать массив так:
Осталось только скомпоновать:
Забавно будет, если Sqrin попросил задачку для школы <_<
Не знал, что можно задавать массив так:
Цитата
arrset: array[boolean]
Также, как и не знал, что q - гласная буква, хех.Осталось только скомпоновать:
program da_zdravstvuet_kollektivniy_trud_ura;
uses crt;
const
maxlen = 8;
minwords = 2;
maxwords = 50;
_glasn = ['q','e','y','u','i','o','a'];
_sogl = ['a'..'z'] - _glasn;
var
words : array[1 .. maxwords] of
string[maxlen];
function get_words: integer;
const
_alphabet = _glasn + _sogl;
_delimit = [' ', ','];
_endstr = ['.'];
var
ch: char;
word_count: integer;
begin
word_count := 1;
repeat
ch := readkey;
if (ch in _alphabet) then begin
if length(words[word_count]) < maxlen then begin
words[word_count] := words[word_count] + ch; write(ch)
end
end
else
if (ch in _delimit) and (words[word_count] <> '') then begin
if (word_count < maxwords) then begin
inc(word_count); write(ch)
end
end
until (ch in _endstr) and (word_count >= minwords);
write(ch);
writeln;
get_words := word_count
end;
type
char_set = set of char;
const
arrset: array[boolean] of char_set = (_glasn, _sogl);
var
flag, which : boolean;
i, j, n : integer;
begin
clrscr;
writeln('Введите строку (слов: 2-50; букв в слове: 1-8;');
writeln(' между словами '' '' или '',''; в конце ''.''):');
n := get_words;
writeln('Выборка по условию 1:');
for i := 1 to n - 1 do begin
if words[i] <> words[n] then begin
which := words[i][1] in _glasn;
flag := true; j := 1;
while (j <= length(words[i])) and flag do begin
flag := words[i][j] in arrSet[which xor odd(j)];
inc(j)
end;
if flag then write(' ',words[i])
end
end;
writeln;
writeln('Выборка по условию 2:');
for i := 1 to n - 1 do begin
if odd(length(words[i])) and (words[i] <> words[n]) then begin
delete(words[i], length(words[i]) div 2 + 1, 1);
write(' ',words[i]);
end
end;
readkey
end.
Забавно будет, если Sqrin попросил задачку для школы <_<
Цитата(klem4 @ 17.06.05 14:03)
...красиво :D
Раз такая пьянка пошла, чередование так проще проверить:
st:='';
for k:=1 to length(words[i]) do
st:=st+char($30+byte(words[i][k] in glasn));
if not((pos('00',st)>0) or (pos('11',st)>0)) then { чередуются }
и как то нагляднее :p2:
Ну, насчет наглядности, допустим, это как кому нравится... Можно еще не один вариант привести, который будет делать то же самое...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.