Формирование матрицы с помощью функции как параметра процедуры, Паскаль

[Madara]

Формирование матрицы с помощью функции как параметра процедуры, Паскаль

Доброго времени суток.
Помогите пожалуйста с программой:

Условие задания – головного модуля — предполагает обязательное использование разработанной процедуры П1 с функцией (f или f1, f2) в качестве параметра. В качестве исходного данного в большинстве заданий используется квадратная матрица А.

Используя в качестве f1 синус, а в качестве f2 косинус, сформировать матрицу Е из А по правилу: первая строка матрицы Е формируется с помощью процедуры из двух первых столбцов матрицы А, вторая строка - из следующей пары столбцов и т.д.

Как я понял, из матрицы А:
1 2 3 4 5 6
4 7 1 8 9 5
2 8 4 1 3 7

должна получиться матрица Е:
1 4 2 2 7 8
3 1 4 4 8 1
5 9 3 6 5 7

Вот я написал программу, но без процедур и функций:

Program MatrixForm;
Const n=3; m=6;

Type 
Matr = array[1..n,1..m] of Real;


Const 
A: matr = ( ( 1, 2, 3, 4, 5, 6 ), 
            ( 4, 7, 1, 8, 9, 5 ), 
            ( 2, 8, 4, 1, 3, 7 ) 
           );  
           
Var i,j:byte;
E:matr;

Begin
  for i:=1 to n do
    begin
       for j:=1 to m do
Begin
  E[1,1]:=A[1,1]; E[1,2]:=A[2,1]; E[1,3]:=A[3,1]; E[1,4]:=A[1,2]; E[1,5]:=A[2,2]; E[1,6]:=A[3,2];
  E[2,1]:=A[1,3]; E[2,2]:=A[2,3]; E[2,3]:=A[3,3]; E[2,4]:=A[1,4]; E[2,5]:=A[2,4]; E[2,6]:=A[3,4];
  E[3,1]:=A[1,5]; E[3,2]:=A[2,5]; E[3,3]:=A[3,5]; E[3,4]:=A[1,6]; E[3,5]:=A[2,6]; E[3,6]:=A[3,6];
     Write(E[i,j]:4);
end;
 writeln;
 end;
End.

Не могу понять зачем нужны синусы и косинусы, сомневаюсь что верно понял условие...

Заранее спасибо!

 

[Евгений]

Не моё. Случайно наткнулся.

uses crt;
const max=10;
type mas=array[1..max] of real;{массив}
mtr=array[1..max] of mas;{матрица}
proc=procedure(n:byte;b,c:mas;var t:mas);{процедурный тип}
{опишем две функции}
function f1(x:real):real;
begin
f1:=sin(x)
end;
function f2(x:real):real;
begin
f2:=cos(x)
end;
{$F+}
{опишем процедуру для использования параметром в другой процедуре}
procedure newmas(n:byte;b,c:mas;var t:mas);
var m,i:byte;
begin
m:=0;
for i:=1 to n do
if (f1(b)>0)and(f2(c)>f1(b)) then
begin
m:=m+1;
t[m]:=b+c
end;
if m<n then
for i:=m+1 to n do
t:=0;
end;
{$F-}
{основная процедура}
procedure newmtr(a:mtr;n:byte;newmasroc;var e:mtr);
var i:byte;
begin
for i:=1 to n div 2 do
newmas(n,a[2*i-1],a[2*i],e)
end;
var a,e:mtr;
n,i,j:byte;
begin
clrscr;
randomize;
repeat
write('Размер матрицы А четное число до ',max,' n=');
readln;
until (n in [2..max])and(n mod 2=0);
{создадим матрицу А по столбцам}
for j:=1 to n do
for i:=1 to n do
a[j,i]:=random;
{выведем ее построчно}
writeln('Матрица А:');
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j]:6:2);
writeln
end;
{получим новую матрицу}
newmtr(a,n,newmas,e);
{выведемее построчно}
writeln('Матрица E:');
for i:=1 to n div 2 do
begin
for j:=1 to n do
write(e[i,j]:5:2);
writeln
end;
readln
end.

 

[Madara]

Спасибо огромное!

Переписал под паскаль себе: без uses crt и randomize, а так же без усложнений с размером матрицы; может кому пригодится

Program matrconv;

Const n=6;

Type
   mass=array[1..n] of real;
   matr=array[1..n] of mass;
   proc=procedure(n:byte;b,c:mass;var t:mass);

Const  A: matr =     ( (  1,  0.2, 0.3, 0.4, 0.5, 0.6 ),  
                       ( 0.4, 0.7, 0.1, 0.8, 0.9, 0.5 ),  
                       ( 0.2, 0.8, 0.4, 0.1, 0.3,  7  ),
                       ( 0.4, 0.7,  1,  0.9, 0.5,  2  ),
                       ( 0.8, 0.3, 0.7, 0.1,  0,  0.4 ),
                       (  2,  0.5, 0.6, 0.4,  3,  0.8 )
                      );
                      
function f1(x:real):real;
  begin
    f1:=sin(x)
  end;
  
function f2(x:real):real;
  begin
    f2:=cos(x)
  end;
  
procedure newmas(n:byte;b,c:mass;var t:mass);
      var m,i:byte;
  begin
    m:=0;
    for i:=1 to n do
    if (f1(b[i])>0)and(f2(c[i])>f1(b[i])) then
      begin
        m:=m+1;
        t[m]:=b[i]+c[i]
      end;
    if m<n then
    for i:=m+1 to n do
    t[i]:=0;
  end;

procedure newmtr(a:matr;n:byte;newmas:proc;var e:matr);
    var i:byte;
  begin
    for i:=1 to n div 2 do
    newmas(n,a[2*i-1],a[2*i],e[i])
  end;
  
var e:matr;
    i,j:byte;
begin
    writeln('Матрица А:');
    for i:=1 to n do
      begin
        for j:=1 to n do
        write(a[i,j]:6:2);
        writeln
      end;
  newmtr(a,n,newmas,e);
  writeln('Матрица E:');
  for i:=1 to n div 2 do
    begin
      for j:=1 to n do
      write(e[i,j]:6:2);
      writeln;
    end;
end.