IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> множество, вывести согл. буквы
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


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

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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 013
Пол: Мужской
Ада: Разработчик
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик

Репутация: -  627  +


Что-то букв у тебя очень много... Все, что тебе надо знать для решения данного задания - это то, что множества перемножаются для получения тех элементов, которые присутствуют и в первом, и во втором множестве. В отличие от сложения, когда результат содержит все элементы, содержащиеся или в первом, или во втором (т.е., хотя бы в одном из них)...

Смотри:

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.
Ну, на кириллицу сам переложишь. Там зависит от версии Дельфи, да и вообще... Я предпочитаю с латиницей работать...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 49
Пол: Мужской

Репутация: -  0  +


...мда, не надо рассираться было. Спасибо за помощь.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Insomnia @ 13.06.2011 18:06) *
...мда, не надо рассираться было.

Что бы это значило?.. blink.gif опечатка?


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 21.04.2025 8:27
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name