poj 3378 pascal

Description

These days, Sempr is crazed on one problem named Crazy Thair.Given N (1 ≤ N ≤ 50000) numbers, which  are nomore 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 fourCrazy 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 many Crazy Thairs in thesequence?

Input

Input contains several test cases. Each test case begins with aline containing a number N,followed by a line containing N numbers.

Output

Output the amount of Crazy Thairs in each sequence.

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

题目大意：求长度为5的不下降序列的个数。

分析：一看这题，就想到了一个dp算法。

f[I,j]表示用a[i]结尾的长度为j的序列数目。

F[I,j]= sum(f[k,j-1]) (1<=k<I且a[i]>a[k])        

 

因为时间复杂度太大，为O(N^2)(n<=50000),所以我们应该用树状数组求sum(f[k,j-1])，就可以快速求解。要用高精度求解。

 

const
maxn=1000;
type
nd=record
x,y:longint;
end;

var
dp:array [1..50005,1..5] of int64;
mac,len,i,n,k:longint;
c:array [0..50000] of longint; {表示原数在排序好数列的数列}
s:array [0..50000] of nd;
sum:array [0..maxn] of longint;

procedure qsort(l,r:longint);
var
i,j,key,key1:longint;
temp:nd;
begin
if l>=r then exit;
i:=l;j:=r;
key:=s[(l+r) shr 1].x;
key1:=s[(l+r) shr 1].y;
repeat
while  (s[i].x<key) or (s[i].x=key) and (s[i].y<key1) do inc(i);
while  (s[j].x>key) or (s[j].x=key) and (s[j].y>key1) do dec(j);
if i<=j then
begin
temp:=s[i];s[i]:=s[j];s[j]:=temp;
inc(i);dec(j);
end;
until i>j;
qsort(l,j);
qsort(i,r);
end;
procedure add(n:qword);
var i:longint;
a,b:array [0..maxn] of longint;
begin

fillchar(a,sizeof(a),0);
fillchar(b,sizeof(b),0);
i:=-1;
while n>0 do
begin
inc(i);
a[i]:=n mod 10;
n:=n div 10;
end;
i:=-1;
while i<1000 do
begin
inc(i);
b[i]:=a[i]+sum[i]+b[i];
if b[i]>=10 then
begin
inc(b[i+1]);
b[i]:=b[i] mod 10;
end;
end;
for i:=0 to 999 do
sum[i]:=b[i];
end;

function bit(n:longint):longint;
begin
exit(n and -n);
end;

function count(n,j:longint):int64;
var ans:int64;
begin
ans:=0;
while n>0 do
begin
ans:=ans+dp[n,j];
n:=n-bit(n);
end;
exit(ans);
end;
procedure update(n,j:longint;k:int64);
begin
while n<=mac do
begin
dp[n,j]:=dp[n,j]+k;
n:=n+bit(n);
end;
end;
procedure dpp(n:longint);
var tem:int64;
i,j:longint;
begin
fillchar(dp,sizeof(dp),0);
fillchar(sum,sizeof(sum),0);
len:=1;
for i:=1 to n do
begin
tem:=count(c[i]-1,4);

add(tem);
for j:=5 downto 2 do
begin
tem:=count(c[i]-1,j-1);
update(c[i],j,tem);
end;
update(c[i],1,1);
end;
len:=1000;
while(sum[len]=0) and (len>0) do
dec(len);
for i:=len downto 0 do
write(sum[i]);
writeln;
end;
begin
while not eof do
begin
readln(n);
mac:=n;
for i:=1 to n do
begin
read(s[i].x);
s[i].y:=i;
end;
readln;
qsort(1,n);
c[s[1].y]:=1;
k:=0;
for i:=1 to n do
begin
if(s[i].x=s[i-1].x) then
c[s[i].y]:=c[s[i-1].y]
else
begin
c[s[i].y]:=k+1;
inc(k);
end;
end;
dpp(n);
end;
end.