# Cod sursa(job #7165)

Utilizator Data 21 ianuarie 2007 12:56:38 Elimin 30 fpc done preONI 2007, Runda 1, Clasa a 10-a 3.28 kb
``````{\$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{\$M 65520,0,655360}

type matrix = array[1..350,1..350] of integer;
var ma:matrix;
v:array[1..10000] of integer;
summax,sum,i,j,int:longint;
m,n,p,r,k,c,piv:longint;
fi,fo:text;

procedure inloc(x,y:longint);
var i:longint;
aux:integer;
begin
for i:=1 to n do
if i<>k then
begin
aux:=ma[x,i];
ma[x,i]:=ma[y,i];
ma[y,i]:=aux;
end;
end;

function part(st,dr:longint):longint;
var p,i,j,aux:longint;
sens:integer;
begin

p := st + random(dr-st+1);
aux:=ma[st,k];
ma[st,k]:=ma[p,k];
ma[p,k]:=aux;
inloc(st,p);

i:=st; j:=dr; sens:=-1;
while i<j do
begin
if ma[i,k]<ma[j,k] then
begin
aux:=ma[i,k];
ma[i,k]:=ma[j,k];
ma[j,k]:=aux;
inloc(i,j);
sens:=-sens;
end;
if sens=1 then inc(i)
else dec(j);
end;
part:=i;
end;

procedure qsort(st,dr:longint);
var p:longint;
begin
if st<dr then
begin
p:=part(st,dr);
qsort(st,p-1);
qsort(p+1,dr);
end;
end;

function part1(st,dr:longint):longint;
var p,i,j,aux:longint;
sens:integer;
begin

p := st + random(dr-st+1);
aux:=v[st];
v[st]:=v[p];
v[p]:=aux;

i:=st; j:=dr; sens:=-1;
while i<j do
begin
if v[i]<v[j] then
begin
aux:=v[i];
v[i]:=v[j];
v[j]:=aux;
sens:=-sens;
end;
if sens=1 then inc(i)
else dec(j);
end;
part1:=i;
end;
procedure qsort1(st,dr:longint);
var p:longint;
begin
if st<dr then
begin
p:=part1(st,dr);
qsort1(st,p-1);
qsort1(p+1,dr);
end;
end;

begin
assign(fi,'elimin.in'); reset(fi);
assign(fo,'elimin.out'); rewrite(fo);
for i:=1 to m do
for j:=1 to n do

for k:=1 to n do
begin
for i:=1 to n do
v[i]:=0;
qsort(1,m);
{    writeln(fo,k);  }
{    for i:=1 to m do
begin
for j:=1 to n do
write(fo,ma[i,j],' ');
writeln(fo);
end;
writeln(fo,'*****************');
}
int:=0;
for i:=1 to m-r do
inc(int,ma[i,k]);
p:=1;
{   writeln(fo,int);   }
for i:=1 to n do
if i<>k then
begin
for j:=1 to m-r do
v[p]:=v[p]+ma[j,i];
inc(p);
end;
qsort1(1,p-1);
{for i:=1 to p-1 do
write(fo,v[i],' '); }
{ writeln(fo);}
sum:=int;
for i:=1 to n-c-1 do
inc(sum,v[i]);
{   writeln(fo,sum);  }
if sum>summax then summax:=sum;
end;
writeln(fo,summax);
close(fi);
close(fo);
end.
``````