Пользователь
Регистрация: 12.01.2017
Сообщений: 10
|
Подправить фрагмент кода
Условие:
Дана матрица A, состоящая из n строк и n столбцов. Получить массив Х1, Х2, ..., Хn по правилу:
Хi = 1, если для всех j = l, 2, ..., n (кроме j=i) выполняется неравенство Aji< Aij, иначе Xi = 0. Найти сумму
элементов матрицы.
Рабочий код(почти):
Код:
program Lab11procedure;
{$APPTYPE CONSOLE}
const
nmax=5;
mmax=20;
Type SMas=array[2..nmax,2..nmax] of integer;
Type Mas=array[1..mmax] of integer;
Procedure VvodVyvod(var dat,res: TextFile; var n: integer; var A: SMas; var name: char);
Var i,j: byte;
begin
readln(dat, name);
readln(dat,n);
i:=1;
while(i <= n) do
begin
j:= 1;
while(j <= n) do
begin
read(dat,A[i,j]);
j:= j+1;
end;
i:= i+1;
readln(dat);
end;
writeln(res, 'Иcходная матрица ',name,'[i,j] из ',n,' строки ',n,' столбцов');
i:= 1;
while(i <= n) do
begin
j:=1;
while(j <= n) do
begin
write(res,A[i,j]:4,' ');
j:= j+1;
end;
i:= i+1;
writeln(res);
end;
end;
Procedure PoiskMassiva (const n:integer;var A: SMas; out X:Mas;Vse,Odin:Boolean);
var i,j: byte;
begin
Vse:=True;
i:=1;
repeat
Odin:=False;
j:=1;
repeat
if (A[j,i]<A[i,j]) and (A[j+1,i]<A[i,j+1]) and (j<>i) then
X[i]:=1
else
Odin:=True;
X[i]:=0;
until (j<=n) or (not Odin);
if Odin then
begin
Vse:=False;
X[i]:=0
end
else
i:=i+1;
until (i<=n) or (not Vse);
end;
Procedure SummaVsex(const n:integer;var A:SMas; out SUM: integer);
var i,j: byte;
begin
SUM:=0;
for i:=1 to n do
for j:=1 to n do
SUM:=SUM+A[i,j];
end;
var
A,B,C:SMas;
X:Mas;
MinSum,SUM,SUMA,SUMB,SUMC,i,j,n:integer;
dat1,dat2,dat3,res:TextFile;
name:char;
Vse,Odin:Boolean;
begin
AssignFile(dat1,'dat11(A).txt');reset(dat1);
AssignFile(dat2,'dat11(B).txt');reset(dat2);
AssignFile(dat3,'dat11(C).txt');reset(dat3);
AssignFile(res,'res11.txt');rewrite(res);
VvodVyvod(dat1,res,n,A,name);
PoiskMassiva(n,A,X,Vse,Odin);
write(res,'Массив Xn(А) = ');
for i:=1 to n do write(res,X[i]:4,' ');
writeln(res);
SummaVsex(n,A,SUM);
SUMA:=SUM;
writeln(res,'Сумма всех элементов матрицы A = ',SUMA);
writeln(res,'----------------------------------------------');
VvodVyvod(dat2,res,n,B,name);
PoiskMassiva(n,B,X,Vse,Odin);
write(res,'Массив Xn(B) = ');
for i:=1 to n do write(res,X[i]:4,' ');
writeln(res);
SummaVsex(n,B,SUM);
SUMB:=SUM;
writeln(res,'Сумма всех элементов матрицы B = ',SUMB);
writeln(res,'----------------------------------------------');
VvodVyvod(dat3,res,n,C,name);
PoiskMassiva(n,C,X,Vse,Odin);
write(res,'Массив Xn(C) = ');
for i:=1 to n do write(res,X[i]:4,' ');
writeln(res);
SummaVsex(n,C,SUM);
SUMC:=SUM;
writeln(res,'Сумма всех элементов матирцы C = ',SUMC);
writeln(res,'----------------------------------------------');
if (SUMA<SUMB) and (SUMA<SUMC) then
writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица A = ',SUMA)
else
if (SUMB<SUMA) and (SUMB<SUMC) then
writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица B = ',SUMB)
else
if (SUMC<SUMA) and (SUMC<SUMB) then
writeln(res,'Минимальной суммой значений среди всех матриц обладает матрица C = ',SUMC)
else
if (SUMA=SUMB) and (SUMA<SUMC) then
writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы А и B = ',SUMA)
else
if (SUMB=SUMC) and (SUMB<SUMA)then
writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы B и С = ',SUMB)
else
if (SUMA=SUMC) and (SUMC<SUMB) then
writeln(res,'Минимальной суммой значений среди всех матриц обладают матрицы А и C = ',SUMA)
else
if (SUMA=SUMB) and (SUMA=SUMC) then
writeln(res,'Значение суммы всех элементов каждой матрицы совпадает и равняется = ',SUMA,'.Минимальное значение отсутствует.')
else
writeln(res,'----------------------------------------------');
CloseFile(dat1);
CloseFile(dat2);
CloseFIle(dat3);
CloseFile(res);
end.
Выходной файл(фрагмент для матрицы А) :
Иcходная матрица А[i,j] из 3 строки 3 столбцов
-2 7 7
6 5 14
5 3 0
Массив Xn(А) = 0 0 0 , а должно быть 1 0 0 ,т.к А(21)<A12 и A(31)<A(13)
Сумма всех элементов матрицы A = 45
----------------------------------------------
Подскажите , как подправить цикл?Заранее Спасибо!
|