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

[volvo]

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;

;)

[klem4]

klem4, а как тебе вот такой способ решения первого задания (насчет чередования)?

...красиво :D

[Archon]

volvo, я твою функцию get_words чуток подправил и сделал более дотошной:

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)

[Archon]

volvo, оценил проверку на чередование.
Не знал, что можно задавать массив так:

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 попросил задачку для школы <_<

[Malice]

...красиво  :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:

Ну, насчет наглядности, допустим, это как кому нравится... Можно еще не один вариант привести, который будет делать то же самое...

Сообщение отредактировано: volvo - 17.06.2005 16:14