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

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

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

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

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

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

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

Выпуск № 772
от 01.01.2009, 18:35

Вопрос № 155916: Составить под-программу, которая в целочисленной квадратной матрице находит максимальный элемент в закрашенной чёрным области: <img src="http://rusfaq.ru/thumb.cgi?s=http://s51.radikal.ru/i134/0812/05/1f418befc802.jpg&r=1&w=600" border="0" class="pic...

Вопрос № 155.916

Составить под-программу, которая в целочисленной квадратной матрице находит максимальный элемент в закрашенной чёрным области: . В основной программе обработать 2 массива. Для ввода массивов использовать подпрограмму.

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Пилин Денис Александрович! Решение задачи в приложении. Приложение: uses crt; type Tmatr=array[1..20,1..20]of integer; procedure Vvod(k:integer;var x:Tmatr);{процедура ввода элементов макрицы с клавиатуры} var i,j:integer; begin writeln('Vvedite ',k*k,' elementov matricy:'); for i:=1 to k do for j:=1 to k do read(x[i,j]); readln; end; procedure Vyvod(k:integer;var x:Tmatr);{процедура вывода отфарматированной матрицы на экран} var i,j:integer; begin clrscr; for i:=1 to k do begin for j:=1 to k do write(x[i,j]:4); writeln; end; end; function MaxVrTr(k:integer;x:Tmatr):integer;[определение максимального в указанной области матрицы} var i,j,max:integer; begin max:=x[1,1]; for i:=1 to k do for j:=1 to k do if (j>=i)and(j<=k-i+1)and (x[i,j]>max) then max:=x[i,j]; MaxVrTr:=max; end; var a,b:Tmatr; {раздел переменных программы} n,m:integer; begin {начало программы} clrscr; write('Vvedite razmernost matricy A n=');readln(n); Vvod(n,a); {вызов процедур} Vyvod(n,a); writeln('Max v verh treug=',MaxVrTr(n,a)); {вызов функции} write('Vvedite razmernost matricy B m=');readln(m); Vvod(m,b); Vyvod(m,b); writeln('Max v verh treug=',MaxVrTr(m,b)); readln end.

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

Вопрос № 155.931

Дана матрица, в каждой строке найти минимальный элемент и вывести его индексы

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

Отвечает: Emmanuel Goldstein Здравствуйте, Иванов Виктор Олегович! Решение в приложении. Приложение: program massiv; type matrix = array [1..4, 1..4] of integer; var s: matrix; i, j: integer; function min(s: matrix; i: integer): integer; //Находим минимальное значение var //элемента в строчке и возвращаем q, w, e: integer; //его порядковый номер begin //s - матрица i - строка в матрице w := s[1][i]; e := 1; for q := 1 to 4 do //Перебираем все элементы в строке if w > s[q][i] then begin //Находим минимальный и попутно w := s[q][i]; //сохраняем его индекс e := q; end; min := e; //Найдя минимальный элемент, возвращаем его индекс end; begin for i := 1 to 4 do //заполняем массив строчками вида 1234 for j := 1 to 4 do s[i][j] := j; for i := 1 to 4 do //выводим на экран, перебирая строчки begin Write(min(s, i)); Write(', '); WriteLn(i); end; end. --------- Основное правило хакера: "Научился сам, научи другого".

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

Вопрос № 155.949

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

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

Отвечает: Emmanuel Goldstein Здравствуйте, Thalmonzar! Решение в приложении. Программа тестировалась в FreePascal Приложение: program _155949; type stroka = array [1..10] of char; var s: stroka; //строка pos: integer = 1; //Позиция, с которой начинается замена i: integer; mir: integer = 0; //Число нулей в результате procedure mirror(var s: stroka); var q: integer; w: char; begin for q := 1 to 5 do //Перебираем строку до половины begin w := s[q]; //Первый заносим в буфер s[q] := s[11 - q]; //В первый заносим последний s[11 - q] := w; //В последний заносим первый из буфера end; end; begin s := '1001010101'; //Строка (могут быть и другие символы for i := pos to 10 do //перебираем все элементы if s[i] = '0' then s[i] := '1'// ноль заменяем на единицу else if s[i] = '1' then begin s[i] := '0'; //Единицу заменяем на ноль и увеличиваем inc(mir); //счетчик нулей на 1 end; if mir mod 2 = 0 then mirror(s); //если остаток от деления //счетчика на 2 - ноль, т.е writeln(s); //четное - отражаем элементы строки //и выводим на экран end. --------- Основное правило хакера: "Научился сам, научи другого".

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

Вопрос № 155.978

Здравствуйте! Пожалуйста, составьте программу вычисления максимальной компоненты вектора Х размерностью п. Заранее спасибо!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Blagodar! Решение этой наипростейшей задачи в приложении. Приложение: uses crt; const n=15; var x:array[1..n]of real; i:integer; max:real; begin clrscr; randomize; writeln('Vector X:'); max:=-100; for i:=1 to n do begin x[i]:=10*random; if x[i]>max then max:=x[i]; write(x[i]:5:2); end; writeln; write('Max=',max:0:2); readln end.

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

