Advertisement
ALTracer

Matrix operation №4

May 13th, 2016
373
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.92 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+2,n+2);
  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. procedure FlushArray(var b:MyArray; m,n:Word; bulk:Boolean);
  24. var i,j:Word;
  25. begin
  26.   case bulk of
  27.     False: begin
  28.       SetLength(b,m+2,n+2);
  29.       for i:=0 to m+1 do b[i,0]:=0;
  30.       for i:=0 to m+1 do b[i,n+1]:=0;
  31.       for j:=0 to n+1 do b[0,j]:=0;
  32.       for j:=0 to n+1 do b[m+1,j]:=0;
  33.      end;
  34.     True: begin
  35.       SetLength(b,0,0);
  36.       SetLength(b,m+2,n+2);
  37.       for i:=0 to m+1 do
  38.         for j:=0 to n+1 do
  39.           b[i,j]:=0;
  40.      end;
  41.     end;
  42. end;
  43.  
  44. function Compute(a:MyArray; m,n:Word; y,x:Word; mode:Integer):Integer;
  45. var i,i1,i2,j,j1,j2:Word;
  46.   s:Integer;
  47. begin
  48.   if mode=1 then begin //down-right
  49.        i1:=y+1;
  50.   j1:=x+1;  j2:=n;
  51.        i2:=m;
  52.   end else begin //upper-left
  53.        i1:=1;
  54.   j1:=1;  j2:=x-1;
  55.        i2:=y-1;
  56.   end;
  57.   s:=0;
  58.   {if i1<1 then i1:=1;
  59.   if i2>m then i2:=m;
  60.   if j1<1 then j1:=1;
  61.   if j2>n then j2:=n;}
  62.   for i:=i1 to i2 do
  63.     for j:=j1 to j2 do
  64.       s:=s+a[i,j];
  65.   Compute:=s;
  66. end;
  67.  
  68. procedure PushArray(b:MyArray; m,n:Word);
  69. var i,j:Word;
  70.   Fout:Text;
  71. begin
  72.   Assign(Fout,'out.txt');
  73.   ReWrite(Fout);
  74.   WriteLn(Fout,m,' ',n);
  75.   for i:=1 to m do
  76.   begin
  77.     for j:=1 to n do
  78.       Write(Fout,b[i,j]:4,' ');
  79.     WriteLn(Fout);
  80.   end;
  81.   Close(Fout);
  82. end;
  83. //main
  84. begin
  85.   PullArray(a,m,n);
  86.   FlushArray(a,m,n,False);
  87.   SetLength(b,m+1,n+1);
  88.   for j:=1 to ((n+1) div 2) do
  89.     for i:=1 to m do
  90.       b[i,j]:=Compute(a,m,n,i,j,1);
  91.   for j:=((n+1) div 2 +1) to n do
  92.     for i:=1 to m do
  93.       b[i,j]:=Compute(a,m,n,i,j,2);
  94.   PushArray(b,m,n);
  95. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement