Advertisement
ALTracer

Matrix op. №4 refined

May 13th, 2016
387
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.33 KB | None | 0 0
  1. program Mx_4;
  2. type MyArray=array of array of Integer;
  3. var a,b:MyArray;
  4.   i,j,m,n:Word;
  5.  
  6. procedure PullArray(var a:MyArray; var m,n:Word);
  7. var Fin:Text;
  8.   i,j:Word;
  9. begin
  10.   Assign(Fin,'in.txt');
  11.   ReSet(Fin);
  12.   ReadLn(Fin,m,n); // array size
  13.   SetLength(a,m+1,n+1);
  14.   for i:=1 to m do
  15.   begin
  16.     for j:=1 to n do
  17.       Read(Fin,a[i,j]);
  18.     ReadLn(Fin);
  19.   end;
  20.   Close(Fin);
  21. end;
  22.  
  23. function Compute(a:MyArray; m,n:Word; y,x:Word; mode:Integer):Integer;
  24. var i,i1,i2,j,j1,j2:Word;
  25.   s:Integer;
  26. begin
  27.   if mode=1 then begin //down-right
  28.        i1:=y+1;
  29.   j1:=x+1;  j2:=n;
  30.        i2:=m;
  31.   end else begin //upper-left
  32.        i1:=1;
  33.   j1:=1;  j2:=x-1;
  34.        i2:=y-1;
  35.   end;
  36.   s:=0;
  37.   for i:=i1 to i2 do
  38.     for j:=j1 to j2 do
  39.       s:=s+a[i,j];
  40.   Compute:=s;
  41. end;
  42.  
  43. procedure PushArray(b:MyArray; m,n:Word);
  44. var i,j:Word;
  45.   Fout:Text;
  46. begin
  47.   Assign(Fout,'out.txt');
  48.   ReWrite(Fout);
  49.   WriteLn(Fout,m,' ',n);
  50.   for i:=1 to m do
  51.   begin
  52.     for j:=1 to n do
  53.       Write(Fout,b[i,j]:4,' ');
  54.     WriteLn(Fout);
  55.   end;
  56.   Close(Fout);
  57. end;
  58. //main
  59. begin
  60.   PullArray(a,m,n);
  61.   SetLength(b,m+1,n+1);
  62.   for j:=1 to ((n+1) div 2) do
  63.     for i:=1 to m do
  64.       b[i,j]:=Compute(a,m,n,i,j,1);
  65.   for j:=((n+1) div 2 +1) to n do
  66.     for i:=1 to m do
  67.       b[i,j]:=Compute(a,m,n,i,j,2);
  68.   PushArray(b,m,n);
  69. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement