SPSEQ - Sequences

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
program SPSEQ;
const
  input  = '';
  output = '';
  maxn = 100000;
var
  a,b,d,pos: array[1..maxn] of integer;
  L,L1,L2,t: array[1..maxn] of integer;
  n: integer;
  res: integer;

procedure init;
var
  f: text;
  i: integer;
begin
  assign(f, input);
    reset(f);

  readln(f, n);
  for i := 1 to n do
    begin
      read(f, d[i]);
      pos[i] := i;
    end;

  close(f);
end;

procedure swap(var x,y: integer);
var
  z: integer;
begin
  z := x;  x := y;  y := z;
end;

procedure swapint(i,j: integer);
begin
  swap(d[i],d[j]);
  swap(pos[i],pos[j]);
end;

procedure quicksort;

  procedure par(l,h: integer);
  var
    i,j,p: integer;
  begin
    if l >= h then exit;
    i := l;  j := h;  p := d[random(h - l + 1) + l];

    repeat
      while (d[i] < p) do inc(i);
      while (d[j] > p) do dec(j);

      if i <= j then
        begin
          if i < j then swapint(i,j);
          inc(i);
          dec(j);
        end;
    until i > j;

    par(l,j);
    par(i,h);
  end;

var
  i,c: integer;
begin
  par(1,n);
  c := 1;
  b[pos[1]] := 1;
  for i := 2 to n do
    begin
      if d[i] > d[i - 1] then inc(c);
      b[pos[i]] := c;
    end;
end;

procedure update(x,m: integer);
begin
  while x <= maxn do
    begin
      if t[x] < m then t[x] := m;
      x := x + (x and -x);
    end;
end;

function calc(x: integer): integer;
var
  r: integer;
begin
  r := 0;
  while x > 0 do
    begin
      if r < t[x] then r := t[x];
      x := x - (x and -x);
    end;
  calc := r;
end;

procedure optimize;
var
  i: integer;
begin
  fillchar(t, sizeof(t), 0);

  update(1,1);
  for i := 1 to n do
    begin
      L[i] := calc(a[i]);
      update(a[i] + 1,L[i] + 1);
    end;
end;

procedure solve;
var
  i,min: integer;
begin
  for i := 1 to n do a[i] := b[i];
  optimize;
  L1 := L;

  for i := 1 to n do a[i] := b[n + 1 - i];
  optimize;
  L2 := L;

  res := 0;
  for i := 1 to n do
    begin
      if L1[i] > L2[n + 1 - i] then min := L2[n + 1 - i] else min := L1[i];
      if res < min then res := min;
    end;
end;

procedure printresult;
var
  f: text;
begin
  assign(f, output);
    rewrite(f);
    writeln(f, 2 * res - 1);
  close(f);
end;

begin
  init;
  quicksort;
  solve;
  printresult;
end.

Download