Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Micren Статус: Студент Рейтинг: 117 ∙ повысить рейтинг >>

Botsman Статус: 7-й класс Рейтинг: 90 ∙ повысить рейтинг >>

Зенченко Константин Николаевич Статус: Профессор Рейтинг: 55 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 822
от 01.03.2009, 18:05

Вопрос № 161181: <b>Дана непустая последовательность слов из строчных русских букв; между соседними словами – запятая, за последним словом – точка. Напечатать в алфавитном порядке множества, сформированные согласно </b> <b>1.</b> Все гласные буквы, которые вхо...

Вопрос № 161.181

Дана непустая последовательность слов из строчных русских букв; между соседними словами – запятая, за последним словом – точка. Напечатать в алфавитном порядке множества, сформированные согласно 1. Все гласные буквы, которые входят в каждое слово; 2. Все звонкие согласные буквы, которые входят в каждое нечетное слово и не входят ни в одно четное слово. Программа должна решаться через множества, множество всех звонких согласных: б, в, г, д, ж, з, л, м, н, р; Первый пункт я решил, а вот второй не могу, прошу помочь. Желательно, чтобы оба пункта были объединены в одну программу Приложение: Program lab5; uses crt; type mn= set of char; const glas=[' ','Ґ','с','Ё','®','г','л','н','о','п']; var a:string; i,s:integer; f:text; b:mn; begin clrscr; assign(f,'1.txt'); reset(f); readln(f,a); s:=length(a); for i:=1 to s do begin write(a[i]:2); end; readkey; i:=0; b:=[]; repeat begin inc(i); if a[i] in glas then b:=b+[a[i]]; end; until a[i]='.'; writeln; for i:=0 to 255 do if chr(i) in b then write(chr(i):2); readln; end.

Отправлен: 23.02.2009, 11:57 Вопрос задал: Holden (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Holden! В приложении программа выполняющая обе задачи одновременно. После ввода строки идет контроль правильности ввода т.е. последним символом в строке должна быть точка, если её нет, то она дописывается, если после точки есть ещё символы, то они удаляются. Котрольная строка использовалась для проверки алгоритма и при работе её нужно убрать : InputString:='бвгджзаеу,джаеи,лмнрае.'; Множество гласных букв постоянно уменьшается остаются только те буквы, которые встретились в уже проверенных словах SetOne:=SetOne * SetChar; . Согласные буквы записываются в разные множества зависящие от четности слова и когда будет проверенна вся строка, множество букв четных слов вычитается из множества нечетных. Вопросы по программе задавайте в мини-форум. Удачи! Приложение: var SetChet,SetNeChet,SetChar,SetOne,SetTwo:set of char; WordCount:integer; InputString:string; begin {ставим нужные множества: гласных и согластных} SetOne:=['а','е','и','о','у','ы','э','ю','я'];{гластные} SetTwo:=['б','в','г','д','ж','з','л','м','н','р'];{согласные} {варианты на все случаи жизни: гласные буквы - а, е, и, о, у, ы, э, ю, я; звонкие согласные буквы - б, в, г, д, ж, з, л, м, н, р; глухие согласные буквы - к, п, с, т, ф, х, ц, ч, ш, щ.} write('Enter string :');readln(InputString);{вводим строку} if pos('.',InputString)=0 then InputString := InputString + '.'{ставим точку если пользователь забыл} else while InputString[length(InputString)]<>'.' do delete(InputString,length(InputString),1);{удаляем все символы после точки, если ввел лишнее} InputString:='бвгджзаеу,джаеи,лмнрае.';{контрольная строка для проверки- приработе она ненужна} writeln('Result:',InputString);{выводим строку} {сброс счетчиков букв и рабочих множеств} WordCount:=1;{счетчик слов} SetChet:=[];{множество согласных букв четных слов} SetNechet:=[];{множество согластных букв нечетных слов} SetChar:=[];{множество гласных букв в одном слове} writeln; While length(InputString)>0 do{} begin if (InputString[1]='.') or (InputString[1]=',')then{если точка или запятая - новое слово} begin inc(WordCount);{увеличиваем счетчик слов} SetOne:=SetOne * SetChar;{пересечение множеств, остаются только те буквы, которые есть в обоих множествах} SetChar:=[];{сбрасываем текущее множество} end else begin if InputString[1]in SetTwo then{если буква принадлежит множеству согласных букв} begin if odd(WordCount){буквы четных и нечентных слов записываем в разные множества} then SetNechet:=SetNechet+[InputString[1]] else SetChet:=SetChet+[InputString[1]]; end; if InputString[1]in SetOne then SetChar:=SetChar + [InputString[1]];{если буква принадлежит множеству гласных, записываем текущего слова} end; delete(InputString,1,1);{удаляем первый символ строки} end; SetNechet:=SetNechet-SetChet;{вычитаем из множества согласных букв нечетных слов, буквы которые встретились в четных словах} writeln('Count:',WordCount); write('One :');{выводим результат первой задачи} for WordCount:=0 to 255 do if chr(WordCount)in SetOne then write(chr(WordCount):2); writeln; write('Two :');{выводим результат второй задачи} for WordCount:=0 to 255 do if chr(WordCount)in SetNechet then write(chr(WordCount):2); readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Украина, Киев Тел.: +380979536619 Адрес: Украина г.Киев ---- Ответ отправлен: 23.02.2009, 19:51 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244303 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Вопрос № 161.197

Здравствуйте! Помогите пожалуйста. Задача на встроеннные циклы. Расчитать все возможные значения k=(4*x-(y-2))/3, если х изменяется на заданном интервале с заданным шагом, у принадлежит известное любое количество значений.

Отправлен: 23.02.2009, 15:52 Вопрос задал: Kuvart2009 Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Kuvart2009! Вот решение с подачи Зенченко Константина Николаевича. Код программы с пояснениями в приложении. Приложение: uses crt; const nmax=50;{максимальное количество значений У} var y:array[1..nmax]of real;{массив значений У} x,xn,xk,dx,k:real; n,i,s:integer; begin clrscr; repeat {вводим количество значений с проверкой} write('Kolichestvo znachenij Y n='); readln(n); until (n>0)and(n<=nmax); writeln('Vvedite ',n,' znachenij Y:'); for i:=1 to n do begin write('y[',i,']=');{вводим сами значения} readln(y[i]); end; clrscr;{очистим экран после ввода} writeln(n,' znachenij Y:');{выведем количество и сами значения У} for i:=1 to n do write(y[i]:5:2); writeln; repeat {введем начало интервала и конец} write('Nachalo intervala xn='); readln(xn); write('Konec intervala xk='); readln(xk); until xk>xn;{если конец больше начала, ввод правильный} repeat write('Shag vychislenij dx='); readln(dx); until(dx>0)and(dx<xk-xn);{шаг должен быть больше 0 и меньше длины интервала, лучше кратный длине, наприме при длине интервала 4, шаг 1, или 0,5 или 0,2} s:=0;{счетчик строк} for i:=1 to n do {перебираем все значения У} begin x:=xn;{сначала х=начальному} while x<=xk do{пока х меньше конца} begin k:=(4*x-(y[i]-2))/3;{вычисляем значение К} writeln(i:2,' y=',y[i]:0:2,' x=',x:0:2,' k=',k:0:2);{выводим в строку все данные} x:=x+dx;{увеличиваем Х} s:=s+1;{считаем строки} if s mod 20=0 then readln;{после каждых 20 строк задержка, это когда строк много, чтоб все просмотреть, а не только последние} end; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 24.02.2009, 10:39 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244335 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 161.198

Доброе время суток, Уважаемые Эксперты! Помогите пожалуйста решить задачку. Есть много идей, но не могу собрать всё воедино. Надеюсь, вы поможете. Задача: Сгенерировать 2 целочисленные матрицы, размерностью mxn. Сложить их и в полученной матрице нечётные значения записать с минусом, а чётные с плюсом.

Отправлен: 23.02.2009, 16:00 Вопрос задала: Ekaterina (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Ekaterina! Если првильно понял условие, то так. См. приложение. Приложение: uses crt; const m=5;{размер матриц} n=6; var a,b,c:array[1..m,1..n] of integer;{тип матриц} i,j:integer; begin clrscr; randomize; writeln('Matrica A:'); for i:=1 to m do {сгенерируем и выведем матрису А} begin for j:=1 to n do begin a[i,j]:=random(20)-9; write(a[i,j]:4); end; writeln; end; writeln('Matrica B:'); for i:=1 to m do{сгенерируем и выведем матрису В} begin for j:=1 to n do begin b[i,j]:=random(20)-9; write(b[i,j]:4); end; writeln; end; writeln('Matrica C=A+B:'); for i:=1 to m do begin for j:=1 to n do begin c[i,j]:=a[i,j]+b[i,j];{сложим матрицы} write(c[i,j]:4); end; writeln; end; writeln('Izmenennaya matrica C:'); for i:=1 to m do begin for j:=1 to n do begin {нечетные положительные превратим в отрицательные, а четные отрицательные-в положительные} if (c[i,j]>0)and(c[i,j] mod 2<>0) then c[i,j]:=-c[i,j] else if (c[i,j]<0)and(c[i,j] mod 2=0) then c[i,j]:=-c[i,j]; write(c[i,j]:4); end; writeln; end; readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 23.02.2009, 16:18 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244283 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Большое Вам спасибо за очень оперативный ответ!а главное, это то, что нужно. Я, например, мучила процедуры и в конец запуталась))

Вопрос № 161.199

Уважаемые эксперты! помогите пожалуйста решить следующие задачи через модуль. 1. заданы координаты 3-х вершин (х1,у1) (х2,у2) (х3,у3). найти его периметр и площадь. 2. ввести последовательность символов предшествующих символу * и выяснить сколько среди них букв S,A,R. все буквы S заменить на точку. 3. при поступлении в вуз абитуриенты, получившие 2 на первом экзамене, ко второму не допускаются. в массиве А[10] записаны оценки экзаменующихся, полученные на первом экзамене. подсчитать сколько человек не допущено ко второму экзамену. ЗАРАНЕЕ БЛАГОДАРЕН!!!

