Ответы: 3рк матрицы
Описание
Характеристики ответов (шпаргалок)
Список файлов
- Матрицы с условием
- matr.txt 1,04 Kb
- mptr2.txt 1,17 Kb
- Задача 1 (найти сумму мин и макс на побочной диаг и поделить всю матрицу на эту сумму).txt 1,35 Kb
- Задача 10 (перестановка наибольшего и наименьшего элемента в каждом столбце).txt 1,4 Kb
- Задача 11 (умножение каждого столбца на макс элемент этого столбца).txt 1,23 Kb
- Задача 12 (поменять макс элемент каждый строки с 1ым элементом (например)).txt 1,19 Kb
- Задача 13 (найти мин элемент и поделить на него всю матрицу).txt 1,38 Kb
- Задача 14 (убрать столбец с минималным элементом на побочной диагонали).txt 1,61 Kb
- Задача 15 (умножить четные столбцы на сумму мин и макс матрицы).txt 1,16 Kb
- Задача 16 (Максимальный элемент всей матрицы).txt 740 b
- Задача 17 (Поиск отрицательных элементов и запись их в отдельный массив).txt 760 b
- Задача 18 (Сумма, произведение и т.п.).txt 3,04 Kb
- Задача 2 (каждый элемент строки делится на макс элемент этой строки).txt 1,15 Kb
- Задача 4 (умножить числа главной диагонали на кол-во четных элементов всей матрицы).txt 1,06 Kb
- Задача 5 (найти в каждой строке ср арифметическое и из них массив).txt 1,02 Kb
- Задача 6 (умножить числа главной диагонали на кол-во нечетных элементов).txt 1,11 Kb
- Задача 7 (все элементы матрицы делятся на минимальный главной диагонали).txt 1,2 Kb
- Задача 8 (создать новую матрицу без столбца с мин элементом).txt 1,46 Kb
- Задача 9 (удалить столбец, содержащий мин элемент побочной диагонали).txt 1,34 Kb
- Матр3.txt 0 b
- Новый текстовый документ.txt 1,01 Kb
- двумерки.txt 3,34 Kb
- задача 3 (найти макс элемент на главной диагонале, удаляет строку с макс).txt 1,24 Kb
type mas=array[1..30,1..20] of integer;
Tmas=array[1..30] of real;
procedure VVOD (var a:mas;var n,m:byte);
var i,j:integer;
begin
//repeat
writeln('VVedite kolichestvo strok');
readln(n);
writeln('Vvedite kolichestvo stolbzov');
readln(m);
//until n=m;
writeln('Vvedite matrizu');
for i:=1 to n do
begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure proizv (var b:Tmas; a:mas; n,m:byte);
var
s,i,j:integer;
begin
for i:=1 to m do
begin
s:=0;
for j:=1 to n do
s:=s+a[i,j];
b[i]:=s;
//writeln('ctr s= ',s);
end;
end;
procedure VIVOD (a:mas;n,m:byte);
var i,j:integer;
begin
for i:=1 to n do
begin
for j:=1 to m do
write (a[i,j],' ');
writeln;
end;
end;
procedure vivod2 (n:byte;b:Tmas);
var
i:byte;
begin
for i:=1 to n do
write (b[i]:4:0,' ');
writeln;
end;
var A:mas;
b:Tmas;
n,m:byte;
begin
VVOD(A,n,m);
proizv(b,A,n,m);
writeln('Poluchennaya matriza');
VIVOD(A,n,m);
writeln ('now massiv');
vivod2 (n,b);
readln;
end.
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov <=15');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure sum (var a:mas;n:integer);
var i,j,s:integer;
begin
s:=0;
for i:=1 to n do
for j:=1 to n do
if (i=j) then s:=s+a[i,j];
writeln ('summa glavnoi = ',s);
end;
procedure sum2 (var a:mas;n:integer);
var i,j,s2:integer;
begin
s2:=0;
for i:=1 to n do
for j:=1 to n do
if (n+1-i=n+1-j) then s2:=s2+a[i,j];
writeln ('summa pobochnoi = ',s2);
end;
procedure VIVOD (a:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (a[i,j],' ');
writeln;
end;
end;
var M:mas;
s,s2,n:integer;
begin
VVOD(M,n);
writeln('Poluchennaya matriza');
VIVOD(M,n);
sum(M,n);
sum2(M,n);
readln;
if s>s2 then
writeln ('summa glavnoi bolshe');
if s<s2 then
writeln ('summa pobochnoi bolshe');
if s=s2 then
writeln ('summa pobochnoi ravna summe glavnoi');
end.
1) в матрице найти минимальный и максимальный элементы побочной диагонали, поделить все элементы на их сумму (используя процедуру/функцию)
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of double;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (a:mas;n:integer;var sum:double);
var i,j:integer;
min,max:double;
begin
min:=a[1,n];
for i:=1 to n do if a[i,n+1-i]<min then min:=a[i,n+1-i];
max:=a[1,n];
for i:=1 to n do if a[i,n+1-i]>max then max:=a[i,n+1-i];
sum:=min+max;
writeln('Min element pobochnoi diag ',min:0:0);
writeln('Max element pobochnoi diag ',max:0:0);
writeln('Cymma ',sum:0:0);
end;
procedure DELENIE (a:mas;n:integer;sum:double;var c:mas);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do c[i,j]:=a[i,j]/sum;
end;
end;
procedure VIVOD (c:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (c[i,j]:1:1,' ');
writeln;
end;
end;
var M,K:mas;
n:integer;
summa:double;
begin
VVOD(M,n);
POISK(M,n,summa);
DELENIE(M,n,summa,K);
VIVOD(K,n);
readln;
end.
10) квадратная матрица, надо написать процедуру перестановки наибольшего и наименьшего элементов в каждом столбце и процедуру вывода/ввод в основной программе
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n:integer);
var i,j,min,max,imin,imax,buf:integer;
begin
for j:=1 to n do begin
min:=a[1,j];
imin:=1;
for i:=1 to n do if a[i,j]<min then begin
min:=a[i,j];
imin:=i;
end;
max:=a[1,j];
imax:=1;
for i:=1 to n do if a[i,j]>max then begin
max:=a[i,j];
imax:=i;
end;
a[imax,j]:=min;
a[imin,j]:=max;
end;
end;
procedure VIVOD (a:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (a[i,j],' ');
writeln;
end;
end;
var A:mas;
n:integer;
begin
VVOD(A,n);
POISK(A,n);
writeln('Poluchennaya matriza');
VIVOD(A,n);
readln;
end.
11) матрицу n x m чтоб н<=10 м<=12 вещественных чисел.
Создать проедуру обработки матрицы чтобы она находила в каждом столбце максимальный элемент и умножала этот столбец на максимальный элемент своего столбца. Вывод матрицв сделать в основной программе
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..10,1..12] of double;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
repeat
writeln('VVedite kolichestvo strok');
readln(n);
until n<=10;
repeat
writeln('VVedite kolichestvo stolbzov');
readln(m);
until n<=12;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n,m:integer);
var i,j:integer;
max:double;
begin
for j:=1 to m do begin
max:=a[1,j];
for i:=1 to n do if a[i,j]>max then max:=a[i,j];
for i:=1 to n do a[i,j]:=a[i,j]*max;
end;
end;
procedure VIVOD (a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j]:1:1,' ');
writeln;
end;
end;
var A:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m);
writeln('Poluchennaya matriza');
VIVOD(A,n,m);
readln;
end.
12) в строках матрицы - найти макс и поменять местами с чем-то
(я меняла для разнообразия с первым элементом)
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..20] of integer;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok');
readln(n);
writeln('VVedite kolichestvo stolbzov');
readln(m);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n,m:integer);
var i,j,max,kol,jmax:integer;
begin
for i:=1 to n do begin
max:=a[i,1];
jmax:=1;
for j:=1 to m do if a[i,j]>max then begin
max:=a[i,j];
jmax:=j;
end;
a[i,jmax]:=a[i,1];
a[i,1]:=max;
end;
end;
procedure VIVOD (a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j],' ');
writeln;
end;
end;
var A:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m);
writeln('Poluchennaya matriza');
VIVOD(A,n,m);
readln;
end.
13) В матрице 12х15 найти минимальный элемент в матрице. Поделить всю матрицу на этот элемент , если он = 0 , не изменить матрицу. Использовать процедуру. Вывести исходную матрицу и полученную в основной программе
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..12,1..15] of double;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
repeat
writeln('VVedite kolichestvo strok');
readln(n);
until n<12;
repeat
writeln('VVedite kolichestvo stolbzov');
readln(m);
until m<15;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (a:mas;n,m:integer;var b:mas);
var i,j:integer;
min:double;
begin
min:=a[1,1];
for i:=1 to n do begin
for j:=1 to m do if a[i,j]<min then min:=a[i,j];
end;
for i:=1 to n do begin
for j:=1 to m do begin
b[i,j]:=a[i,j];
b[i,j]:=b[i,j]/min;
end;
end;
end;
procedure VIVOD (a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j]:1:1,' ');
writeln;
end;
end;
var A,B:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m,B);
writeln('Isxodnaya matriza');
VIVOD(A,n,m);
writeln('Poluchennaya matriza');
VIVOD(B,n,m);
readln;
end.
14) Задана квадратная матрица А(n,n) n<=10. вещественных чисел.Написать процедуру новой матрицы путем вычеркивания солбца, где расположен минимальный элемент ПОБОЧНОЙ диагонали исходной матрицы.считать элемент единственный. В основной пограмме распечатать исходную и полученную матрицу.
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..10,1..10] of double;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
repeat
repeat
writeln('VVedite kolichestvo strok');
readln(n);
until n<=10;
repeat
writeln('VVedite kolichestvo stolbzov');
readln(m);
until m<=10;
until m=n;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (a:mas;n:integer;var b:mas;var m:integer);
var i,j,jmin:integer;
min:double;
begin
min:=a[1,m];
jmin:=m;
for i:=1 to n do if a[i,m+1-i]<min then begin
min:=a[i,m+1-i];
jmin:=m+1-i;
end;
for i:=1 to n do
for j:=1 to m do b[i,j]:=a[i,j];
for i:=1 to n do
for j:=jmin to m-1 do begin b[i,j]:=b[i,j+1];
end;
m:=m-1;
end;
procedure VIVOD (a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j]:1:1,' ');
writeln;
end;
end;
var A,B:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,B,m);
writeln('Isxodnaia matriza');
VIVOD(A,n,n);
writeln('Poluchennaya matriza');
VIVOD(B,n,m);
readln;
end.
15) в матрице прямоугольной элементы чётных столбов умножить на сумма минмального и максимального элемента всей матрицы
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..20,1..20] of integer;
procedure VVOD (var A:mas; var n,m:integer);
var i,j:integer;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
writeln('Vvedite kolichestvo stolbzov');
readln(m);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (var A:mas;n,m:integer);
var i,j,min,max,sum:integer;
begin
min:=a[1,1];
for i:=1 to n do
for j:=1 to m do if a[i,j]<min then min:=a[i,j];
max:=a[1,1];
for i:=1 to n do
for j:=1 to m do if a[i,j]>max then max:=a[i,j];
sum:=max+min;
for i:=1 to n do begin
for j:=1 to m do if (j mod 2) = 0 then a[i,j]:=a[i,j]*sum;
end;
end;
procedure VIVOD (A:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j],' ');
writeln;
end;
end;
var n,m:integer;
A:mas;
begin
VVOD(A,n,m);
POISK(A,n,m);
VIVOD(A,n,m);
readln;
end.
program kvadratnaya_matriza;
{$APPTYPE CONSOLE}
uses
SysUtils;
var a:array[1..10,1..15] of integer;
i,j,n,max,imax,jmax:integer;
max2,imax2,jmax2:integer;
begin
{Задание матрицы}
writeln('Vvedite kol-vo strok/stolbzov');
readln(n);
writeln('Vvedite matrizy');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
{Перебрать все элементы матрицы и найти максимальный}
max:=a[1,1];
imax:=1;
jmax:=1;
for i:=1 to n do
for j:=1 to n do
if a[i,j]>max then
begin
max:=a[i,j];
imax:=i;
jmax:=j;
end;
writeln('Maksimalnii element ',max,' stoit v stroke ',imax,' i ',jmax,' stolbze');
readln;
program priamoygolnaya_matriza;
{$APPTYPE CONSOLE}
uses
SysUtils;
var a:array[1..10,1..15] of integer;
b:array[1..150] of integer;
i,j,n,m,otriz:integer;
begin
{Задание матрицы}
writeln('Vvedite kol-vo strok');
readln(n);
writeln('Vvedite kol-vo stolbzov');
readln(m);
writeln('Vvedite matrizy');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
otriz:=0;
for i:=1 to n do
for j:=1 to m do
if a[i,j]<0 then
begin
otriz:=otriz+1;
b[otriz]:=a[i,j];
end;
if otriz=0 then writeln('Otrizatelnix chisel net')
else begin writeln('Otrizatelnie elementi');
for i:=1 to otriz do write(b[i],' ');
writeln;
end;
readln;
program matriza;
{$APPTYPE CONSOLE}
uses
SysUtils;
var a:array[1..10,1..15] of integer;
b,nec:array[1..150] of integer;
i,j,n,m:integer;
sum,k:integer;
min,max,nmin,nstrmin,nmax,nstrmax,buf:in teger;
l:integer;
t,proizv:integer;
begin
writeln('Vvedite kolichestvo strok');
readln(n);
writeln('Vvedite kolichestvo stolbvoz');
readln(m);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
{symma i kolichestvo otrizatelnix elementov, novii massiv s nimi}
k:=0;
sum:=0;
for i:=1 to n do
for j:=1 to m do
if a[i,j]<0 then begin
k:=k+1;
b[k]:=a[i,j];
sum:=sum+a[i,j];
end;
if k=0 then writeln ('Net otrizatelnix elementov')
else begin writeln ('Otrizatelnie elementi');
for i:=1 to k do write (b[i],' ');
writeln;
writeln('kolichestvo otrizatelnix elementov ravno ',k,' ,ix summa ravna ',sum);
end;
{pomeniat mestami pervii minimalnii i poslednii maksimalnii}
min:=a[1,1];
nmin:=1;
nstrmin:=1;
for i:=1 to n do
for j:=1 to m do
if a[i,j]<min then begin
nstrmin:=i;
nmin:=j;
min:=a[i,j];
end;
writeln('Pervii minimalnii element ',min,' stoit v ',nstrmin,' stroke, v ',nmin,' stolbze');
max:=a[1,1];
nmax:=1;
nstrmax:=1;
for i:=1 to n do
for j:=1 to m do
if a[i,j]>=max then begin
nstrmax:=i;
nmax:=j;
max:=a[i,j];
end;
writeln('Posledii maksimalnii element ',max,' stoit v ',nstrmax,' stroke, v ',nmax,' stolbze');
buf:=a[nstrmax,nmax];
a[nstrmax,nmax]:=a[nstrmin,nmin];
a[nstrmin,nmin]:=buf;
writeln('Izmenennaya matriza');
for i:=1 to n do begin
for j:=1 to m do write(a[i,j],' ');
writeln;
end;
{kolichestvo necetnix elementov}
l:=0;
for i:=1 to n do
for j:=1 to m do
if (a[i,j] mod 2=1) or (a[i,j] mod 2=-1) then begin
l:=l+1;
nec[l]:=a[i,j];
end;
if l=0 then writeln ('Net nechetnix chisel')
else writeln ('Nechetnie chisla');
for i:=1 to l do write (nec[i],' ');
writeln;
{proizvedenie polozitelnix elementov}
t:=0;
proizv:=1;
for i:=1 to n do
for j:=1 to m do
if a[i,j]>0 then begin
t:=t+1;
proizv:=proizv*a[i,j];
end;
if (proizv=1) and (t=0) then writeln('Net polozitelnix elementov dlia naxogdenia proizvedenia')
else writeln('Proizvedenie ravno ',proizv)
readln;
end.
2) Матрица. Процедура: в строке находит максимальный элемент и делит каждый элемент на него. Если искомый элемент 0, то оставляет строку без изменений. В основной программе провести процедуру на всех строках.
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of double;
var M,K:mas;
n,i:integer;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK_Del (a:mas;n:integer;var c:mas);
var j:integer;
max,del:double;
begin
max:=a[i,1];
for j:=1 to n do if a[i,j]>max then max:=a[i,j];
for j:=1 to n do begin
del:=a[i,j]/max;
C[i,j]:=del;
end;
end;
procedure VIVOD (c:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (c[i,j]:1:1,' ');
writeln;
end;
end;
begin
VVOD(M,n);
for i:=1 to n do
POISK_Del(M,n,K);
writeln('Poluchennaya matriza');
VIVOD(K,n);
readln;
end.
4) Умножить все элементы главной диагонали квадратной матрицы на кол-во четных элементов всей матрицы. Вывести сообщение, если матрица не изменится.
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n:integer);
var i,j,max,kol:integer;
begin
kol:=0;
for i:=1 to n do
for j:=1 to n do
if (a[i,j] mod 2) = 0 then kol:=kol+1;
if kol=1 then writeln ('matriza ne izmenitsia')
else begin
for i:=1 to n do a[i,i]:=a[i,i]*kol;
end;
end;
procedure VIVOD (a:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (a[i,j],' ');
writeln;
end;
end;
var M:mas;
n:integer;
begin
VVOD(M,n);
POISK(M,n);
writeln('Poluchennaya matriza');
VIVOD(M,n);
readln;
end.
5) матрица m<30 n<20 найти в каждой строке среднее арифм и из этих этих ср.арифм создать массив
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..30,1..20] of integer;
massiv=array[1..30] of double;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok');
readln(n);
writeln('VVedite kolichestvo stolbzov');
readln(m);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (a:mas;n,m:integer;var b:massiv);
var i,j,sum:integer;
ar:double;
begin
for i:=1 to n do begin
sum:=0;
for j:=1 to m do sum:=sum+a[i,j];
ar:=sum/m;
b[i]:=ar;
end;
end;
procedure VIVOD (b:massiv;n:integer);
var i:integer;
begin
for i:=1 to n do write (b[i]:1:1,' ');
writeln;
end;
var A:mas;
b:massiv;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m,b);
writeln('Poluchennaya matriza');
VIVOD(b,n);
readln;
end.
6) матрица, главная диагональ, умножить все члены диагонали на колво нечетных в матрице, и если не изменится - вывести сообщение (теоретические вопросы в этом билете: оперативная память и условный оператор)
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n:integer);
var i,j,max,kol:integer;
begin
kol:=0;
for i:=1 to n do
for j:=1 to n do
if (a[i,j] mod 2) = 1 then kol:=kol+1;
if kol=1 then writeln ('matriza ne izmenitsia')
else begin
for i:=1 to n do a[i,i]:=a[i,i]*kol;
end;
end;
procedure VIVOD (a:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (a[i,j],' ');
writeln;
end;
end;
var M:mas;
n:integer;
begin
VVOD(M,n);
POISK(M,n);
writeln('Poluchennaya matriza');
VIVOD(M,n);
readln;
end.
7) дана квадратна матрица n<=10. Разработать процедуру, в которой все элементы матрицы делятся на минимальный элемент главной диагонали. В основной программе вывести преобразованную матрицу или сообщение , что преобразовать нельзя
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..10,1..10] of double;
procedure VVOD (var a:mas;var n:integer);
var i,j:integer;
begin
repeat
writeln('VVedite kolichestvo strok/stolbzov');
readln(n);
until n<=10;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n:integer);
var i,j:integer;
min:double;
begin
min:=a[1,1];
for i:=1 to n do if a[i,i]<min then min:=a[i,i];
if min=0 then writeln ('Preobrazovat nelzia')
else begin
for i:=1 to n do begin
for j:=1 to n do a[i,j]:=a[i,j]/min
end;
end;
end;
procedure VIVOD (a:mas;n:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to n do write (a[i,j]:1:1,' ');
writeln;
end;
end;
var M:mas;
n:integer;
begin
VVOD(M,n);
POISK(M,n);
writeln('Poluchennaya matriza');
VIVOD(M,n);
readln;
end.
8) найти минимальный эл в матрице запомнить этот слобец и записать все элементы в новую матрицу без этого столбца
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..10] of integer;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
writeln('VVedite kolichestvo strok');
readln(n);
writeln('VVedite kolichestvo stolbzov');
readln(m);
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure POISK (a:mas;n:integer;var m:integer;var b:mas);
var i,j,min,jmin:integer;
begin
min:=a[1,1];
jmin:=1;
for i:=1 to n do begin
for j:=1 to m do if a[i,j]<min then begin
min:=a[i,j];
jmin:=j;
end;
end;
writeln('Min el ',min,' stoit v stolbze ',jmin);
for i:=1 to n do
for j:=1 to m do b[i,j]:=a[i,j];
for i:=1 to n do begin
for j:=jmin to m-1 do begin
b[i,j]:=b[i,j+1];
end;
end;
m:=m-1;
end;
procedure VIVOD (b:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (b[i,j],' ');
writeln;
end;
end;
var A,B:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m,B);
writeln('Poluchennaya matriza');
VIVOD(B,n,m);
readln;
end.
9) дана квадратная матрица. Найти минимальный элемент побочной диагонали и удалить столбец его содержащий.
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
repeat
writeln('VVedite kolichestvo strok');
readln(n);
writeln('Vvedite kolichestvo stolbzov');
readln(m);
until n=m;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to n do read (a[i,j]);
readln;
end;
end;
procedure POISK (var a:mas;n:integer;var m:integer);
var i,j,min,jmin:integer;
begin
min:=a[1,n];
jmin:=n;
for i:=1 to n do begin
if a[i,n+1-i]<min then begin
min:=a[i,n+1-i];
jmin:=n+1-i;
end;
end;
writeln('min el ',min,' v ',jmin);
for i:=1 to n do begin
for j:=jmin to m-1 do begin
a[i,j]:=a[i,j+1];
end;
end;
m:=m-1;
end;
procedure VIVOD (a:mas;n,m:integer);
var i,j:integer;
begin
for i:=1 to n do begin
for j:=1 to m do write (a[i,j],' ');
writeln;
end;
end;
var A:mas;
n,m:integer;
begin
VVOD(A,n,m);
POISK(A,n,m);
writeln('Poluchennaya matriza');
VIVOD(A,n,m);
readln;
end.
По всей видимости файл пустой
program Project159;
{$APPTYPE CONSOLE}
uses
SysUtils;
type TMAS = array[1..100] of Integer;
procedure vvod (var n:Byte; var A:TMAS);
var i:Byte;
begin
Randomize;
writeln('Vvedite razmer massiva');
Readln(n);
//Writeln('ish massiv:');
for i:=1 to n do
A[i]:=random(100)-50;
{for i:=1 to n do
write(A[i]:2,', ');
readln; }
end;
procedure new (var k:Byte;A:TMAS; var B:TMAS; n:byte);
var i:Byte;
kol:integer;
s:integer;
sr:real;
Begin
s:=0;
for i:=1 to n do
//kol:=kol+1;
s:=s+a[i];
sr:=s/n ;
writeln ('sr = ',sr:4:2);
k:=0;
for i:=1 to n do
if a[i]> trunc(sr) then
begin
k:=k+1;
B[k]:=A[i];
end;
{for i:=1 to k do
write(B[i]:2,', ');
readln;
writeln ('kol ',kol:2,' elementov');
readln; }
End;
procedure vivod (n:byte;A:Tmas);
var
i:byte;
begin
for i:=1 to n do
write (a[i],' ');
writeln;
end;
var i:Byte;
A,B:tmas;
k,n:byte;
s:Integer;
begin
vvod(n,A);
vivod(n,A);
Writeln('nov Massiv:');
new(k,A,B,n);
vivod(k,b);
Readln;
end.
ДВУМЕРКИ
const n=10;
type
TMas=array [1..n,1..n] of integer;
TVector=array [1..n] of integer;
TIndex=1..n;
procedure InMas(var A:TMas; var k:TIndex);
{ввод двумерного масива}
var
i,j:TIndex;
begin
write('vvedite razmernost');
readln(k);
writeln;
for i:=1 to k do
for j:=1 to k do
begin
write('vvedite [',i,',',j,'] chislo: ');
readln(a[i,j]);
end;
end;
procedure OutMas(const A:TMas; k:TIndex);
{вывод двумерного масива}
var
i,j:TIndex;
begin
for i:=1 to k do
begin
for j:=1 to k do
write(A[i,j],' ');
writeln;
end;
end;
procedure trans(var A:TMas; k:TIndex);
{транспонирование массива}
var
i,j:TIndex;
s:integer;
begin
for i:=1 to k do
for j:=i+1 to k do
begin
s:=A[i,j];
A[i,j]:=A[j,i];
A[j,i]:=s;
end;
end;
procedure sort(var A:TMas; k:TIndex);
{сортировка по вводимой строке}
var
s,l,i,j:TIndex;
b:TVector;
z:integer;
begin
write('vvedite sortiruimuiu stroku: ');
readln(s);
for i:=1 to k do
b[i]:=A[s,i];
for i:=1 to k-1 do
begin
l:=i;
z:=b[i];
for j:=i+1 to k do
if b[j]<z then
begin
l:=j;
z:=b[j];
end;
b[l]:=b[i];
b[i]:=z;
end;
for i:=1 to k do
A[s,i]:=b[i];
end;
Procedure changestr (var A:TMas; k,k1,k2:TIndex);
{поменять местами 2 строки}
Var z:integer; j:Tindex;
Begin
For J:=1 to k do
Begin
Z:=A[k1,j]; A[k1,j]:=A[k2,j];
A[k2,j] :=z;
End;
Procedure change (var A:Tmas, k:TIndex);
{поменять местами 2 столбца}
Var k1, k2:TIndex; s:Integer; i:TIndex;
Begin
Writeln(‘vvedite nomer pervogo stolbca dlya obmena’);
Readln(k1);
Writeln(‘vtorogo’);
Readln(k2);
For i:=1 to k do
Begin
S:=A[i;k1];
A[i,k1]:=A[i,k2];
A[i,k2]:=S;
End;
End;
Procedure change+( var A:TMas; k:TIndex);
{обмен строки со столбцом}
Var k1, k2, I, j: TIndex; s:integer;
Begin
Writeln(‘vvedite nomer stroki’);
Readln(k1);
Writeln(‘vvedite nomer stolbca’);
Readln(k2);
For i:=1 to k do
Begin
S:=A[k1,i];
A[I,k2]:=A[k1,i];
A[I,k2]:=S;
End;
End;
Function kolichCH(const A:TMas; k1,k2:TIndex):TIndex;
{подсчет количества четных элементов в строке}
Var i,l:TIndex;
Begin
L:=0;
For i:=1 to k do
If (A[k1,i] mod 2=0) then
L:=L+1;
kolichCH:=L;
end;
function maxV(const A:Tmas; k1,k:TIndex):integer;
{поиск максимального в k-той строке}
var i:TIndex; max: integer;
begin
max:=A[1,k1];
for i:=1 to k do
if (max<A[I,k1] then max:=A[I,k1];
maxV:=max;
end;
procedure maxEL (const A:TMas; k:TIndex var Max: Integer; var n:TIndex);
{поиск максимального элемента и его номера в столбце k1}
Var i:TIndex;
Begin
N:=1; max:=A[1,k1];
For i:=2 to k do
If max<A[i, k1] then
Begin
Max:=A[i,k1]; n:=i;
End;
End;
procedure sort2(var A:TMas; k:TIndex);
{сортировка по вводимому столбцу}
var
s,l,i,j:TIndex;
b:TVector;
z:integer;
begin
write('vvedite sortiruimiy stolbec: ');
readln(s);
for i:=1 to k do
b[i]:=A[i,s];
for i:=1 to k-1 do
begin
l:=i;
z:=b[i];
for j:=i+1 to k do
if b[j]<z then
begin
l:=j;
z:=b[j];
end;
b[l]:=b[i];
b[i]:=z;
end;
for i:=1 to k do
A[i,s]:=b[i];
end;
var {основа}
M:TMas;
k1:TIndex;
begin
InMas(M,k1);
OutMas(M,k1);
readln;
end.
3) На главной диагонали находит максимум и удаляет строку содержащую этот максимум.
program matrizi;
{$APPTYPE CONSOLE}
uses
SysUtils;
type mas=array[1..15,1..15] of integer;
procedure VVOD (var a:mas;var n,m:integer);
var i,j:integer;
begin
repeat
writeln('VVedite kolichestvo strok');
readln(n);
writeln('Vvedite kolichestvo stolbzov');
readln(m);
until m=n;
writeln('Vvedite matrizu');
for i:=1 to n do begin
for j:=1 to m do read (a[i,j]);
readln;
end;
end;
procedure Del (var a:mas;n:integer;m:integer;var s:integer);
var i,j,imax,max:integer;
begin
max:=a[1,1];
imax:=1;
for i:=1 to n do
for j:=i to i do
if a[i,j]>max then begin
max:=a[i,j];
imax:=i;
end;
for j:=1 to m do
for i:=imax to n do begin
a[i,j]:=a[i+1,j];
s:=n-1;
end;
end;
procedure VIVOD (a:mas;s,m:integer);
var i,j:integer;
begin
for i:=1 to s do begin
for j:=1 to m do write (a[i,j],' ');
writeln;
end;
end;
var A:mas;
m,n,s:integer;
begin
VVOD(A,n,m);
DEL(A,n,m,s);
writeln('Poluchennaya matriza');
VIVOD(A,s,m);
readln;
end.
Shnurras
