задача на матрицу с использованием процедуры, написать процедуру нахождения клетки матрицы Опции

[DruiD]

Дана матрица A[n,m], составить матрицу B[n/4,m/2], каждый элемент которой равен произведению сумм элементов. Написать процедуру для нахождения элемента матрицы В.
То есть мне дана матрица А, и 1 клетка в ней равна 4 столбца и 2 строки, и это равно 1 элементу матрицы В. Например, B[1,1]=(A[1,1]+A[1,2])*(A[1,3]+A[1,4])*(A[2,1]+A[2,2])*(A[2,3]+A[2,4]).
Если можно, укажите ошибку в моей неработающей программе:

program bayer;
const m=8; n=4;
type aa=array[1..n,1..m]of integer;
var i,j,c,d,f,x,y:byte;
    Sr,Pr:integer; A:AA; B:array[1..n div 4,1..m div 2]of integer;
procedure Sum(A:AA; i,j:byte; var p:integer);
          var k,y,z:byte; s:integer;
          begin
          s:=0; p:=1; k:=j;
          for y:=i to i+1 do
          for z:=k to j+3 do
              begin
              s:=A[y,z]+A[y,z+1];
              p:=p*s;
              k:=k+1;
              end;
          end;
begin
for i:=1 to n do
for j:=1 to m do
    begin
    writeln ('vvedite element v ',i,' stroke i ',j,' stolbce');
    readln (A[i,j]);
    end;
c:=1; d:=1; f:=1;x:=1; y:=1;
for i:=f to n do
begin
for j:=d to m do
     begin
     sum(A,i,j,B[x,y]);
     if d+4>m then d:=m else begin d:=d+4; y:=y+1; end;
     end;
if c mod 2=0 then begin
                   f:=f+2;
                   c:=c+1;
                   x:=x+1;
                   end
 else c:=c+1;
end;
for i:=1 to n div 4 do  begin writeln;
for j:=1 to m div 2 do
write (B[i,j],'  '); end;
readln;
end.

Сообщение отредактировано: DruiD - 26.11.2006 2:04

[DruiD]

Мда... Спасибо всем за активную помощь. Потратив очень много времени на решение задачки, пришёл к выводу, что использование циклов с предусловием намного упростит решение, и я избавлюсь от нескольких переменных сразу. Также существенно упростил процедуру, задав формулу только для единичного случая. В программа работает правильно.

program chelsea;
const n=4; m=8;
var A:array [1..n,1..m] of integer; B:array[1..n div 2,1..m div 4]of integer;
    i,j,x,y:byte; c:integer;
procedure sum(i,j:byte; var Bb:integer);
          begin
          Bb:=(A[i,j]+A[i,j+1])*(A[i,j+2]+A[i,j+3])*(A[i+1,j]+A[i+1,j+1])*
              (A[i+1,j+2]+A[i+1,j+3]);
          end;
begin
for i:=1 to n do
for j:=1 to m do
 begin
 writeln ('vvedite element v ',i,' stroke i ',j,' stolbce');
 readln (A[i,j]);
 end;
i:=1; x:=1;
while i<=n do begin
                j:=1; y:=1;
                while j<=m  do
                            begin
                            sum(i,j,c);
                            B[x,y]:=c;
                            j:=j+4; y:=y+1;
                            end;
                i:=i+2; x:=x+1;
              end;
for i:=1 to n div 2 do   begin writeln;
for j:=1 to m div 4 do
write (B[i,j],'  '); end;
readln;
end.