Crazy Thairs_poj3378_DP+离散+高精度+树状数组

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.