подпрограмма

[alex13]

Помогите пожалуйста

Для заданных четырёх матриц X1(N1*N1), X2(N2*N2), X3(N3*N3), X4(N4*N4) и найти и напечатать длины векторов Ya3=s1,s2,s3 и Yb3=s2,s3,s4, где s1,s2,s3,s4 – суммы положительных элементов соответствующих матриц. Следует напомнить, что длина вектора вычисляется как квадратный корень из суммы квадратов координат. (При решении реализовать процедуры ввода и вывода массивов: Vvod2m(A,N,Name), Vivod2m(A,N,Name); а также функции SummPol(A,N):<тип массива> – сумма положительных элементов; и Dlina(p,q,r):real – длина вектора с координатами p,q,r)

вот что я смог решить:

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

program ABC;
type T1m=array[1..100] of integer;
T2m=array[1..10,1..10] of integer;
var X1,X2,X3,X4:T2m;
Ya3,Yb3:T1m;
s1,s2,s3,s4:byte;
procedure Vvod2m(var A:T2m; var N:byte; const Name:TName);
var i,j:byte;
begin
writeLn('введите массив ', Name,':');
write('размерность массива N=');
readLn(N);
for i:=1 to N do
for j:=1 to N do
begin
write(Name,'[',i,',',j,']=');
readLn(A[i,j]);
end;
end;
procedure Vivod2m(const A:T2m; const N:byte; const Name:TName);
var i,j:byte;
begin
writeLn('введите массив ', Name,':');
for i:=1 to N do
begin
for j:=1 to N do
write(A[i,j]:5);
writeLn;
end;
end;
function SummPol(const A:T2m; N,M:byte):integer;
var S:integer;
i,j:byte;
begin
S:=0;
for i:=1 to N do
for j:=1 to M do
if A[i,j]>0 then
S:=S+A[i,j];
writeln('S=',S);
end;
function Dlina(p,q,r:real;B:T1m)
begin
B:=SQRT(SQR(p)+SQR(q)+SQR(r))
end;

[Naeel Maqsudov]

Это PascalABC или Turbo Pascal?
В ABC есть динамические массивы.

[alex13]

Это Pascal ABC; надо решить данную задачу через подпрограммы

[Naeel Maqsudov]

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

type
  TArr=array [,] of real;
var
  X1,X2,X3,X4:TArr;
  s2,s3:Real;
  
procedure Vvod2m(var A:TArr;Name:string);
var i,j,n:integer;
begin
  write('размерность массива N='); readLn(N);
  setlength(A,N,N);
  writeLn('введите массив ', Name,'.');
  for i:=0 to pred(N) do for j:=0 to pred(N) do begin
    write(Name,'[',i,',',j,']=');
    readLn(A[i,j]);
  end;
end;

procedure Vivod2m(var A:TArr;Name:string);
var i,j:integer;
begin
  writeLn('массив ', Name,'.');
  for i:=0 to pred(length(A,0)) do begin 
    for j:=0 to pred(length(A,1)) do write(A[i,j]:5);
    writeln;
  end;
end;

function SummPol(A:TArr):real;
var i,j:integer; s:real;
begin
  s:=0;
  for i:=0 to pred(length(A,0)) do 
    for j:=0 to pred(length(A,1)) do 
      if A[i,j]>0 then s:=s+A[i,j];
  SummPol:=s;
end;

function Dlina(p,q,r:real):real;
begin
  Dlina:=SQRT(SQR(p)+SQR(q)+SQR(r));
end;

begin
  Vvod2m(X1,'X1');  Vivod2m(X1,'X1');     
  Vvod2m(X2,'X2');  Vivod2m(X2,'X2');   s2:=summpol(X2);  
  Vvod2m(X3,'X3');  Vivod2m(X3,'X3');   s3:=summpol(X3);  
  Vvod2m(X4,'X4');  Vivod2m(X4,'X4');     
  writeln('Длина Ya=',Dlina(summpol(X1),s2,s3));
  writeln('Длина Yb=',Dlina(s2,s3,summpol(X4)));
end.

[alex13]

Naeel Maqsudov, большое СПАСИБО!))))

я правда немного подредактировал:

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

type
  Tmtx=array[1..10,1..10] of real;
var
  X1,X2,X3,X4:Tmtx;
  s2,s3:Real;
  N1,N2,N3,N4:byte;
procedure Vvod2m(var A:Tmtx;var N:byte;const Name:string);
var i,j:integer;
begin
writeLn('введите массив ', Name,':');
write('размерность массива N=');
readLn(N);
for i:=1 to N do
for j:=1 to N do
begin
write(Name,'[',i,',',j,']=');
readLn(A[i,j]);
end;

end;

procedure Vivod2m(const A:Tmtx;const N:byte; const Name:string);
var i,j:integer;
begin
  writeLn('введите массив ', Name,':');
for i:=1 to N do
begin
for j:=1 to N do
write(A[i,j]:5);
writeLn;
end;
end;


function SummPol(const A:Tmtx; N,M:byte):real;
var i,j:integer; s:real;
begin
  s:=0;
  for i:=1 to N do
for j:=1 to M do

      if A[i,j]>0 then s:=s+A[i,j];
  SummPol:=s;
end;

function Dlina(p,q,r:real):real;
begin
  Dlina:=SQRT(SQR(p)+SQR(q)+SQR(r));
end;

