Description
These days, Sempr is crazed on one problemnamed Crazy Thair. Given N (1 ≤ N ≤ 50000)numbers, which are no more than 109,Crazy Thair is a group of 5 numbers {i, j, k, l, m} satisfying:
1. 1 ≤ i < j < k < l < m ≤ N
2. Ai < Aj < Ak < Al < Am
For example, in the sequence {2, 1, 3, 4,5, 7, 6},there are four Crazy Thair groups: {1, 3, 4, 5, 6}, {2, 3, 4, 5, 6},{1, 3, 4, 5, 7} and {2, 3, 4, 5, 7}.
Could you help Sempr to count how manyCrazy Thairs in the sequence?
Input
Input contains several test cases. Eachtest case begins with a line containing a number N, followed by a linecontaining N numbers.
Output
Output the amount of Crazy Thairs in eachsequence.
Sample Input
5
1 2 3 4 5
7
2 1 3 4 5 7 6
7
1 2 3 4 5 6 7
Sample Output
1
4
21
题目大意:
给一个长度为n的序列ai,定义五元组(i,j,k,l,m)满足:
1<=i<j<k<l<m<=n;
ai<aj<ak<al<am;
问序列中有多少个满足条件的五元组。
数据范围:1 <= n <= 50000, 0 <=ai <= 10^9
思路:
本题不止一个大写的坑爹
不要因为看到一坨的解法就望而却步
撇开神奇的翻译,首先可以想到一个简单的dp方程
设f[i][j]表示从前i个数中选择j个数且第j个数为a[i]的种数,则
f[i][j] = f[k][j - 1], 0 <k<i且a[k]<a[i]
直接作的时间复杂度是O(5 * n ^ 2)
转移的时候其实是转移sum(f[k][j-1]), 0 < k < i, 且a[k] < a[i],具有区间性。
利用树状数组优化转移时间复杂度。
然而提交超时+wa+mle超过三页我也是懵逼,F8到手残终于发现中间过程不需要用到高精度,只有在最后累计求f[5]之和才有用。
输入完要readln换行不然会多输出一行0
高精度最多25位,位数太多会TLE
不说了都是泪,毕竟oi用pascal本来就很少,标程数据什么的几乎没有,心好累。
源代码/pas:
const
maxn=25;
type
num=array[0..maxn]of longint;
var
n:longint;
c:array[0..5,0..50100]of int64;
a,f,dx:array[0..50100]of longint;
ans:num;
procedure sort(l,r:longint);
var
x,y,key:longint;
temp:int64;
begin
if l>=r then exit;
x:=l;
y:=r;
key:=a[l+random(r-l+1)];
repeat
while (a[x]<key) do inc(x);
while (a[y]>key) do dec(y);
if x<=y then
begin
temp:=a[x];
a[x]:=a[y];
a[y]:=temp;
temp:=dx[x];
dx[x]:=dx[y];
dx[y]:=temp;
inc(x);
dec(y);
end;
until x>y;
sort(l,y);
sort(x,r);
end;
procedure plus(v:int64);
var
i:longint;
p,y:num;
begin
fillchar(p,sizeof(p),0);
fillchar(y,sizeof(y),0);
i:=0;
while v>0 do
begin
inc(i);
y[i]:=v mod 10;
v:=v div 10;
end;
for i:=1 to maxn do
begin
p[i]:=p[i]+ans[i]+y[i];
if p[i]>=10 then
begin
inc(p[i+1]);
p[i]:=p[i]mod 10;
end;
end;
ans:=p;
end;
function get(t,x:longint):int64;
begin
get:=0;
while x>0 do
begin
get:=get+c[t,x];
x:=x-(x and(-x));
end;
end;
procedure add(t,x:longint;y:int64);
begin
while x<=n do
begin
c[t,x]:=c[t,x]+y;
x:=x+(x and(-x));
end;
end;
procedure pre;
var
i,m:longint;
begin
fillchar(a,sizeof(a),0);
fillchar(c,sizeof(c),0);
fillchar(f,sizeof(f),0);
fillchar(dx,sizeof(dx),0);
fillchar(ans,sizeof(ans),0);
for i:=1 to n do
begin
read(a[i]);
dx[i]:=i;
end;
readln;
sort(1,n);
f[dx[1]]:=1;
m:=0;
for i:=1 to n do
begin
if a[i]=a[i-1] then
f[dx[i]]:=f[dx[i-1]]
else
begin
inc(m);
f[dx[i]]:=m;
end;
end;
end;
procedure main;
var
i,j,x,m:longint;
tem:int64;
begin
read(n);
pre;
for i:=1 to n do
begin
tem:=get(4,f[i]-1);
plus(tem);
for j:=5 downto 2 do
begin
tem:=get(j-1,f[i]-1);
add(j,f[i],tem);
end;
add(1,f[i],1);
end;
for i:=maxn downto 1 do if ans[i]<>0 then break;
for j:=i downto 1 do write(ans[j]);
writeln;
end;
begin
while not eof do main;
end.