Listing Calatorie.PAS
Program CalatorieCuBucluc;
type Sir=array[1..150] of Longint;
Var m,n:Byte;
suma:Longint;
fo:Text;
a:array[1..150] of ^Sir;
Procedure Citire;
Var f:Text;
i,j:Byte;
begin
Assign(f,?in.txt');
Reset(f);
Readln(f,m,n);
for i:=1 to m do
begin
New(a[i]);
Fillchar(a[i]^,Sizeof(a[i]^),0)
end;
for i:=1 to m do
for j:=1 to n do
Read(f,a[i]^[j]);
Close(f)
end;
Function Posibil:Boolean;
{ decide daca problema are solutie }
var s1,s2:Longint;
i,j:Byte;
begin
s1:=0; s2:=0;
for i:=1 to m do
for j:=1 to n do
if Odd(i+j)
then Inc(s1,a[i]^[j])
else Inc(s2,a[i]^[j]);
Posibil:=s1=s2
end;
Procedure Urmator(x,y:Byte; var xx,yy:Byte);
begin
xx:=x; yy:=y;
if Odd(x)
then
if yy=n
then
begin
xx:=x+1;
yy:=n
end
else yy:=y+1
else
if yy=1
then
begin
xx:=x+1;
yy:=1
end
else yy:=y-1
end;
Procedure Mutare(x1,y1:Byte; k:Longint);
var x2,y2:Byte;
begin
if k=0 then Exit;
Urmator(x1,y1,x2,y2);
Inc(a[x1]^[y1],k);
Inc(a[x2]^[y2],k);
Writeln(fo,x1,',',y1,' ?,x2,',',y2,'->',k)
end;
Procedure Rezolvare;
var x,y,xx,yy:Byte;
k:Longint;
begin
x:=1;
y:=1;
while x<>m+1 do
begin
Urmator(x,y,xx,yy);
if a[x]^[y]>a[xx]^[yy]
then
begin
k:=a[x]^[y]-a[xx]^[yy];
Mutare(xx,yy,k)
end;
Mutare(x,y,-a[x]^[y]);
x:=xx;
y:=yy
end
end;
Begin
Citire;
Assign(fo,'out.txt');
Rewrite(fo);
if Posibil
then Rezolvare
else writeln(fo,0);
Close(fo)
End.