Cod sursa(job #1169280)

Utilizator wollyFusy Wool wolly Data 10 aprilie 2014 21:08:59
Problema Avioane Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
type tab=array[0..100100] of longint;
var a,b:text;
	t:tab;
	n,i,mx,mxt,mxp,mxf,p:longint;
	
function min(a,b:longint):longint;
begin
	if a<b then min:=a else min:=b;
end;	
	
function max(f:longint):longint;
var mx,i,pp:longint;
begin
	max:=0;
	for i:=min(f,p) downto 1 do
		begin
			mx:=t[i]*(f-i+1);
			if mx>max then begin max:=mx; pp:=i; end;
		end;
	p:=pp;
end;	
	
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;
	
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)>mxf then
	begin
		mxf:=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);
		mx:=t[i]*(n-i+1)+max(i-1);
		if mx>mxt then mxt:=mx;
		end;
	end;

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