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

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

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

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

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

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

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

Выпуск № 859
от 21.04.2009, 16:05

Вопрос № 165048: Здравствуйте господа! Помогите в одной задачке. Необходимо поменять местами в матрице (квадратной) компоненты строки, содержащей максимум с компонентами столбца содержащего мтнимум. Заранее спасибо....

Вопрос № 165.048

Здравствуйте господа! Помогите в одной задачке. Необходимо поменять местами в матрице (квадратной) компоненты строки, содержащей максимум с компонентами столбца содержащего мтнимум. Заранее спасибо.

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

Отвечает: Proce Здравствуйте, Elkanv! Код программы в приложении. Программа не меняет местами только элемент стоящий на пересечении строки и столбца. Если этого не нужно то в части, где мы меняем массив удалите строку: 'if (i <> nCln) and (i <> nStr) then' в общем - как вам удобнее, такой вариант и оставьте. Приложение: program z_165048; const n = 5;{размерность матрицы} var A: array[1..n, 1..n] of integer; i, j, max, min, nCln, nStr: Integer; begin {ввод массива} for i := 1 to n do for j := 1 to n do begin write('[', i, ', ', j, ']= '); readln(A[i, j]); end; {вывод исходного массива} for i := 1 to n do begin for j := 1 to n do write(A[i, j]:5); writeln end; writeln; {нахождение минимума и максимума} max := A[1, 1]; min := A[1, 1]; nCln := 1; nStr := 1; for i := 1 to n do for j := 1 to n do if A[i, j] > max then begin max := A[i, j]; nStr := i; end else if A[i, j] < min then begin min := A[i, j]; nCln := j; end; {меняем местами} for i := 1 to n do if (i <> nCln) and (i <> nStr) then begin j := A[nStr, i]; A[nStr, i] := A[i, nCln]; A[i, nCln] := j; end; writeln('Minimum = ', min); writeln('Maximum = ', max); writeln; {вывод ризменённого массива} for i := 1 to n do begin for j := 1 to n do write(A[i, j]:5); writeln end; readln end.

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

Вопрос № 165.053

Здравствуйте! Нужна помощь! дали такую задачку, ничего понять не могу: 10- количество разрядов, 4-система исчисления. Условие отбора: Сумма цифр, стоящих на четных местах четна и в два раза больше суммы цифр, стоящих на нечетных местах.

Отправлен: 15.04.2009, 17:31 Вопрос задала: Улитина Наталья Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Proce Здравствуйте, Улитина Наталья Владимировна! Код программы в приложении. Если что-нибудь будет непонятно пишите на мини-форум. Приложение: program z_165053; const S = 4; N = 10; type TArray = array [1..N] of 0..S-1; var A: TArray; function proverka(var A: TArray):Boolean; var SumCh, SumNCh, i: Integer; begin SumCh := 0; SumNCh := 0; for i := 1 to N do if (i mod 2) = 0 then SumCh := SumCh + A[i] else SumNCh := SumNCh + A[i]; if ((SumCh mod 2) = 0) and (SumCh = SumNCh*2) then proverka := true else proverka := false end; procedure print(var A: TArray); var i: Integer; begin for i := 1 to N do write(A[i]); writeln end; procedure proc(var A: TArray; k: Integer); var i: Integer; begin if k > n then begin if Proverka(A) then print(A); end else for i := 0 to S - 1 do begin A[k] := i; proc(A, k + 1); end; end; begin proc(A, 1); readln end.

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

Вопрос № 165.061

Даны две действительные квадратные матрицы порядка n получить новую матрицу. Прибавление к элементам каждого столбца первой матрицы праизведение элементов соответствующих столбцов второй матрицы .

Отправлен: 15.04.2009, 18:54 Вопрос задала: Султанов Канат Калдарбекович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Mixala Здравствуйте, Султанов Канат Калдарбекович! Насколько я понял каждый элемент новой матрицы будет равен аналогичному элементу первой матрицы + произведение элементов столбца с номером, равным номеру строки первой, второй матрицы. Приложение: const nmax=100; var i,j,n,k:integer; a,b,c:array[1..nmax,1..nmax] of real; t:real; begin Read(n); For i:=1 to n do For j:=1 to n do begin //формирование матриц - либо случайно, либо с клавиатуры( в комментах ) a[i,j]:=random(n); b[i,j]:=random(n); // Read(a[i,j]); // Read(b[i,j]); end; For i:=1 to n do for j:=1 to n do begin t:=1; for k:=1 to n do //считаем произведение эл-в столбца j t:=t*b[j,k]; c[i,j]:=a[i,j]+t; end; For i:=1 to n do begin for j:=1 to n do Write(c[i,j],' '); WriteLn; end; end.

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

Вопрос № 165.065

как менять язык в паскале до переустановки все норм было шифт и контрол а щас не пашет

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

