Developing.ru

Код: Выделить всё

{---------- Двумерные массивы ---------------}
program primer1;
uses crt;
type stroka=array[1..20] of real;
     matr=array[1..20] of stroka;

var m,n,i,j,k,l,r:integer;
    s,s1,s2,ext:real; x,y:stroka;
    a:matr;
{---------- Вспомогательные функции---------------}

{----------- Сумма строки ------------------}
function summa(m:integer;x:stroka):real;
    var i:integer;  s:real;
begin
    s:=0;
    for i:=1 to m do 
    	s:=s+x[i];
    summa:=s
end;
{-------------------Сумма модулей строки----------------------}
function summamod(m:integer;x:stroka):real;
    var i:integer;   s:real;
begin
    s:=0;
    for i:=1 to m do 
        s:=s+abs(x[i]);
    summamod:=s
end;
{------------ Процедуры ------------------}

{------------- Ввод массива с клавиатуры* ------------------------}
procedure wwod(var a:matr);
    var i,j:integer;
begin 
    clrscr;
    write('Введите к-во строк ');readln(n);
    write('Введите к-во столбцов ');readln(m);
    for i:=1 to n do
    begin
        for j:=1 to m do 
	begin
		write(' A[',i,',',j,']=');
		read(a[i][j])
	end;
	writeln;
    end;
end;

{------------- Присваивание значенй элементам массива---------------}
procedure priswaiwanie;
begin 
    n:=3;m:=4;
    a[1][1]:=3; a[1][2]:=0; a[1][3]:=-5;a[1][4]:=3;
    a[2][1]:=-4;a[2][2]:=-1;a[2][3]:=-2;a[2][4]:=-3;
    a[3][1]:=1; a[3][2]:=3; a[3][3]:=0; a[3][4]:=8;
end;
{------------- Вывод массива в виде матрицы ----------------------}
procedure wywod;
var i,j:integer;
begin  
    for i:=1 to n do begin
    for j:=1 to m do write('  ',a[i][j]:6:2);
             writeln end
end;
{------------- Смена знаков элементов строки* ----------------}
procedure znak(m:integer;var x:stroka);
var i:integer;
begin
    for i:=1 to m do x[i]:=-x[i];
end;
{------------- Максимум в строке, стоящИй на k-том месте--------------}
procedure maximum(m:integer;x:stroka;var k:integer;var ma:real);
var i:integer;
begin 
    k:=1;ma:=x[1];
    for i:=2 to m do 
    if x[i]>ma then begin
                    k:=i;ma:=x[i]
                    end
end;
{------Максимум по модулю в строке, стоящИй на k-том месте--------------}
procedure maximummod(m:integer;x:stroka;var k:integer;var ma:real);
var i:integer;
begin
    k:=1;ma:=abs(x[1]);
    for i:=2 to m do 
    if abs(x[i])>ma then begin
                         k:=i;ma:=abs(x[i])
                         end
end;
{--------------- Основная программа* -----------------}
begin
    clrscr;
    writeln('Введите массив:');
    wwod(a);
    writeln;

{-------  Вывод массива на экран --------}
{  clrscr; writeln('Введенный массив'); wywod; }

    for i:=1 to n do 
    begin
        s:=summa(m,a[i]);
	writeln('   Сумма ',i,'*строки =  ',s:5:2)
    end;
end.

Код: Выделить всё

…
{--------------- Основная программа* -----------------}
var NumOfStr:integer;
begin
    clrscr;
    writeln('Введите массив:');
    wwod(a);
    writeln;
{-------  Вывод массива на экран --------}
{  clrscr; writeln('Введенный массив'); wywod; }
    NumOfStr:=0;
    for i:=1 to n do
    begin
        if summa(m,a[i])/m < 0 then inc(NumOfStr);
    end;
    writeln('В ',NumOfStr, ' строке(ах) среднее меньше 0.')
end.