TPINCD - Dãy con tăng

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=10001;
      z=15111992;
var n,k,max,re:longint;
    a,e,d:array[0..maxn] of longint;
    f,g:array[1..50,0..maxn] of longint;

procedure rf;
var i:longint;
begin
     assign(input,fi); reset(input);
     read(n,k);
     for i:=1 to n do
     begin
          read(a[i]);
          d[i]:=i;
     end;
     close(input);
end;

procedure sort(l,r:longint);
var i,j,x,y:longint;
begin
     i:=l; j:=r; x:=a[(i+j) shr 1];
     repeat
           while a[i]<x do i:=i+1;
           while a[j]>x do j:=j-1;
           if i<=j then
           begin
                y:=a[i]; a[i]:=a[j]; a[j]:=y;
                y:=d[i]; d[i]:=d[j]; d[j]:=y;
                i:=i+1; j:=j-1;
           end;
     until i>j;
     if i<r then sort(i,r);
     if l<j then sort(l,j);
end;

procedure edit;
var i:longint;
begin
     a[0]:=-1; d[0]:=0;
     for i:=1 to n do
     begin
          e[d[i]]:=i;
          if a[i]=a[i-1] then d[i]:=d[i-1]
          else d[i]:=d[i-1]+1;
     end;
     max:=d[n];
end;

procedure add(j,x,t:longint);
begin
     if t=0 then exit;
     while x<=max do
     begin
          f[j,x]:=f[j,x]+t;
          if f[j,x]>=z then f[j,x]:=f[j,x]-z;
          x:=x+x and (-x);
     end;
end;

function calc(j,x:longint):longint;
var r:longint;
begin
     r:=0;
     while x>0 do
     begin
          r:=r+f[j,x];
          if r>=z then r:=r-z;
          x:=x-x and (-x);
     end;
     calc:=r;
end;

procedure pr;
var i,x,j,t,u:longint;
begin
     sort(1,n);
     edit;
     if k=1 then
     begin
          re:=max;
          exit;
     end;
     for i:=1 to n do
     begin
          x:=d[e[i]];
          t:=calc(k-1,x-1);
          re:=(re+t+z-g[k,x]) mod z;
          add(k,x,(t+z-g[k,x]) mod z);
          g[k,x]:=t;
          for j:=k-1 downto 2 do
              begin
                   t:=calc(j-1,x-1);
                   if t<g[j,x] then u:=z else u:=0;
                   add(j,x,t+u-g[j,x]);
                   g[j,x]:=t;
              end;
          if g[1,x]=0 then
          begin
               add(1,x,1);
               g[1,x]:=1;
          end;
     end;
end;

procedure wf;
begin
     assign(output,fo); rewrite(output);
     writeln(re);
     close(output);
end;

begin
     rf;
     pr;
     wf;
end.

Download