Консультация № 176558
08.02.2010, 01:46
0.00 руб.
0 2 2
Добрый вечер,уважаемые эксперты!!!
Помогите решить задачи:
Найти сумму элементов и произведение ниже главной диагонали
Проверить,содержит ли матрица нулевую строку
найти решение системы n линейных уравнений с n неизвестными треугольного вида

Обсуждение

давно
Профессор
401888
1232
08.02.2010, 08:32
общий
это ответ
Здравствуйте, angel.nero!
Решение задач в приложении. Подробно не комментирую, ибо я уже немало Вам написал о матрицах.

Приложение:
1.Найти сумму элементов и произведение ниже главной диагонали
uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of real;
n,i,j:byte;
sm,pr:real;
begin
clrscr;
randomize;
repeat
write('Размер матрицы=');
readln(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=5*random;
if j<i then{элементы ниже гл. диагонали }
begin
textcolor(12);{выделим красным цветом}
write(a[i,j]:5:2);
end
else
begin
textcolor(15);{остальные по умолчанию, у меня белый}
write(a[i,j]:5:2);
end;
end;
writeln;
end;
writeln;
sm:=0;
pr:=1;
for i:=2 to n do{от строки 2 до последней}
for j:=1 to i-1 do{от столбца 1 не доходя до главной диагонали}
begin
sm:=sm+a[i,j];{сумма}
pr:=pr*a[i,j];{произведение}
end;
writeln('Сумма=',sm:0:2);
write('Произведение=',pr:0:2);
readln
end.

2.Проверить,содержит ли матрица нулевую строку
uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
n,m,i,j,k,f:byte;
begin
clrscr;
repeat
write('Количество строк n=');
readln(n);
until n in [1..nmax];
repeat
write('Количество столбцов m=');
readln(m);
until m in [1..nmax];
writeln('Введите ',n*m,' элементов матрицы');
for i:=1 to n do
for j:=1 to m do
begin
write('a[',i,',',j,']=');
readln(a[i,j]);
end;
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:2,' ');
writeln;
end;
writeln;
f:=0;{пока строк с нолями нет}
for i:=1 to n do{смотрим строки по порядку}
begin
k:=0;{пока нолей в строке нет}
for j:=1 to m do{идем по строке}
if a[i,j]=0 then k:=k+1;{считаем ноли}
if k=m then{если все ноли}
begin
write('Матрица содержит нулевую строку ее номер=',i);
f:=1;{фиксируем}
break;{дальше не ищем}
end;
end;
if f=0 then write('Матрица не содержит нулевых строк');
readln
end.
3.Найти решение системы n линейных уравнений с n неизвестными треугольного вида
uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of real;{матрица коэффициентов}
b,x:array[1..nmax] of real;{массивы свободных членов и корней системы}
n,i,j,k:byte;{размер и счетчики циклов}
r,g:real;{вспомогательные переменные}
begin
clrscr;
randomize;
repeat
write('Количество уравнений=');
readln(n);
until n in [1..nmax];
writeln('Введите коэффициенты треугольной матрицы:');
for i:=1 to n do{вводим по строкам}
for j:=i to n do{от главной диагонали до кол-ва}
begin
write('a[',i,',',j,']=');
readln(a[i,j]);
end;
writeln('Введите свободные члены:');
for i:=1 to n do
begin
write('b[',i,']=');
readln(b[i]);
end;
clrscr;
writeln('Исходная матрица и свободные члены:');
for i:=1 to n do
begin
for j:=1 to n do
if j<i then write(' ':5){до главной-пробелы}
else write(a[i,j]:5:2);{дальше коэффициенты}
write(b[i]:7:2);{свободные члены}
writeln;
end;
writeln;
for i:=n downto 1 do{обратный ход Гаусса, теорию в математике}
begin
if a[i,i]=0 then{если главный элемент=0, матрица выржденная}
begin
write('Решений нет!');
readln;
exit;
end;
r:=0;
for j:=i+1 to n do
begin
g:=a[i,j]*x[j];
r:=r+g;
end;
x[i]:=(b[i]-r)/a[i,i];
end;
writeln('Корни системы:');
for i:=1 to n do
write('x[',i,']=',x[i]:0:2,' ');
readln
end.
Неизвестный
08.02.2010, 15:29
общий
это ответ
Здравствуйте, angel.nero.
Решение задачи о нулевой строке в матрице приведено в приложении

Приложение:
{
Проверить,содержит ли матрица нулевую строку
}

Uses
Crt;
Const
Rows = 5;
Columns = 3;
Var
Ar: Array[1..Rows, 1..Columns] of Byte;
col, row: Byte;
flag: Boolean;
begin
ClrScr;
Randomize;
{Init array}
for row:=1 to Rows do begin
for col:=1 to Columns do begin
Ar[row, col] := Random(2);
Write(Ar[row, col]:4);
end;
WriteLn;
end;

{Search zero-row};
for row:=1 to Rows do begin
flag := true;
for col:=1 to Columns do begin
if Ar[row, col] <> 0 then begin
flag := false;
break;
end;
end;
if flag then break;
end;
if flag then
Write('Found zero-row.')
else
Write('Zero-row not found.');
repeat until keypressed;
end.
Форма ответа