Отвечает: Тимошенко Дмитрий Здравствуйте, Глазырин Александр! Меня самого достал этот вопрос, но на Pascale теперь приходится писать не часто, так что разобраться руки, что называется, "не доходили". Вот в связи с вашим вопросом решил для себя эту проблему. Надо добавить досовский русификатор в autoexec.nt, например unikbd, keyrus или штатный из windows keyb (kb16). Поиск по "kb16 windows xp" мне помог, поможет и вам.

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

Вопрос № 165.068

Здравствуйте уважаемые Эксперты, помогите пожалуйста с решением одной задачки: Написать программу для вычисления определенного интеграла указанными методами 5 ∫----------------- dx, 0 x√x+4 метод трапеций, прямоугольников Очень надеюсь на вашу помощь. Заранее спасибо.

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

Отвечает: Proce Здравствуйте, Lexx1841! Код в приложении. Будут вопросы - пишите в мини-форуме. Приложение: program z_165068; const a = 0;{нижний предел интегрирования} b = 5;{верхний предел интегрирования} n = 100;{точность, чем больше n - тем точнее вычисление интеграла} function f(x: real): real; {вычисление значения подинтегральной функции} begin f := 1/(x*sqrt(x)+4); end; function IntegralTrap(a, b: real): real; {вычисление интеграла методом трапеций} var h, k, s: real; i: Integer; begin h := (b - a)/N; s := (f(a) + f(b))/2; for i := 1 to N - 1 do begin k := k + h; s := s + f(k); end; s := s*h; IntegralTrap := s; end; function IntegralRect(a, b: real): real; {вычисление интеграла методом прямоугольников} var h, k, s: real; i: Integer; begin h := (b - a)/N; s := 0; k := a; for i := 0 to N - 1 do begin s := s + f(k); k := k + h; end; s := s*h; IntegralRect := s; end; begin writeln('Metodom Trapecij = ', IntegralTrap(a, b):0:5); writeln('Metodom Priamougoljnikov = ', IntegralRect(a, b):0:5); readln end.

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

Вопрос № 165.107

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

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

Отвечает: Чичерин Вадим Викторович Здравствуйте, Ложкин Иван Дмитриевич! Массив зададим A(8,8). Количество будем складывать в переменную Count. Для цикла используем переменные x и y. Переменная p - для определения, есть ли ноль в массиве. Умножение на ноль дает ноль... Можно использовать сравнение... Приложение: program array88; uses crt; var a : array [1..8,1..8] of integer; x,y,count : byte; p : integer; begin randomize; for x := 1 to 8 do begin for y := 1 to 8 do begin a[x,y] := round(random(10)); write(a[x,y]); write(' '); end; writeln; end; count := 0; for x := 1 to 8 do begin p := 1; for y := 1 to 8 do p := p*a[y,x]; if p= 0 then count := count + 1; end; writeln; writeln(count); end. --------- Чем больше я смотрюсь в зеркало, тем больше верю Дарвину...

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

Отвечает: Proce Здравствуйте, Ложкин Иван Дмитриевич! Вот мой вариант решения задачи. В предыдущем ответе, при работе программы может много раз повторяться тело цикла по перебору элементов столбца, поэтому я заменил цикл for циклом с условием. Ведь если мы при поиске нашли ноль, то дальше в этом столбце нам искать нули уже нет никакой необходимости. Приложение: program z_165107; const N = 8; var A: array [1..N,1..N] of Integer; i, j, count: Integer; flag: Boolean; begin randomize; for i := 1 to N do begin for j := 1 to N do begin a[i, j] := random(10); write(a[i, j]:5); end; writeln; end; writeln; count := 0; for i := 1 to N do begin flag := true; j := 1; while flag and (j <= N) do begin flag := not (a[j, i] = 0); j := j + 1; end; if not flag then count := count + 1; end; writeln(count); readln end.

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

Вопрос № 165.111

Извиняюсь за столь частое обращение к вам, но мне опять нужна помощь. В одномерном массиве, состоящем из 35 вещественных элементов вычислить: а) сумму положительных элементов массива. б) произведение элементов, расположенных между максимальным по модулю и минимальным по модулю элементов. Огромное спасибо.

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

Отвечает: Proce Здравствуйте, Ложкин Иван Дмитриевич! Код в приложении. Приложение: program z_165111; const N = 35; var A: array [1..N] of real; i, nMax, nMin : Integer; sum, Min, Max: Real; begin Randomize; for i := 1 to N do begin A[i] := (100 - random(200))/10; writeln(A[i]:0:2); end; min := abs(A[1]); max := abs(A[1]); nMax := 1; nMin := 1; if A[1] > 0 then sum := A[1] else sum := 0; for i := 2 to N do begin if A[i] > 0 then sum := sum + A[i]; if abs(A[i]) > max then begin max := A[i]; nMax := i; end else if abs(A[i]) < min then begin min := A[i]; nMin := i; end; end; writeln('Summa = ', sum:0:2); if nMin > nMax then begin i := nMin; nMin := nMax; nMax := i end; sum := 0; if nMax - nMin > 1 then begin sum := 1; for i := (nMin + 1) to (nMax - 1) do sum := sum*A[i]; end; writeln('Proizvedenie = ', sum:0:5); readln end.

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

© 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