множества Опции

[Sqrin]

Дана последовательность, содержащая от 2 до 50 слов, в каждом из которых от 1 до 8 строчных латинских букв; между соседними словами – запятая или не менее одного пробела, за последним словом - точка.
Напечатать те слова последовательности, которые отличны от последнего слова и
удовлетворяют следующему свойству:
- в слове гласные чередуются с согласными;
Напечатать те слова последовательности, которые отличны от последнего слова,
предварительно преобразовав каждое из них по следующему правилу:
- если слово нечетной длины, то удалить его среднюю букву.


напишите плиз

[volvo]

напишите плиз

Помочь - пожалуйста, но писАть полностью :no:
Хоть что-нибудь уже начато?

Для начала можно прочитать здесь: FAQ: Множества, чтобы иметь представление о том, с чем придется иметь дело...

[asCOOLs]

ето понятно ... вот тока определение согласные или не согласные ?
сделать отдельный блок данных с забитыми гласными и проверять? что не соглас то гласные ? или как лучше оформиь?

[volvo]

const
  glas = ['a', 'e', 'i']; { и так далее }
  soglas = ['a' .. 'z'] - glas;

[Sqrin]

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

[volvo]

Напечатать те слова последовательности, которые отличны от последнего слова

Ну, для этого допустим надо разбивать строку на слова, это тоже уже было: FAQ: Строки
А потом вот так:

Count := GetWords(s, arr, []);
for i := 1 to pred(Count) do
  If (arr[i] <> arr[Count]) and ({ здесь проверяй чередование }) 
    then writeln(arr[i]);

если слово нечетной длины, то удалить его среднюю букву

Элементарно:

If odd(length(s)) then delete(s, succ(length(s) div 2), 1);

[Sqrin]

о елки .. оболдеть... что то я запутолся...
ксати насчет 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);
ето вроде начало... как терь сюда прикрипить
разбиение строки по словам?

[Archon]

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;

Сообщение отредактировано: Archon - 15.06.2005 18:41

[Malice]

Если я все правильно понял, то 50 слов * (8 символов +1 разделитель) = 450 символов максимум. Стрингом никак

[klem4]

Если я все правильно понял, то 50 слов * (8 символов +1 разделитель) = 450 символов максимум.  Стрингом никак 

что значит ? программа, описаная выше, видишь ? там объявлен массив строк по 8 символов

так что никаких проблем.

[Malice]

что значит ? программа, описаная выше, видишь ? там объявлен массив строк по 8 символов

так что никаких проблем.

Массив заполняется при вводе ? Нет. Там readln (s).

[Archon]

:D :D :D :D :D :D :D
Можно
S : string;
заменить на
S : array [1..450] of char;
только вводить сложнее.

И вообще, нефиг придираться, там ещё написано:

между соседними словами – запятая или не менее одного пробела

Если пробелов ставить можно сколько угодно, нам придётся безразмерную строку делать что-ли? <_<

[Malice]

Если пробелов ставить можно сколько угодно, нам придётся безразмерную строку делать что-ли? <_<

Зря ты так. Может в этом и суть Описано уж больно все конкретно.
Придется заполнять массив при вводе, используя что-то типа RLe компресии и array [1..499] Ж)

[volvo]

Может в этом и суть Описано уж больно все конкретно.

Что именно КОНКРЕТНО описано? Я например виже только то, что есть ограничение на длину слова... С остальным никаких проблем нет, но если тебе так хочется поумничать, то просто напиши свою функцию ввода строки посимвольно... 10 минут работы вместе с отладкой...

В чем проблемы?

[klem4]

Можно вводить сразу массив слов :

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.

немного лагает, надо поправить

Сообщение отредактировано: klem4 - 16.06.2005 19:02

[Archon]

Да ну вас... Мы же с Malice пошутили... :p2:

У нас для этого есть раздел "ЮМОР"...
А сюда люди когда приходят, им не до шуток...

Да, сэр, так точно, сэр!

Сообщение отредактировано: Archon - 16.06.2005 20:45

[klem4]

Не уверен что отрабатывает полностью правильно, так что не бейте , здесь вариант с фиксированным числом записей, взгляните :

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.

если надо, можно сделать такойже ввод, только без фиксированного числа последовательностей

Сообщение отредактировано: klem4 - 16.06.2005 23:08

[Guest]

Что именно КОНКРЕТНО описано? Я например виже только то, что есть ограничение на длину слова... С остальным никаких проблем нет, но если тебе так хочется поумничать, то просто напиши свою функцию ввода строки посимвольно... 10 минут работы вместе с отладкой...

В чем проблемы?

Нежнее, volvo, нежнее. Работа программиста приучает к буквоедству, если в задании возможны разночтения - я всегда уточняю. Эти цифры просто режут глаз. Почему именно 50, а на пример не 10 ? Сложнее программа от этого не становится, а за 255 выталкивает. И окончание ввода конкретным символом тоже подводит к посимвольному вводу (это к until ch='.'). И ни каких проблем в этом нет. Говорю-что думаю. Ни каких шуток - все серьезно.

[volvo]

Не уверен что отрабатывает полностью правильно

Вот этот кусок вызывает сомнения:

   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
<пустая строка или пробел>

А у меня получилось вот такое (для ввода слов):

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.

[klem4]

А если так :

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;