Cod sursa(job #16274)

Utilizator alex_bBinca Alexandra alex_b Data 12 februarie 2007 19:36:12
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.18 kb
program elimin;
type matrice=record
			l,c:byte;
      m:array[0..100,0..100]of word;
      end;
var f1,f2:text; a:matrice;
		i,j,suma,min,r,c,k,p,q:longint;
    ok:boolean;
begin
assign(f1,'elimin.in');
reset(f1);
read(f1,a.l,a.c,r,c);
for i:=1 to a.l do
	for j:=1 to a.c do
  	read(f1,a.m[i,j]) ;
close(f1);
suma:=0;
for i:=1 to a.l do
	for j:=1 to a.c do
  	suma:=suma+a.m[i,j];
k:=0;
repeat
	k:=k+1;
	for i:=1 to a.l do
		begin
  	a.m[i,0]:=0;
  	for j:=1 to a.c do
  		a.m[i,0]:=a.m[i,0]+a.m[i,j];
  	end;
	for i:=1 to a.c do
		begin
  	a.m[0,i]:=0;
  	for j:=1 to a.l do
  		a.m[0,i]:=a.m[0,i]+a.m[i,j];
  	end;
	min:=a.m[1,0]+a.m[0,1]-a.m[1,1];
	i:=0;
  ok:=false;
	while (i<a.l) and (ok=false) do
  	begin
    i:=i+1;
		for j:=1 to a.c do
    	if a.m[i,0]+a.m[0,j]-a.m[i,j]<min then
    		begin
				min:=a.m[i,0]+a.m[0,j]-a.m[i,j];
    		p:=i;
    		q:=j;
        ok:=true;
    		end;
    end;
	suma:=suma-min;
	for i:=p to a.l-1 do
  	begin
			for j:=1 to	a.c do
				a.m[i,j]:=a.m[i+1,j];
			a.l:=a.l-1;
		end;
for j:=q to a.c-1 do
	begin
		for i:=1 to	a.l do
			a.m[i,j]:=a.m[i,j+1];
		a.c:=a.c-1;
		end;
until (k=r) or (k=c);
if k<r then
	repeat
  	k:=k+1;
		for i:=1 to a.l do
			begin
  		a.m[i,0]:=0;
      for j:=1 to a.c do
  			a.m[i,0]:=a.m[i,0]+a.m[i,j];
  		end;
    min:=a.m[1,0];
		i:=0;
  	ok:=false;
		while (i<a.l) and (ok=false)do
    	begin
      i:=i+1;
    	if a.m[i,0]<min then
    		begin
				min:=a.m[i,0];
    		p:=i;
        ok:=true;
    		end;
      end;
	suma:=suma-min;
	for i:=p to a.l-1 do
				a.m[i,0]:=a.m[i+1,0];
			a.l:=a.l-1;
	until k=r
else
	if k<c then
	repeat
  	k:=k+1;
		for i:=1 to a.c do
			begin
  		a.m[0,i]:=0;
      for j:=1 to a.l do
  			a.m[0,i]:=a.m[0,i]+a.m[i,j];
  		end;
    min:=a.m[0,1];
		i:=0;
  	ok:=false;
		while (i<a.l) and (ok=false) do
    	begin
      i:=i+1;
    	if a.m[0,i]<min then
    		begin
				min:=a.m[i,0];
    		p:=i;
        ok:=true;
    		end;
      end;
	suma:=suma-min;
	for i:=p to a.c-1 do
				a.m[0,i]:=a.m[0,i+1];
			a.c:=a.c-1;
	until k=c;
assign(f2,'elimin.out');
rewrite(f2);
write(f2,suma);
close(f2);
end.