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

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

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

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 254 ∙ повысить рейтинг >>

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

Шичко Игорь Статус: Практикант Рейтинг: 124 ∙ повысить рейтинг >>

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

Выпуск № 768
от 28.12.2008, 14:35

Вопрос № 155333: Добрый день! Помогите пожалуйста с решением двух задач! Озадачил начальник, а его любимая доченька) Что делать не знаю... 1. Составить блок схему алгоритма и программу вывода на экран всех двузначных чисел, оканчивающихся на цифру 2. 2. Сос...

Вопрос № 155.333

Добрый день! Помогите пожалуйста с решением двух задач! Озадачил начальник, а его любимая доченька) Что делать не знаю... 1. Составить блок схему алгоритма и программу вывода на экран всех двузначных чисел, оканчивающихся на цифру 2. 2. Составить программу для нахождения наименьшего натурального х, такого, что X5 -3x >358 Заранее благодарен!!

Отправлен: 22.12.2008, 13:31 Вопрос задал: Богданов Денис Викторович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 7)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Богданов Денис Викторович! Решения задач в приложении, блок-схема во вложенном файле. Приложение: 1. Составить блок схему алгоритма и программу вывода на экран всех двузначных чисел, оканчивающихся на цифру 2. uses crt; {модуль для очистки экрана} var i:integer; begin clrscr; {очистка экрана} for i:=12 to 92 do if i mod 10=2 then {если в остатке 2, выводим на экран} writeln(i); readln end. 2. Составить программу для нахождения наименьшего натурального х, такого, что X5 -3x >358 uses crt; var x,i:integer; begin clrscr; x:=1; while x*x*x*x*x-3*x<=358 do {пока не превысили 358, считаем} inc(x);{увеличиваем х на 1, можно написать x:=x+1;} write('x=',x,' x^5-3x=',x*x*x*x*x-3*x);{выводим результат} readln end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

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

Вопрос № 155.334

Дана действительная квадратная матрица порядка 2n. Получить новую матрицу, переставляя ее блоки размера n×n в соответствии с рисунком:

Отправлен: 22.12.2008, 13:33 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение с пояснениями в приложении. Приложение: uses crt; const n=4;{размер половины матрицы} var a:array[1..2*n,1..2*n] of integer;{тип матрицы} i,j,x:integer; begin clrscr; writeln('Ishodnaya matrica:'); for i:=1 to 2*n do begin for j:=1 to 2*n do {заполняем всю матрицу} begin a[i,j]:=10*i+j; {берем числа какномера ячеек для наглядности} write(a[i,j]:4); end; writeln; end; for i:=1 to n do for j:=1 to n do begin x:=a[i,j]; {запоминаем элементы 1 четверти} a[i,j]:=a[n+i,j];{на их место ставим элементы 4 четверти} a[n+i,j]:=a[n+i,n+j];{на место 4ой - третью} a[n+i,n+j]:=a[i,n+j];{на место третьей - вторую} a[i,n+j]:=x;{на место второй - первую} end; writeln('Rezultat:'); for i:=1 to 2*n do begin for j:=1 to 2*n do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 155.338

Составить процедуру, позволяющую определить позицию первого вхождения в заданную строку какого-либо символа из второй заданной строки. Результатом работы процедуры должна быть -1, если первая строка не содержит ни одного символа, принадлежащего и второй строке.

Отправлен: 22.12.2008, 13:44 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Абельхарисов Руслан/Marked One Здравствуйте, Иванов Виктор Олегович! Код в приложении. Удачи!!! Приложение: procedure FindStr(str1, str2: string; var p: integer); var i, j: integer; b: boolean; begin for i := 1 to Length(str1) do if str1[i] = str2[1] then begin b := false; for j := 0 to Length(str2) - 1 do if str1[i + j] = str2[j + 1] then b := true else begin b := false; break; end; if b then begin p := i; exit; end; end; p := -1; end; var str1, str2: string; p: integer; begin Write('str1: '); ReadLn(str1); Write('str2: '); ReadLn(str2); FindStr(str1, str2, p); Write('Ответ: ', p); ReadLn; end. --------- Нам не дано предугадать, как слово наше отзовется (C) Тютчев

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

Вопрос № 155.340

Составить процедуру, результатом работы которой является символ, заданный при обращении к процедуре, если этот символ не является буквой, и соответствующая строчная (малая) буква в противном случае.

Отправлен: 22.12.2008, 13:48 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Mixala Здравствуйте, Иванов Виктор Олегович! в общем то все просто, но не очень красиво. Если это английские букве, то есть специальная функция, но я не знаю какие именно нужны, сделаю и для русских. и если функции передана строчная буква, то она и возвращается. Код функции Перевод для русских букв неправильный. См. следующий ответ. -------- ∙ Отредактировал: Николай Владимирович / Н.В., Академик ∙ Дата редактирования: 25.12.2008, 00:17 (время московское) Приложение: function f(c:char):char; begin if ((c>='a')and(c<='z'))or((c>='а')and(c<='я')) then begin f:=c; exit; end; if ((c>='A')and(c<='Z')) then begin f:=chr(ord(c)-ord('A')+ord('a')); exit; end; if ((c>='А')and(c<='Я')) then begin f:=chr(ord(c)-ord('А')+ord('а')); exit; end; f:=c; end;

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

Отвечает: Шевченко Дмитрий Здравствуйте, Иванов Виктор Олегович! Так как русские буквы совсем не обязательно идут подряд, то лучше использовать следующий вариант: С уважением, Дмитрий. Приложение: Function change(c:char):char; var z1,z2:String; res:char; begin z1:='QWERTYUIOPASDFGHJKLZXCVBNM'+'ЙЦУКЕНГШЩЗЪХФЫВАПРОЛДЖЭЯЧСМИТЬБЮЁ';{список заглавных букв} z2:='qwertyuiopasdfghjklzxcvbnm'+'йцукенгшщзхъфывапролджэячсмитьбюё';{список соответствующих строчных} IF pos(c,z1) > 0 then{если буква - заглавная - } res:=z2[pos(c,z1)]{меняем на соответствующую строчную} Else res:=c; change:=res; end;

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

Вопрос № 155.341

Составить процедуру вычисления значения целого числа по заданной строке символов, являющейся записью этого числа в шестнадцатеричной системе счисления.

Отправлен: 22.12.2008, 13:52 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Andersen Здравствуйте, Иванов Виктор Олегович! Функция HexToDec преобразует шеснадцатеричное число в десятичное Приложение: program Hex; function HexToDec(s:string):longint; var i,z:integer; j,r:longint; begin r:=1; j:=0; for i:=length(s) downto 1 do begin z:=-1; case s[i] of '0' : z:=0; '1' : z:=1; '2' : z:=2; '3' : z:=3; '4' : z:=4; '5' : z:=5; '6' : z:=6; '7' : z:=7; '8' : z:=8; '9' : z:=9; 'A','a' : z:=10; 'B','b' : z:=11; 'C','c' : z:=12; 'D','d' : z:=13; 'E','e' : z:=14; 'F','f' : z:=15; end; if z>-1 then begin j:=j+z*r; r:=r*16; end; end; HexToDec:=j; end; var s:string; begin write ('Vvedite shesnadcerichnoe chislo :'); readln(s); writeln(HexToDec(s)); readln; end.

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

Вопрос № 155.348

Здравствуйте Уважаемые эксперты! у меня пару задачек,которые никак не могу решить! Если сможете,помогите! 1.Выделить слова в выражение и распечать каждое слово с новой строки. 2.Поменять в слове попарно буквы. Заранеее благодарю

Отправлен: 22.12.2008, 14:57 Вопрос задал: Куценко Артём Андреевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Костя Симанович Здравствуйте, Куценко Артём Андреевич! Решение задачи в приложении. в задаче словом считается последовательность состоящая из букв, разделиель между словами всё остальное ( пробел, цифра, запятая и т.д). что касается второй задачи, может я немного не понял условие, сделал так: берём слово и меняем в нём две соседние буквы местами, переходим к следующей паре букв и т. д. до конца, вариант решения под номером 2 с пояснениями. просто добавил в 1 задачу дополнительную функцию. Удачи. Приложение: Задача 1. program sss2; const Alpha : set of char=['A'..'Z','А'..'П','Р'..'Я','a'..'z','а'..'п','р'..'я']; var s, s1 : string; i : integer; begin writeln('Введите предложение.'); readln(s); writeln(' список слов в тексте.'); i := 1; repeat while NOT(s[i] in alpha) and (i <= length(s)) do {ищем не букву "разделитель"} inc(i); {разделитель может быть пробел, цифра, знак препинания} {и пропускаем его} s1 := ''; while (s[i] in Alpha) and (i<=length(s)) do {если символ принадлежит} begin {множеству записываем его в s1} s1 := s1 + s[i]; {это и будет искомое слово} inc(i); end; if length(s1) <> 0 then writeln(s1); {выводим это слово} until i > length(s); readln; end. Задача 2. program sss2; const Alpha : set of char=['A'..'Z','А'..'П','Р'..'Я','a'..'z','а'..'п','р'..'я']; function obmen(str : string) : string; {функция произвдит обмен двух} var {соседних букв в слове} a : integer; st: string; begin a := 1; obmen := ''; while a < length(str) do begin st := ''; st := str[a + 1] + str[a]; obmen := obmen + st; a := a + 2; end; {ниже проверяем если длина слова нечетная, то последняя буква остаётся} {без пары, просто добавляем её в конец } if odd(length(str)) then obmen := obmen + copy(str, length(str), 1); end; var s, s1 : string; i : integer; begin writeln('Введите предложение.'); readln(s); writeln(' список слов в тексте.'); i := 1; repeat while NOT(s[i] in alpha) and (i <= length(s)) do {ищем не букву "разделитель"} inc(i); {разделитель может быть пробел, цифра, знак препинания} {и пропускаем его} s1 := ''; while (s[i] in Alpha) and (i<=length(s)) do {если символ принадлежит} begin {множеству записываем его в s1} s1 := s1 + s[i]; {это и будет искомое слово} inc(i); end; if length(s1) <> 0 then begin writeln; writeln('Исходное слово. = ', s1); writeln; write('Обработанное слово. '); writeln(obmen(s1)); {вызываем функцию обработки} end; until i > length(s); readln; end.

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

Вопрос № 155.351

Пусть A - двумерный массив чисел размерности nxn ввести его случайным образом. Поменять местами: а) максимальный из отрицательных эл-ов и минимиальный из четных эл-ов б) 3-ю и 4-ю строки массива в) столбцы с минимальными и максимальными модулями суммы эл-ов очень надеюсь на Вашу помощь. Скоро зачет и это последня нерешенная задача

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Torres! Решение с комментариями в приложении. Приложение: uses crt; const n=6; {размер матрицы} var a:array[1..n,1..n]of integer; i,j,max,imax,jmax,min,imin,jmin,sm,x:integer; begin clrscr; randomize; writeln('Ischodnyj massiv:');{создаем массив и сразу} min:=maxint;imin:=1;jmin:=1; max:=-maxint-1;imax:=1;jmax:=1; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(20)-9; if (a[i,j]<0)and(a[i,j]>max)then {ищем максимальный из отрицательных} begin max:=a[i,j]; imax:=i; {его строку} jmax:=j; {его столбец} end; if (a[i,j] mod 2=0)and(a[i,j]<min)then {минимальный из четных} begin min:=a[i,j]; imin:=i;{его строку} jmin:=j;{его столбец} end; write(a[i,j]:4); end; writeln; end; writeln('MaxOtr=',max,' Imax=',imax,' Jmax=',jmax); {выводим данные, чтоб видеть, что переставляем} writeln('MinCht=',min,' Imin=',imin,' Jmin=',jmin); writeln('Obmen max i min:'); x:=a[imin,jmin]; a[imin,jmin]:=a[imax,jmax];a[imax,jmax]:=x;{перестановка} for i:=1 to n do {вывод на экран} begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln; writeln('Obmen strok 3 i 4:'); for j:=1 to n do begin x:=a[3,j];a[3,j]:=a[4,j];a[4,j]:=x; {просто обмен} end; for i:=1 to n do {вывод на экран} begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln; writeln('Obmen stolbcov:'); max:=-maxint-1;jmax:=1;min:=maxint;jmin:=1; for j:=1 to n do begin sm:=0; for i:=1 to n do sm:=sm+a[i,j]; {считаем сумму в столбцах} if abs(sm)>max then {если ее модуль больше макс} begin max:=abs(sm); jmax:=j; {запоминаем столбец} end; if abs(sm)<min then {если меньше мин} begin min:=abs(sm); jmin:=j; {запоминаем столбец} end; end; {выводим, чтобы видеть что переставляем} writeln('MinMod=',min,' Jminmod=',jmin,' MaxMod=',max,' Jmaxmod=',jmax); for i:=1 to n do begin x:=a[i,jmin];a[i,jmin]:=a[i,jmax];a[i,jmax]:=x;{перестановка обменом} end; for i:=1 to n do {вывод на экран} begin for j:=1 to n do write(a[i,j]:4); writeln; end; readln end.

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

Вопрос № 155.352

Уважаемые эксперты помогите решить задачу в Pascal ABC через модуль. Условие: Дана не пустая строка S. Вывести строку, содержащую символы строки S между которыми вставлено по одному пробелу.

Отправлен: 22.12.2008, 15:12 Вопрос задал: Tetris Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Andersen Здравствуйте, Tetris! Вот вам вариант с использованием модуля Приложение: program Demo; uses Unit1; var s:string; begin write('Vvedite ctroky '); readln(s); writeln(NewLine(s)); readln; end. unit Unit1; interface function NewLine(s:string):string; implementation function NewLine(s:string):string; var s1:string; i:byte; begin s1:=''; for i:=1 to length(s)-1 do if s[i]<>' ' then s1:=s1+s[i]+' '; NewLine:=s1+s[length(s)]; end; end.

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

Вопрос № 155.372

Многоуважаемые эксперты, помогите плиз решить задачу: Сформировать квадратную матрицу порядка n по заданному образцу: 1 0 0 ... 0 0 n 0 2 0 ... 0 n-1 0 0 0 3 ... n-2 0 0 . . . . . . . . . . . . . . . . . . . . . 0 2 0 ... 0 n-1 0 1 0 0 ... 0 0 n

Отправлен: 22.12.2008, 17:12 Вопрос задал: Андрей Викторович В. (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Андрей Викторович В.! Сформировать можно так, как в приложении. Удачи! Приложение: const n=10; var a:array [1..n,1..n]of integer; x,y:integer; begin for x:=1 to n do begin for y:=1 to n do begin a[x,y]:=ord(x=y)*x+ord((n-x+1)=y)*y; write(a[x,y]:3); end; writeln; end; readln; end. --------- Итерация от человека, рекурсия — от Бога (Питер Дойч)

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

Отвечает: Thoughtful Traveller Здравствуйте, Андрей Викторович В.! Можно попробовать вот так. Приложение: uses crt; const n=5; var a:array[1..n,1..n] of integer; i,j:integer; begin clrscr; writeln('Your matrix:'); for i:=1 to N do begin for j:=1 to N do begin if i=j then a[i,j]:=i else if i=n+1-j then a[i,j]:=j else a[i,j]:=0; write(a[i,j]:4) end; writeln; end; readln; end.

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

Вопрос № 155.399

Добрый вечер, уважаемые эксперты))) Помогите, пожалуйста, с задачей для курсовой. Вычислить среднее арифметическое значение элементов матрицы W(L,L), L <= 30, расположенных слева и справа от двух диагоналей. Но задача должна быть решена без использования процедур и функций!!! Заранее благодарен)))

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Eugenmail2008! Решение задачи с пояснениями в приложении. Приложение: uses crt; const nmax=30;{максимальный размер матрицы} var W:array[1..nmax,1..nmax]of real;{тип матрицы} L,i,j,k:integer; sr:real;{среднее} begin clrscr; randomize;{генерация случайных чисел} repeat write('Razmer matricy L='); readln(L); until (L>=3)and(L<=nmax);{проверяем размер матрицы} writeln('Matrica W:'); sr:=0;k:=0; for i:=1 to L do begin for j:=1 to L do begin W[i,j]:=10*random;{заполняем матрицу случайными вещественными числами из инт. 0-10} if((j<i)and(j<L-i+1))or((j>i)and(j>L-i+1)){если мы в заданной области} then begin TextColor(4);{сделаем подсветку красным} k:=k+1; {сосчитаем элементы этой области} sr:=sr+W[i,j]; {сосчитаем сумму} write(W[i,j]:5:2);{выведем с подсветкой} end else {если за пределами области} begin Textcolor(0);{цвет по умолчанию} write(W[i,j]:5:2);{выводим остальные числа} end; end; writeln; end; sr:=sr/k;{считаем среднее} writeln('Srednee=',sr:0:2); readln end.

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

Вопрос № 155.457

Дана матрица nxn посчитать кол-во нулей ниже главной диагонали

Отправлен: 23.12.2008, 10:19 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: uses crt; const n=10; var a:array[1..n,1..n]of byte; k,i,j:integer; begin clrscr; randomize; writeln('Matrica A:'); k:=0; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(3); {числа 0,1,2} if (i>j) and (a[i,j]=0) then {если ниже главной и ноль} begin inc(k);{считаем} Textcolor(4);{подсвечиваем красным} write(a[i,j]:3);{выводим} end else {если нет} begin Textcolor(0);{цвет по умолчанию} write(a[i,j]:3);{выводим} end; end; writeln; end; writeln('Kol nolej=',k); readln end.

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

Вопрос № 155.458

Даны натуральные числа k, l, m, действительные числа x1, ... , xk, y1, ... , yl, z1, ... , zm. Получить t = (max(y1, ... , yl) + max(z1, ... , zm))/2 при max(x1, ... , xk)≥0, 1 + (max(x1, ... , xk))2 в противном случае.

Отправлен: 23.12.2008, 10:29 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: uses crt; type Tmas=array[1..100]of real;{тип массива для передачи параметром в процедуру и функцию} procedure Mas(r:integer;var q:Tmas);{процедура создания и вывода на экран массива} var i:integer; begin for i:=1 to r do begin q[i]:=10*random-6; write(q[i]:5:2); end; writeln; end; function Max(r:integer;q:Tmas):real;{функция нахождения максимального в массиве} var i:integer; mx:real; begin mx:=q[1]; for i:=2 to r do if q[i]>mx then mx:=q[i]; Max:=mx; end; var x,y,z:Tmas; k,l,m:integer; t:real; begin {программа по условию} clrscr; write('Vvedite razmery massivov:'); readln(k,l,m); writeln('Massiv X:'); Mas(k,x); writeln('MaxX=',Max(k,x):0:4); writeln('Massiv Y:'); Mas(l,y); writeln('MaxY=',Max(l,y):0:4); writeln('Massiv Z:'); Mas(m,z); writeln('MaxZ=',Max(m,z):0:4); if Max(k,x)>=0 then t:=Max(l,y)+Max(m,z)/2 else t:=1+Max(k,x); write('Rez=',t:0:4); readln end.

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

Вопрос № 155.460

Даны действительные числа s, t, a0, ..., a12. Получить p(1) - p(t) + p2(s - t) - p3(1), где p(x) = a12x12 + a11x11 + ... + a0.

Отправлен: 23.12.2008, 10:43 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Пупорев Юрий Борисович Здравствуйте, Иванов Виктор Олегович! Если я прав насчет опечатки(смотри мини-форум)то программа в приложении. Если не прав, уточните условие, переделаем. Можете даже сами, основной код не изменится. Приложение: uses crt; type Tmas=array[0..12]of real; {тип массива для передачи в функцию в качестве параметра} function Step(q:real;n:byte):real;{функция натуральной степени вещественного числа, стандартная exp(ln(q)*n)не работает при q<=0, нужно все равно делать свою функцию} var i:integer; st:real; begin st:=1.0; for i:=1 to n do st:=st*q; Step:=st; end; function P(z:real;m:Tmas):real;{основная функция вычисления слагаемых выражения, параметры - число(s,t,s-t) и массив А} var sm,r:real; i:integer; begin sm:=0; for i:=12 downto 0 do begin r:=m[i]*Step(z,i);{вычисляем член ряда через дополнительную переменную, говорят так быстрее} sm:=sm+r;{вычисляем сумму} end; P:=sm; end; var s,t,Rez:real; {раздел переменных программы} a:Tmas; i:integer; begin clrscr; randomize; write('s=');readln(s); {вводим два числа} write('t=');readln(t); writeln('Massiv A:'); for i:=0 to 12 do begin a[i]:=5*random; {создаем массив} write(a[i]:5:2); end; writeln; Rez:=P(s,a)-P(t,a)+P(s-t,a)*P(s-t,a)-P(s,a)*P(s,a)*P(s,a); {считаем выражение, используя готовые функции} write('Rezultat=',Rez:0:5); readln end.

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

