Cod sursa(job #7669)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 21 ianuarie 2007 21:33:51
Problema Elimin Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.56 kb
program asd;
var f,g:text;
a:array[1..100,1..100] of integer;
li,ci:array[1..100] of longint;
min,posi,posj,m,s1,s,n,i,j,k,r,c:longint;
procedure Sort(l, r: Integer);
var
  i, j, x, y: longint;
begin
  i := l; j := r; x := li[(l+r) DIV 2];
  repeat
    while li[i] < x do i := i + 1;
    while x < li[j] do j := j - 1;
    if i <= j then
    begin
      y := li[i]; li[i] := li[j]; li[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
procedure qSort(l, r: Integer);
var
  i, j, x, y: longint;
begin
  i := l; j := r; x := ci[(l+r) DIV 2];
  repeat
    while ci[i] < x do i := i + 1;
    while x < ci[j] do j := j - 1;
    if i <= j then
    begin
      y := ci[i]; ci[i] := ci[j]; ci[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then qSort(l, j);
  if i < r then qSort(i, r);
end;


begin
assign(f,'elimin.in');
assign(g,'elimin.out');
reset(f);
rewrite(G);
readln(f,m,n,r,c);
for i:=1 to m do
begin
        for j:=1 to n do
        begin
                read(f,a[i,j]);
                li[i]:=li[i]+a[i,j];
                ci[j]:=ci[j]+a[i,j];
        end;
        readln(f);
end;
repeat
c:=c-1;
r:=r-1;
min:=maxlongint;
for i:=1 to m do
        for j:=1 to n do
                 if li[i]+ci[j]-a[i,j]<min then
                                                begin
                                                min:=li[i]+ci[j]-a[i,j];
                                                posi:=i;
                                                posj:=j;
                                                end;
for i:=1 to m do
        li[i]:=li[i]-a[i,posj];
for j:=1 to n do
        ci[j]:=ci[j]-a[posi,j];
for i:=posi to m-1 do
begin
        for j:=1 to n do a[i,j]:=a[i+1,j];
li[i]:=li[i]+1;
end;
for i:=1 to m do
        for j:=posj to n-1 do
                a[i,j]:=a[i,j+1];
for j:=posj to n-1 do
        ci[j]:=ci[j]+1;
m:=m-1;
n:=n-1;
until (c=0) or (r=0);
if c<>0 then
        begin
        qsort(1,n);
        s:=0;
        for i:=c+1 to n do s:=s+ci[i];
        writeln(g,s);
        end
        else
        if r<>0 then
                begin
                sort(1,m);
                s:=0;
                for i:=r+1 to n do
                        s:=s+li[i];
                writeln(g,s);
                end
                else
                begin
                s:=0;
                for i:=1 to n do s:=s+li[i];
                writeln(g,s);
                end;
close(f);
close(G);
end.