Cod sursa(job #1169315)

Utilizator wollyFusy Wool wolly Data 10 aprilie 2014 21:48:00
Problema Avioane Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
type tab=array[0..100100] of longint;
var a,b:text;
	t:tab;
	n,i,mx,mxt,mxp,mxf,p,mxn,j,pp,max,f:longint;

procedure qsort(s,f:longint);
var p,i,j,ax:longint;
begin
	i:=s;
	j:=f;
	p:=t[(s+f) div 2];
	while i<j do
	begin
		while (t[i]<p) and (i<f) do i:=i+1;
		while (t[j]>p) and (j>s) do j:=j-1;
		if (i<=j) then
			begin
			ax:=t[i];
			t[i]:=t[j];
			t[j]:=ax;
			i:=i+1;
			j:=j-1;
			end;
	end;
	if j>s then qsort(s,j);
	if i<f then qsort(i,f);
end;
	
function maxx(a,b:longint):longint;
begin
	if a>b then max:=a else max:=b;
end;	
	
begin
assign(a,'avioane.in'); reset(a);
assign(b,'avioane.out'); rewrite(b);

read(a,n);
for i:=1 to n do
read(a,t[i]);

qsort(1,n);

for i:=n downto 1 do
	if t[i]*(n-i+1)>mxp then
		begin
			mxp:=t[i]*(n-i+1);
			p:=i;
		end;
mxp:=0;

for i:=n downto 2 do
	begin
	if t[i]*(n-i+1)>mxp then
		begin
		mxp:=t[i]*(n-i+1);
		max:=0;
		for j:=p downto 75000 do
			begin
			mxn:=t[j]*(i-j);
			if mxn>max then 
				begin 
				max:=mxn; 
				pp:=j; 
				end;
			end;
		p:=pp;
		mx:=t[i]*(n-i+1)+max;
		if mx>mxt then mxt:=mx;
		end;
	end;

writeln(b,mxt);
	
close(a);
close(b);
end.