Отправлен: 23.02.2009, 16:13 Вопрос задал: Ильин Дмитрий (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Ильин Дмитрий! Задача №3: Код: const N = 10; var {Массив оценок} a: array [1..N] of Integer; i, count: integer; begin count := 0; {получаем оценки} write('введите результаты первого экзамена: '); for i := 1 to N do readln(a[i]); {перебираем массив, если оценка два или меньше, то увеличиваем кол-во недопущеных студентов на 1} for i := 1 to N do if a[i] <= 2 then inc(count); Write('Ответ: ', count); readln; end. Удачи!!! --------- Нам не дано предугадать, как слово наше отзовется (C) Тютчев

Ответ отправил: Абельхарисов Руслан/Marked One (статус: Практикант) Ответ отправлен: 23.02.2009, 19:11 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244293 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

Отвечает: Шевченко Дмитрий Здравствуйте, Ильин Дмитрий! Решение первых двух задач в приложении. В первой проверяем существование треугольника с заданными вершинами (каждая сторона меньше суммы двух других) и далее считаем его периметр и площадь (по формуле Герона: URL >>) Во второй задаче считываем введённый символ, если это A или R - просто считаем их количество и выводим на экран, чтобы пользователь видел что он нажал, а если это S - заменяем на точку, считаем количество и выводим на экран сразу точку). Если надо сначала сохранить то что ввели в строку, а потом уже считать количество букв и заменять S на точку, то вторая задача выглядит так: Код: uses crt; var c:char; s:String; i:byte; KolA,KolR,KolS:Word; begin ClrScr; KolS:=0; KolA:=0; KolR:=0; s:=''; repeat{пока не ввели *} c:=ReadKey;{считываем введённый символ} s:=s+c; Write(c); IF c = #13 then{Если нажали Enter - переводим курсор на следующую строку} WriteLn; until c = '*'; For i:= 1 to length(s) do case s[i] of 's','S': begin{если это буква S - заменяем на точку} s[i]:='.'; inc(kolS);{считаем количество} end; 'a','A': inc(KolA);{если буква A или R - считаем кол-во} 'r','R': inc(KolR); end; WriteLn; WriteLn('Изменённая строка: '); WriteLn(s);{выводим ответ} WriteLn('Количество букв A: ',KolA); WriteLn('Количество букв R: ',KolR); WriteLn( 'Количество букв S: ',KolS); ReadLn; end. Успехов! С уважением, Дмитрий. Приложение: program z161199; uses crt; {=== ЗАДАЧА №1 ===} Procedure vvod_tochek(var x1,x2,x3,y1,y2,y3:Extended); begin Write('введите x и y первой точки: '); Readln(x1,y1); Write('введите x и y второй точки: '); Readln(x2,y2); Write('введите x и y третьей точки: '); Readln(x3,y3); end; Function rasst(x1,x2,y1,y2:Extended):Extended; begin {расстояние между двумя точками} rasst:=sqrt(sqr(x2-x1)+sqr(y2-y1)); end; var a,b,c,s,x1,x2,x3,y1,y2,y3,poluPer:Extended; begin ClrScr; vvod_tochek(x1,x2,x3,y1,y2,y3);{ввести координаты точек} a:=rasst(x1,x2,y1,y2);{расчитываем стороны} b:=rasst(x2,x3,y2,y3); c:=rasst(x1,x3,y1,y3); IF ((a < b+c)and(b < a+c)and(c < a+b)) then{если точки образуют треугольник (сума двух сторон больше третьей), то} begin WriteLn('периметр = ',a+b+c:5:6);{вычислить периметр} poluper:=(a+b+c)/2; s:=sqrt(poluper*(poluper-a)*(poluper-b)*(poluper-c));{вычислить площадь} WriteLn('площадь = ',s:5:6); end else WriteLn('Треугольника с заданными координатами вершин не существует'); ReadLn(); end. {=== ЗАДАЧА №2 ===} var c:char; KolA,KolR,KolS:Word; begin ClrScr; KolS:=0; KolA:=0; KolR:=0; repeat{пока не ввели *} c:=ReadKey;{считываем введённый символ} case c of 's','S': begin{если это буква S - заменяем на точку} c:='.'; inc(kolS);{считаем количество} end; 'a','A': inc(KolA);{если буква A или R - считаем кол-во} 'r','R': inc(KolR); #13: WriteLn;{если нажали Enter - переводим курсор на след. строку} end; Write(c);{выводим введённый символ (или точку вместо S)} until c = '*'; WriteLn;{выводим ответ} WriteLn('Количество букв A: ',KolA); WriteLn('Количество букв R: ',KolR); WriteLn('Количество букв S: ',KolS); ReadLn; end.

Ответ отправил: Шевченко Дмитрий (статус: Студент) Ответ отправлен: 23.02.2009, 23:26 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 244312 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru