Cod sursa(job #1169289)

Utilizator wollyFusy Wool wolly Data 10 aprilie 2014 21:23:18
Problema Avioane Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.35 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;

{function max(f:longint):longint;
var mx,i,pp:longint;
begin
	max:=0;
	for i:=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);

mxf:=0;
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;
mxt:=0;
for i:=n downto 2 do
	begin
	if t[i]*(n-i+1)>mxp then
		begin
		mxp:=t[i]*(n-i+1);
		f:=i-1;
		max:=0;
		mxn:=0;
		for j:=p downto 1 do
			begin
				mxn:=t[j]*(f-j+1);
				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.