Вопрос № 155.979

Здравствуйте! Пожалуйста, составьте программу умножения квадратной матрицы А на 2ю Заранее спасибо!

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Blagodar! Решение задачи в приложении. Приложение: uses crt; const n=5; var a,b,c:array[1..n,1..n] of integer; i,j,k:byte; begin clrscr; randomize; writeln('Matrica A:'); for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); write(a[i,j]:3); end; writeln; end; writeln('Matrica B:'); for i:=1 to n do begin for j:=1 to n do begin b[i,j]:=random(10); write(b[i,j]:3); end; writeln; end; {Umnozenie matricy A*B} for k:=1 to n do for j:=1 to n do begin c[k,j]:=0; for i:=1 to n do begin c[k,j]:=c[k,j]+a[k,i]*b[i,j]; end; end; writeln('Matrica C=A*B:'); for i:=1 to n do begin for j:=1 to n do write(c[i,j]:5); writeln; end; readln end.

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

Вопрос № 155.994

Уважаемые эксперты у меня глупый вопрос как грамотно называются две точки в Pascal в операторе case которые между 1 и 7. ниже пример Приложение: case f of 1..7:Begin

Отправлен: 27.12.2008, 14:49 Вопрос задал: WiniHakStyle (статус: 4-й класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Николай // Programmator Здравствуйте, WiniHakStyle! Как такового, названия в книгах я не встречал, но можно сказать, что это двоеточие, которое устанавливается между двумя значениями селектора и предназначено для установки диапазона вариантов, в даном случае это от 1 к 7. Удачи Вам!!!

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

Вопрос № 155.997

Помогите составить программу где нужно, удвоить все согласные буквы.

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

Отвечает: Mixala Здравствуйте, Иванов Виктор Олегович! ну можно просто перебирая буквы. я сделал только для маленьких англ и русских. если буква согл. , то она просто запоминается два раза Приложение: var s,st:string; i,n:integer; q:set of char=('q','w','r','t','p','s','d','f','g','h','k','l','z','x','c','v','b','n','m','й','ц','к','н','г','ш','щ','з','х','ф','в','п','д','ж','ч','с','м','т','б'); begin Read(s); n:=0; for i:=1 to length(s) do begin if s[i] in q then st:=st+s[i]; st:=st+s[i]; end; Write(st); end.

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

Вопрос № 156.004

Дан символ. Вставить его после каждого вхождения ‘symbol’ в строке S.

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

Отвечает: Boriss Здравствуйте, Иванов Виктор Олегович! Вот решение Вашей задачи. Закомментировал часть для ввода с клавиатуры Приложение: uses CRT; CONST ins: String = 'symbol'; VAR S, buf : String; ch: Char; i, len : Integer; BEGIN { WriteLn('Введите строку:'); ReadLn(S); Write('Введите символ: '); repeat ch := ReadKey; until (ch > ' ') and (ch <= 'я'); } S :='symbol sdfasymbolsymbol smb'; WriteLn(S); ch :='ш'; len := length(ins); buf := ''; repeat i := pos(ins, S); if i = 0 then begin buf := buf + copy(S, 1, 255); Break; end; buf := buf + Copy(S, 1, i+len-1) + ch; Delete(S, 1, i+len-1); until FALSE; S := buf; WriteLn(S); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 27.12.2008, 20:57 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 239816 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Огромное спасибо! Все работает =)

Вопрос № 156.006

Дано натуральное число n. Вычислить произведение первых n сомножителей. 2/1 * 2/3 * 4/3 * 4/5 * 6/5 * 6/7 ....

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

Отвечает: Mixala Здравствуйте, Иванов Виктор Олегович! вот мой вариант, должно работать, ответ будет вещественный Приложение: var i,n:integer; s:real; begin Read(n); i:=2; s:=1; while i<n do begin s:=s*i/(i-1)*i/(i+1); i:=i+2; end; Write(s); end.

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

Вопрос № 156.019

Помошите пожалуйста решить задачу. Вычислить сумму элементов матрицы (выделены символом X) 1________________M __+---------------- -----+ 1_I\_____________/I __IXX\_________/XXI __IXXXX\_____/XXXXI __IXXXXXX\_/XXXXXXI __IXXXXXX/_XXXXXXI __IXXXX/_____XXXXI __IXX/_________XXI N_I/_____________I __+---------------------+

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

Отвечает: Пупорев Юрий Борисович Здравствуйте, Stayer! Решение задачи в приложении. Там просто операторами i,j,n описывается эта область. Приложение: uses crt; var a:array[1..20,1..20] of integer; n,i,j:byte; sm:integer; begin clrscr; randomize; write('n=');readln(n); sm:=0; for i:=1 to n do begin for j:=1 to n do begin a[i,j]:=random(10); if ((i>j)and(i>n-j+1)) or ((j>i)and(j<n-i+1)) then sm:=sm+a[i,j]; write(a[i,j]:3); end; writeln; end; write('Summa=',sm); readln end.

Ответ отправил: Пупорев Юрий Борисович (статус: Специалист) Ответ отправлен: 28.12.2008, 20:34 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 239900 на номер 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