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

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

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

> множество, вывести согл. буквы
Insomnia
сообщение 13.06.2011 9:38
Сообщение #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 - 13.06.2011 9:53
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Insomnia
сообщение 13.06.2011 17:06
Сообщение #2


Новичок
*

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

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


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


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

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

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


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

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


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

Сообщений в этой теме


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

 



- Текстовая версия 20.07.2025 13:56
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"