Вопрос № 155.462

Даны натуральное число n, действительные числа x1, y1, x2, y2, ... , xn, yn. Найти площадь n - угольника, вершины которого при некотором последовательном обходе имеют координаты (x1, y1), (2, y2), (xn, yn). (Определить процедуру вычисления площади треугольника по координатам его вершин.)

Отправлен: 23.12.2008, 10:49 Вопрос задал: Иванов Виктор Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шичко Игорь Здравствуйте, Иванов Виктор Олегович! Предлагаю Вам вариант решения. Код с функцией в приложении. Как я понял из условия треугольники формируются так: точка1, точка 2, и перебираем точки от 3 до n. Т.е. всего n-2 треугольников. Если не так, то пишите, подправлю. Приложение: function square(x1, y1, x2, y2, x3, y3: integer):real; var a1, a2, a3, p: real; begin a1:= sqrt(sqr(x2-x1) + sqr(y2-y1)); a2:= sqrt(sqr(x3-x2) + sqr(y3-y2)); a3:= sqrt(sqr(x1-x3) + sqr(y1-y3)); p:= (a1 + a2 + a3) / 2; square:= sqrt(p * (p-a1) * (p-a2) * (p-a3)); end; const n = 20; {íà÷àëî ïðîãðàììû} var x, y: array[1..n] of integer; temp: real; i: integer; begin randomize; for i:= 1 to n do {формируем точки случайным образом} begin x[i]:= random(20) - 10; y[i]:= random(20) - 10; end; for i:= 3 to n do {перебираем точки} begin writeln('Koordinaty treugolnika ', i-2, ': ', x[1]:4, y[1]:4, x[2]:4, y[2]:4, x[i]:4, y[i]:4); temp:= square(x[1], y[1], x[2], y[2], x[i], y[i]); writeln('Square of treugolnik ', i-2, ' = ', temp:10:2); writeln; end; readln; end.

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

Вопрос № 155.484

Здравствуйте очень нужна ваша помощь.....зачёт уже завтра вот задача: Даны квадратные матрицы A, B и С порядка n. Получить матрицу (A+B)*C

Отправлен: 23.12.2008, 14:10 Вопрос задал: Никитин Иван Сергеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 12)

Отвечает: Шичко Игорь Здравствуйте, Никитин Иван Сергеевич! Предлагаю Вам вариант решения. Код в приложении Приложение: const n = 5; var a, b, c, summ, p: array[1..n, 1..n] of integer; i, j, st: integer; begin randomize; writeln('Matrics A'); {заполнение матриц случайными числами} for i:= 1 to n do begin for j:= 1 to n do begin a[i, j]:= Round(Random(10)-5); write(a[i,j]:5); end; writeln; end; writeln('Matrics B'); for i:= 1 to n do begin for j:= 1 to n do begin b[i, j]:= Round(Random(10)-5); write(b[i,j]:5); end; writeln; end; writeln('Matrics C'); for i:= 1 to n do begin for j:= 1 to n do begin c[i, j]:= Round(Random(10)-5); write(c[i,j]:5); end; writeln; end; writeln('Matrics A+B'); {вычисление матрицы А+В} for i:= 1 to n do begin for j:= 1 to n do begin summ[i,j]:= a[i,j] + b[i,j]; write(summ[i,j]:5); end; writeln; end; writeln('Matrics (A+B) * C'); {вычисление итоговой матрицы} for i:= 1 to n do begin for j:= 1 to n do begin p[i,j]:= 0; for st:= 1 to n do p[i,j]:= p[i,j] + summ[i,st]* c[st,j]; write(p[i,j]:5); end; writeln; end; readln; end.

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

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