В заданной прямоугольной матрице поставить на первое место
Столбец с наименьшим количеством нулевых элементов,
Перестаиви все нули в конец этого столбца. (Измененная
Матрица должна сожержать все элементы исходной матрицы).
program Z433_20;
uses Z433_20;
Var a:matr; i,j:integer;
Begin
for i:=1 to n do
for j:=1 to m do
read(a[i,j]);
obmen_nul(a);
for j:=1 to m do
for i:=1 to n do
writeln(a[i,j]);
end.
unit Z433_20;
interface
Const n=4; Const m=5;
Type matr=array[1..n,1..m] of real;
Var a:matr; i,j:integer;
procedure nul_schet(a:matr; Var k:mas);
procedure nom_stol(k:mas; Var w:integer);
procedure obmen_nul(Var a:matr);
implementation
procedure nul_schet;
Var i,j:integer;
Begin
for j:=1 to m do
for i:=1 to n do
if a[i,j]=0 then k[j]:=k[j]+1;
end;
end;{proc1}
procedure nom_stol;
Var i,j:integer;
Begin w:=0;
for j:=1 to m do
if k[j]>k[j+1] then w:=i+1;
end;
end;{proc2}
procedure obmen_nul;
Var j, k,l:integer;
Begin k:=1; l:=m;
for i:=1 to n do
for j:=1 to m do
while k<>l do Begin
if a[i,k]=0 then Begin
if a[i,l]=0 then l:=l-1
else Begin a[i,l]:=a[i,k]; a[i,k]:=0; k:=k+1; l:=l+1; end; end
else k:=k+1;
end;
end;{proc}
21(1) Для массива С из N элементов составить процедуру, которая находит m наименьших значений С1,С2…СN и т.д.
program 432_1;
const n=6;
type fun=function(x:real):real;
matr=array[1..n,1..n] of real;
mas=array[1..n] of real;
var A:matr; c:mas; i,j,m:integer; S:real;
procedure UPOR_P(c:mas;f:fun;m:integer;s:real);
var i,j,k,l:integer; w,min:real;z:array[1..m] of real;
begin for j:=1 to n-1 do begin
min:=c[j]; k:=j;
for i:=j to n do if c[i]<min
then begin min:=c[i]; k:=1; end;
w:=c[j];
c[j]:=c[k];
c[k]:=w;
end;
for l:=1 to n do
z[l]:=c[l];
s:=0;
for l:=1 to m do s:=s+f(z[l]);
end;
{$F+} function G(x:real):real;
begin
G:=SQR(x);
end;
{$F-};
begin
for i:=1 to n do
for j:=1 to n do
readln A[i,j];
read(m);
for i:=1 to n do begin
for j:=1 to n do
c[j]:=A[i,j];
p(c,G,m,S);
writeln(S);
end;
end.
Дана квадратная матрица. Если номер столбца с максимальной суммой элементов совпадает с номером строки с максимальной суммой элементов, определить сумму найденных элементов строки и столбца, иначе - распечатать номера найденных строки и столбца с максимальными суммами.
unit Z433_22;
interface
Const n=5;
Type matriza=array[1..n,1..n]of real;
massiv=array[1..n]of real;
procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);
procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);
procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);
implementation
procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);
Var i,j:integer;
Begin
for j:=1 to n do Begin
sumcol[j]:=0;
for i:=1 to n do
sumcol[j]:=sumcol[j]+a[i,j]; end;
maxcol:=sumcol[1];
for j:=2 to n do
if sumcol[j]>maxcol then Begin
maxcol:=sumcol[j];
ncol:=j; end;
end; { procedure colmax }
procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);
Var i,j:integer;
Begin
for i:=1 to n do Begin
sumrow[i]:=0;
for j:=1 to n do
sumrow[i]:=sumrow[i]+a[i,j]; end;
maxrow:=sumrow[1];
for i:=2 to n do
if sumrow[i]>maxrow then Begin
maxrow:=sumrow[i];
nrow:=i; end;
end;{ procedure rowmax }
procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);
Var i,j:integer;
Begin
sumelem:=0;
for i:=1 to n do
for j:=1 to n do
if (i=nrow) or (j=ncol)
then sumelem:=sumelem+a[i,j];
end; { procedure summa }
end.
program Z433_22;
uses Z433_22;
Var a:matriza;
sumcol,sumrow:massiv;
sumelem,maxcol,maxrow:real;
ncol,nrow,i,j:integer;
Begin
for i:=1 to n do
for j:=1 to n do
readln(a[i,j]);
colmax(a,ncol,sumcol,maxcol);
rowmax(a,nrow,sumrow,maxrow);
if ncol=nrow then Begin
summa(a,ncol,nrow,sumelem);
writeln(sumelem); end
else writeln(nrow,ncol);
end.
23 program Z433_23;
uses Z433_23;
Var x,y:mass; t:boolean; z:mass1;
i:integer;
Begin{osnovnaya programma}
writeln('x[i]=');
for i:=1 to n do
readln(x[i]);
writeln('y[i]=');
for i:=1 to n do
readln(y[i]);
ysl(x,y,t);
if t then Begin
form_massiv(x,y,z);
for i:=1 to n do
writeln (z[i]);
end
else writeln('yslovie ne vupolneno');
end.
unit Z433_23;
interface;
Const n=2;
Type mass=array[1..n] of integer;
mass1=array[1..n] of real;
function fact(n:integer):integer;
procedure ysl(x,y:mass; Var t:boolean);
procedure form_massiv(x,y:mass; Var z:mass1);
implementation
function fact(n:integer):integer;
Var y,i:integer;
Begin y:=1;
for i:=1 to n do
y:=y*i;
fact:=y;
end;
procedure ysl(x,y:mass; Var t:boolean);
Var i:integer;
Begin
for i:=1 to n do
if (y[i]>x[i]) then t:=true
else t:=false;
end;
procedure form_massiv(x,y:mass; Var z:mass1);
Var i:integer;
Begin
for i:=1 to n do
z[i]:=fact(y[i])/(fact(x[i])*(fact(y[i])-fact(x[i])));
end;
end.