Cod sursa(job #93359)

Utilizator 7RaduRadu Antohi 7Radu Data 18 octombrie 2007 17:03:02
Problema Secv Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.87 kb
program Secv;
var
   Fl : text;
   a : array[1..5000] of longint;
   b, c : array[1..5000] of integer;
   n, i, j, k, p : integer;
begin
   Assign(Fl,'secv.in');
   Reset(Fl);
   ReadLn(Fl,n);
   for i := 1 to n do
      Read(Fl,a[i]);
   Close(Fl);

   for i := 1 to n do
      begin
         b[i] := 0;
         c[i] := 0;
      end;

   WriteLn;
   b[n] := 1;
   for i := n-1 downto 1 do
      begin
         k := i;
         for j := i+1 to n do
            if (b[j] > b[k]) and (a[j] > a[i]) then
               begin
                  k := j;
                  c[i] := j;
               end;
         b[i] := b[k] + 1;
      end;

  k := 1;
  for i := 2 to n do
     if b[k] < b[i] then
        k := i;

  p := k;
  while c[k] <> 0 do
      k := c[k];

   Assign(Fl,'secv.out');
   ReWrite(Fl);
   WriteLn(Fl,k-p+1);
   Close(Fl);
end.