множество, вывести согл. буквы Опции

[Insomnia]

вывести согласные буквы, которые встречаются во всех нечетных словах и не встречаются во всех четных.

program sogl_v_ne4_slovax;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

type
  TElem=string;
  Tslov=set of char;

function PoiskSogl (slovo: string): boolean;// смотрит, есть ли в слове согл. буквы
var
  Mn: Tslov;
  i,l: integer;
begin
  result:=false;
  Mn:=[];
  Mn:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ','ъ','ь','Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ь'];
  i:=1;
  l:=length(slovo);
  while (i<=l) do
  begin
    if slovo[i] in Mn then
                    begin
                      result:=true;
                      inc(i);
                    end
                    else
                      inc(i);
  end;
end;
const
  n=10;
procedure PrintNechBykv (slovo: string);
  i,j,l: integer;
  nomer: integer;
  f: boolean;
  Mn: Tslov;
  A: array [1..n] of integer;
begin
  i:=1;
  j:=1;
  l:=length(slovo);
  nomer:=0;// запоминаем номер слова
  f:=true;
  Mn:=[];
  Mn:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ','ъ','ь','Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ь'];
  while i<=l do
  begin
    while (slovo[i]= ' ') and (i<=l) do inc(i);
    while (slovo[i]<>' ') and (i<=l) do inc(i);
    begin
      inc(nomer);
      A[j]:=nomer;
      inc(j);
    end;
  end;
end;


var
  slovo: string;
  simvol: char;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  slovo:='';
  writeln('напишите текст, точка- конец');
  read(simvol);
  if simvol='.' then
                begin
                  writeln('слов нет');
                  readln;
                  readln;
                  exit
                end
                else
                begin
                  while simvol<> '.'  do
                  begin
                    slovo:=slovo+simvol;
                    read(simvol)
                  end;
                end;
  PoiskSogl(slovo);
  writeln('согл. буквы, встречающиеся во всех нечетных словах и отсутствующие в четных');
  PrintNechBykv(slovo);
  readln;
  readln
end.

никак не могу придумать алгоритм, который исках бы буквы. Я предполагал, что сначала пронумерую слова все, занесу их в массив, а потом каждую букву буду сравнивать со словами со всеми в 1 цикле и смотреть, условие задачи выполняется или нет. Занести все в множество будет не правильным. Или у меня заведомо неправильный подход к решению?

Добавлено через 11 мин.
написал код, который выводит все согл. буквы в нечетных словах. Хотел по подобию сделать, но не могу до ума до вести. И может этот код вообще очень громоздкий и не рациональный и нужен более простой путь к решению? помогите пожалуйста понять.

program pe4at_sogl_v_ne4_slovah;

{$APPTYPE CONSOLE}

uses
  SysUtils,windows;

type
  TElem=string;
  Tslov=set of char;

function PoiskSogl (slovo: string): boolean;//смотрим, есть ли в слове согл. буквы
var
  Mn: Tslov;
  i,l: integer;
begin
  result:=false;
  Mn:=[];
  Mn:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ','ъ','ь','Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ь'];
  i:=1;
  l:=length(slovo);
  while (i<=l) do
  begin
    if slovo[i] in Mn then
                    begin
                      result:=true;
                      inc(i);
                    end
                    else
                      inc(i);
  end;
end;

procedure PrintNechBykv (slovo: string);//печатаем буквы согл., пропуская четные слова.
var
  i,j,l: integer;
  nomer: integer;
  f: boolean;
  Mn: Tslov;
  MnBykv: Tslov;
begin
  i:=1;
  l:=length(slovo);
  nomer:=0;// номер слова
  f:=true;
  MnBykv:=[];
  Mn:=[];
  Mn:=['б','в','г','д','ж','з','к','л','м','н','п','р','с','т','ф','х','ц','ч','ш','щ','ъ','ь','Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С','Т','Ф','Х','Ц','Ч','Ш','Щ','Ъ','Ь'];
  while i<=l do
  begin
    while (slovo[i]= ' ') and (i<=l) do inc(i);//пропускаем пробелы
    while (slovo[i]<>' ') and (i<=l) do
    if (slovo[i] in Mn) and (nomer mod 2 = 0) then {последнее усл. ставим, что бы в мн-во не вкл. буквы с четных слов}
    begin
      MnBykv:=MnBykv+[slovo[i]];
      inc(i)
    end
                                                    else inc(i);
    inc(nomer);
    if (nomer mod 2 <> 0) and PoiskSogl(slovo) then
    begin
      for j:=1 to 255 do // проверяем по табл. ASCII соответствующий номер символа 
      begin
        if chr(j)  in MnBykv then write(chr(j):2);
      end;
      f:=false;
      MnBykv:=[];//опустошаем мн-во, что бы при выводе старые буквы не повторялись с новыми
    end;
  if f then writeln ('нет');
  end;
end;




var
  slovo: string;
  simvol: char;
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  slovo:='';
  writeln('введите текст, точка - конец');
  read(simvol);
  if simvol='.' then
                begin
                  writeln('слов нет');
                  readln;
                  readln;
                  exit
                end
                else
                begin
                  while simvol<> '.'  do
                  begin
                    slovo:=slovo+simvol;
                    read(simvol)
                  end;
                end;
  PoiskSogl(slovo);
  writeln('согл. буквы в нечетных словах');
  PrintNechBykv(slovo);
  readln;
  readln
end.

Сообщение отредактировано: Insomnia - 13.06.2011 9:53