Автоматическое растормаживание колес: Тормозные устройства колес предназначены для уменьшения длины пробега и улучшения маневрирования ВС при...
Архитектура электронного правительства: Единая архитектура – это методологический подход при создании системы управления государства, который строится...
Топ:
Теоретическая значимость работы: Описание теоретической значимости (ценности) результатов исследования должно присутствовать во введении...
Определение места расположения распределительного центра: Фирма реализует продукцию на рынках сбыта и имеет постоянных поставщиков в разных регионах. Увеличение объема продаж...
Процедура выполнения команд. Рабочий цикл процессора: Функционирование процессора в основном состоит из повторяющихся рабочих циклов, каждый из которых соответствует...
Интересное:
Уполаживание и террасирование склонов: Если глубина оврага более 5 м необходимо устройство берм. Варианты использования оврагов для градостроительных целей...
Распространение рака на другие отдаленные от желудка органы: Характерных симптомов рака желудка не существует. Выраженные симптомы появляются, когда опухоль...
Национальное богатство страны и его составляющие: для оценки элементов национального богатства используются...
Дисциплины:
2018-01-04 | 262 |
5.00
из
|
Заказать работу |
|
|
Unit Z433_7;
interface
Const n = 3, m = 4;
Type matr = array[1..n,1..m] of real;
mas = array[1..m] of real;
procedure p1(A:matr; Var S:mas); {записывает в массив S суммы элементов столбцов}
procedure p2(S:mas; Var nom:integer); {l - минимальный элемент массива S}
procedure p3(A:matr; l1,l2:integer; Var sum:real);
implementation
procedure p1;
Var i,j:integer;
Begin for j:= 1 to m do
Begin S[j]:= 0;
for i:= 1 to n do
S[j]:= S[j] + A[i,j];
end;
end; {p1}
procedure p2;
Var j:integer;
Smin:real;
Begin Smin:= S[1];
nom:= 1;
for j:= 1 to m do
if S[j] < Smin then
Begin Smin:= S[j];
nom:= j;
end;
end; {p2}
procedure p3;
Var i,j:integer;
Begin sum:= 0;
for i:= 1 to n do
for j:= l[1] to 1[2] do
sum:= sum + A[i,j];
end; {p3}
end.
program z433_7;
uses 433_7;
const n = 3, m = 4;
Type matr = array[1..n,1..m] of real;
mas = array[1..m] of real;
Var A:matr; S:mas; i,j,k,nom:integer; sum1,sum2:real;
Begin for i:= 1 to n do
for j:= 1 to m do readln(A[i,j]);
readln(k);
p1(A,S); p2(S,nom);
if (nom = k) then
Begin p3(A,1,k,sum1);
Writeln (sum1)
end else
Begin p3(A,k+1,m,sum2);
writeln(sum2);
end;
end.
Если целочисленная квадратная матрица симметрична относително
Главной диагонали, обнулить все элементы, лежащие выше главной
Диагонали, и определить сумму элементов, лежащих ниже
Главной диагонали.
program z433_8;
uses Z433_8;
Var A:matr;
i,j,s:integer;
BEGIN
for i:= 1 to n do
for j:= 1 to n do
readln(A[i,j]);
if Sim(A) then
Begin
NulSum(A,s);
write('Сумма элементов, лежащих ниже главной диагонали: ');
writeln(s);
end
else writeln('Матрица не симметрична относительно главной диагонали.');
for i:= 1 to n do
Begin
for j:= 1 to n do
write(A[i,j],' ');
writeln;
end;
END.
Unit Z433_8;
interface
Const n = 3;
Type matr = array[1..n,1..n] of integer;
function Sim(A:matr):boolean;
{Возвращает true, если матрица симметрична относительно главной диагонали}
procedure NulSum(Var A:matr; Var s:integer);
{Обнуляет элементы, лежащие выше главной диагонали, и подсчитывает их сумму}
implementation
function Sim(A:matr):boolean;
Var i,j,k:integer;
b:boolean;
Begin
k:= 0;
b:= true;
for i:= 1 to n do
for j:= 1 to n do
if (j < i) and (A[i,j] <> A[j,i]) then k:= k + 1;
if k <> 0 then b:= false;
Sim:= b;
end; {Sim}
procedure NulSum(Var A:matr; Var s:integer);
|
Var i,j:integer;
Begin
s:= 0;
for i:= 1 to n do
for j:= 1 to n do
if j > i then
Begin
s:= s + A[i,j];
A[i,j]:= 0;
end;
end; {NulSum}
END.
Переставить в каждом столбце прямоугольной матрицы
Все отрицательные элементы в конце столбца. Распечатать
Часть полученной матрицы, состоящую из n первых строк,
Не имеющих отрицательных элементов.
program z433_9;
uses Z433_9;
Var A:matr;
i,j,l:integer;
BEGIN
for i:= 1 to n do
for j:= 1 to m do
readln(A[i,j]);
Transpos(A,l);
if l > 0 then PrintL(A,L)
else writeln('Ненулевых строк нет.');
END.
Unit Z433_9;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of real;
procedure Transpos(Var A:matr; Var l:integer);
{Переставляет в каждом столбце матрицы A все отрицательные элементы в конец столбца, l - число строк с ненулевыми элементами}
procedure PrintL(A:matr; l:integer);
{печатает l первых строк матрицы A}
implementation
procedure Transpos(Var A:matr; Var l:integer);
Var i,j,k:integer;
r:real;
Begin
l:= 0;
for j:= 1 to m do
Begin
k:= 0;
for i:= 1 to n do
Begin
while A[n-k,j] < 0 do k:= k + 1;
if (A[i,j] < 0) and (i <= (n - k)) then
Begin
r:= A[i,j];
A[i,j]:= A[n-k,j];
A[n-k,j]:= r;
k:= k + 1;
end;
end;
if k > l then l:= k;
end;
l:= n - l;
end; {Transpos}
procedure PrintL(A:matr; l:integer);
Var i,j:integer;
Begin
for i:= 1 to l do
Begin
for j:= 1 to m do
write(A[i,j]:5:3,' ');
writeln;
end;
end; {PrintL}
END.
Если все точки плоскости, заданные своими координатами, попадают в круг с радиусом R и центром в начале координат, определить их среднюю абсциссу и ординату, иначе распечатать номера точек, не попавших в заданый круг.
Unit Z433_10;
interface
Const n = 5;
Type mass = array[1..n] of real;
function InArea(X,Y:mass; R:real):boolean;
{возвращает true, если все точки попали в круг радиусом R}
procedure SrZnach(A:mass; Var s:real);
{Вычисляет среднее значение массива A}
procedure PrintNum(X,Y:mass; R:real);
{Печатает номера точек, не попавших в круг радиусом R}
implementation
function InArea(X,Y:mass; R:real):boolean;
Var i:integer;
b:boolean;
Begin
b:= true;
i:= 0;
repeat i:= i + 1;
if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then b:= false
until (not b) or (i >= n);
InArea:= b;
end; {InArea}
procedure SrZnach(A:mass; Var s:real);
Var i:integer;
Begin
s:= 0;
for i:= 1 to n do
s:= s + A[i];
s:= s / n;
end; {SrZnach}
procedure PrintNum(X,Y:mass; R:real);
Var i:integer;
Begin
for i:= 1 to n do
if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then write(i,' ');
end; {PrintNum}
END.
program z433_10;
uses Z433_10;
Var X,Y:mass;
i:integer;
R,sx,sy:real;
BEGIN
for i:= 1 to n do
|
Begin
write('X: ');
readln(X[i]);
write('Y: ');
readln(Y[i]);
end;
write('R: ');
readln(R);
if InArea(X,Y,R) then
Begin
SrZnach(X,sx);
SrZnach(Y,sy);
writeln('A: ',sx,' O: ',sy)
end
else Begin
write('N: ');
PrintNum(X,Y,R);
end;
END.
Если столбцы заданной прямоугольной целочисленной матрицы расположены в порядке возрастания числа нулевых элементов в них, то подсчитать число нулевых элементов во всей матрице, иначе определить столбец с максимальным количеством нулей.
program z433_11;
uses Z12433_11;
Var A:matr;
S:mass;
i,j,ch,nmax:integer;
BEGIN
for i:= 1 to n do
for j:= 1 to m do
readln(A[i,j]);
NulS(A,S);
if Vozr(S) then
Begin
NulCh(S,ch);
write('ch: ');
writeln(ch);
end
else Begin
Maximum(S,nmax);
write('nmax: ');
writeln(nmax);
end;
END.
Unit Z433_11;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of integer;
mass = array[1..m] of integer;
procedure NulS(A:matr; Var S:mass);
{Записывает в массив S число нулей в каждом столбце}
function Vozr(S:mass):boolean;
{возвращает true, если в массиве S элементы расположены в порядке возрастания}
procedure NulCh(S:mass; Var ch:integer);
{ch - количество нулей в матрице}
procedure Maximum(S:mass; Var nmax:integer);
{nmax - номер столбца с максимальным количеством нулей}
implementation
procedure NulS(A:matr; Var S:mass);
Var i,j,k:integer;
Begin
for j:= 1 to m do
Begin
k:= 0;
for i:= 1 to n do
if A[i,j] = 0 then k:= k + 1;
S[j]:= k;
end;
end; {NulS}
function Vozr(S:mass):boolean;
Var i,k:integer;
b:boolean;
Begin
k:= 0;
for i:= 2 to m do
if S[i] > S[i-1] then k:= k + 1;
if k = m - 1 then b:= true
else b:= false;
Vozr:= b;
end; {Vozr}
procedure NulCh(S:mass; Var ch:integer);
Var i:integer;
Begin
ch:= 0;
for i:= 1 to m do
ch:= ch + S[i];
end; {NulCh}
procedure Maximum(S:mass; Var nmax:integer);
Var i,max:integer;
Begin
max:= S[1];
nmax:= 1;
for i:= 2 to m do
if S[i] > max then
Begin
max:= S[i];
nmax:= i;
end;
end; {Maximum}
END.
Если максимальный элемент квадратной матрицы находится выше главной диагонали, транспонировать матрицу,иначе определить сумму элементов строки и столбца с номерами, равными индексам максимального элемента.
program z433_12;
uses Z433_12;
Var A:matr;
i,j,k,l:integer;
b:boolean;
s:real;
BEGIN
for i:= 1 to n do
for j:= 1 to n do
readln(A[i,j]);
Maximum(A,k,l,b);
if b then
Begin
Transpos(A);
for i:= 1 to n do
Begin
for j:= 1 to n do
write(A[i,j]:5:3,' ');
writeln;
end; end
else Begin
Sum(A,k,l,s);
write('Сумма элементов строки и столбца, содержащих максимальный элемент: ');
writeln(s:5:3); end;END.
Unit Z433_12;
interface
Const n = 3;
Type matr = array[1..n,1..n] of real;
procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);
{b = true, если максимальный элемент матрицы находится выше главной диагонали, k,l - индексы максимального элемента}
procedure Transpos(Var A:matr);{Транспонирует матрицу}
procedure Sum(A:matr; k,l:integer; Var s:real);
{s - сумма элементов k-й строки и l-го столбца}
implementation
procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);
Var i,j:integer;
max:real;
|
Begin
k:= 1;l:= 1;
max:= A[1,1];
for i:= 1 to n do
for j:= 1 to n do
if A[i,j] > max then
Begin
max:= A[i,j];
k:= i;
l:= j;
end;
if l > k then b:= true
else b:= false;
end; {Maximum}
procedure Transpos(Var A:matr);
Var i,j:integer;
r:real;
Begin
for i:= 1 to n do
for j:= 1 to n do
if i > j then
Begin
r:= A[i,j];
A[i,j]:= A[j,i];
A[j,i]:= r;
end;end; {Transpos}
procedure Sum(A:matr; k,l:integer; Var s:real);
Var i:integer;
Begin
s:= 0;
for i:= 1 to n do
s:= s + A[i,l] + A[k,i];
s:= s - A[k,l];
end; {Sum}END.
|
|
Кормораздатчик мобильный электрифицированный: схема и процесс работы устройства...
Семя – орган полового размножения и расселения растений: наружи у семян имеется плотный покров – кожура...
Таксономические единицы (категории) растений: Каждая система классификации состоит из определённых соподчиненных друг другу...
История развития хранилищ для нефти: Первые склады нефти появились в XVII веке. Они представляли собой землянные ямы-амбара глубиной 4…5 м...
© cyberpedia.su 2017-2024 - Не является автором материалов. Исключительное право сохранено за автором текста.
Если вы не хотите, чтобы данный материал был у нас на сайте, перейдите по ссылке: Нарушение авторских прав. Мы поможем в написании вашей работы!