Помощь - Поиск - Пользователи - Календарь
Полная версия: множество
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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.
IUnknown
Что-то букв у тебя очень много... Все, что тебе надо знать для решения данного задания - это то, что множества перемножаются для получения тех элементов, которые присутствуют и в первом, и во втором множестве. В отличие от сложения, когда результат содержит все элементы, содержащиеся или в первом, или во втором (т.е., хотя бы в одном из них)...

Смотри:

type
   SetOfChar = set of char;
const
   delimit = [' ', '.']; // Разделители между словами
   Consonant = ['a' .. 'z'] - ['a', 'e', 'i', 'o', 'u']; // Согласные буквы

// Здесь получаем множество согласных букв, из которых состоит слово S...
function SetFromWord (const s : string) : SetOfChar;
var i : integer;
begin
   result := [];
   for i := 1 to length(s) do
      if s[i] in Consonant then result := result + [s[i]];
end;

var
   w : string;
   i, n, start : byte;
   s : string;
   Ch : char;

   All_Odds : SetOfChar;
   All_no_Evens : SetOfChar;
   Res : SetOfChar;

begin
   All_Odds := Consonant; // Буквы, встречающиеся во всех нечетных словах...
   All_no_Evens := Consonant; // Буквы, не встречающиеся во всех четных...

   s := 'bbbbhhhhsss nynynew bsbsbs lklklklk bfbsb.';
   i := 1;
   n := 0;

   // Это стандартный алгоритм разбиения строки на слова, я взял его из FAQ...
   while(i <= length(s)) do
   begin
      while (i <= length(s)) and (s[i] in delimit) do inc(i);
      if i <= length(s) then
      begin
         start := i;
         while (i <= length(s)) and not(s[i] in delimit) do inc(i);
         inc(n);
         w := copy(s, start, i - start); // Вот оно, очередное слово...

         // Оно нечетное? Получаем буквы, из которых оно состоит, и "перемножаем" их 
         // со множеством All_Odds... В результате у там нас будут храниться те согласные,
         // которые встречаются в КАЖДОМ нечетном слове
         if Odd(n) then All_Odds := All_Odds * SetFromWord(w)
         else
            // А, слово четное? Значит, делаем обратную операцию. Находим те буквы, которые НЕ
            // присутствуют в нем (от ВСЕХ согласных отнимает найденные), и результат домножаем
            // на All_no_Evens... В итоге там будут храниться те согласные, которые в каждом четном
            // слове НЕ присутствуют.
            All_no_Evens := All_no_Evens * (Consonant - SetFromWord(w));
      end;
   end;

   // Закончили с циклом по словам, осталось сделать пересечение двух множеств
   // и показать результат...
   Res := All_Odds * All_no_Evens;
   if Res <> [] then
   begin
      writeln('Found : ');
      for Ch := 'a' to 'z' do
         if Ch in Res then write(Ch:2);
      writeln;
   end
   else
      writeln('not found...');
end.
Ну, на кириллицу сам переложишь. Там зависит от версии Дельфи, да и вообще... Я предпочитаю с латиницей работать...
Insomnia
...мда, не надо рассираться было. Спасибо за помощь.
Lapp
Цитата(Insomnia @ 13.06.2011 18:06) *
...мда, не надо рассираться было.

Что бы это значило?.. blink.gif опечатка?
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.