begin
  Vvod2m(X1,N1,'X1');  Vivod2m (X1,N1,'X1');
  Vvod2m(X2,N2,'X2');  Vivod2m(X2,N2,'X2');   s2:=summpol(X2,N2,N2);
  Vvod2m(X3,N3,'X3');  Vivod2m(X3,N3,'X3');   s3:=summpol(X3,N3,N3);
  Vvod2m(X4,N4,'X4');  Vivod2m(X4,N4,'X4');
  writeln('Длина Ya3=',Dlina(summpol(X1,N1,N1),s2,s3));
  writeln('Длина Yb3=',Dlina(s2,s3,summpol(X4,N4,N4)));
end.

и у меня возник вопрос, когда программа выводит массив, то выдает следущее:

размерность массив N=2
X1[1,1]=4
X2[1,2]=-1
X3[2,1]=3
X4[2,2]=2
введите массив X1:
4. OE+000 -1. OE+000
3. OE+000 2. OE+000


меня смущает вот это: OE+000
что это такое и как убрать?

[somewhere]

Экспоненциальная форма представления, убрать форматированием [число]:[всего_знаков]:[знаков_после_запятой]

[alex13]

ясно... а вот ещё вопрос, не могу тест составить, как программа координаты высчитывает, откуда они вообще берутся? координаты это координаты нахождения положительных элементов в матрице, да?


и ещё, вконце, в основной пограмме

begin
Vvod2m(X1,N1,'X1'); Vivod2m (X1,N1,'X1');
Vvod2m(X2,N2,'X2'); Vivod2m(X2,N2,'X2'); s2:=summpol(X2,N2,N2);
Vvod2m(X3,N3,'X3'); Vivod2m(X3,N3,'X3'); s3:=summpol(X3,N3,N3);
Vvod2m(X4,N4,'X4'); Vivod2m(X4,N4,'X4');
writeln('Äëèíà Ya3=',Dlina(summpol(X1,N1,N1),s2,s3));
writeln('Äëèíà Yb3=',Dlina(s2,s3,summpol(X4,N4,N4)));
end.
нходятся только s2 и s3, а s1 и s2 писать не нужно? (после ввода и вывода?)

[Naeel Maqsudov]

нходятся только s2 и s3, а s1 и s2 писать не нужно? (после ввода и вывода?)

А зачем? Эти значения вычислены как аргумент функции Dlina.
Раз эти значения используются только по 1 разу, то нет нужды их присваивать каким-то переменным.
Т.е. вместо
Dlina(s1,s2,s3));
можно написать
Dlina(summpol(X1,N1,N1),s2,s3));

[alex13]

ещё есть вопрос по теме
задача: Ввести целочисленный двумерный массив А(N*M), вывести его. Если максимум и минимум массива одновременно являются четными, то разделить их на два, иначи поменять местами первый и предпоследний столбец массива.

вот как я её решил:

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

program ABC;
type
    Tmtx=array[1..10,1..15] of integer;
Var       max,min :integer;
    t, j,i:integer;  N,M:byte ;
    A:Tmtx;
procedure Vvod2m(var A:Tmtx;var N,M:byte;const Name:char);
var i,j:integer;
begin
writeLn('введите массив ', Name,':');
write('размерность массива N='); readLn(N);
write('размерность массива M=');  readLn(M);

for i:=1 to N do
for j:=1 to M do
begin
write(Name,'[',i,',',j,']=');
readLn(A[i,j]);
end;
end;
    procedure Vivod2m(const A:Tmtx;const N,M:byte; const Name:char);
var i,j:integer;
begin
  writeLn('введите массив ', Name,':');
for i:=1 to N do
begin
for j:=1 to M do
write(A[i,j]:5);
writeLn;
end;
end;
    Function Maximum (Var A:Tmtx; N,M: byte ): integer;
     var max:integer;
     i,j:byte;
     begin
 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];
     Maximum:=A[i,j];Maximum:=max;
     end;
     Function Minimum (Var A:Tmtx; N,M: byte): integer;
       var min:integer;
     i,j:byte;
         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];
     Minimum:=A[i,j]; Minimum:=min;
     end;
procedure Del (var A:Tmtx;N,M:byte;max,min:integer);
var
   i,j:byte;
begin
     for  i:=1 to n do
   for  i:=1 to m do
  if  (min mod 2=0) and (max  mod 2=0)then
   begin
    min:=min div 2;
    max:=max div 2;   writeln('min=',min);   writeln('max=',max)

         end;
end;

procedure Perest (var x:Tmtx;N,M:byte);
var
   i,j:byte;
   t:integer;
begin
     for i:=1 to N do
     begin
          t:=A[i,1];
          A[i,1]:=A[i,M-1];
          A[i,M-1]:=t;
     end;
end;


BEGIN

     vvod2m(A,N,M,'A');
     vivod2m(A,N,M,'A');
     max:=Maximum(A,N,M);
     min:=Minimum(A,N,M);
     if (max mod 2 = 0)and(min mod 2 =0) then
     Del(A,N,M,max,min)
     else
     Perest(A,N,M);
     vivod2m(A,N,M,'A');
END.

преподаватель сказал мне, что в процедуре Del нужно делить на два не максимум и минимум, а их значеия; что он имел ввиду? и как это?)

[Naeel Maqsudov]

Если максимум и минимум массива одновременно являются четными, то разделить их на два,

Согласно Вашему условию вроде все правильно. Но если препод так сказал, значит читайте внимательно условие. Видимо там действительно надо делить элементы массивов.