Cod sursa(job #495528)

Utilizator andreii1Ilie Andrei andreii1 Data 25 octombrie 2010 19:13:00
Problema Subsir crescator maximal Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
type vector=array[1..100] of longint;
var x,p,z,q,i,n,j:longint;
    v,b,c,a:vector;
    f,g:text;
    gasit:boolean;

function cautb(n,x:longint):longint;
var st,dr,mij:longint;
    ok:boolean;
begin

st:=1;
dr:=n;
ok:=false;
while (ok=false) and (st<=dr) do
      begin
      mij:=(st+dr) div 2;
      if st=dr then ok:=true else
      if v[mij]=x then
         begin
         dr:=mij;
         break;
         end
            else
      if (v[mij]<x) and (x<v[mij+1]) then
         begin
         dr:=mij+1;
         break;
         end
          else
      if x<v[mij] then dr:=mij else
      if x>v[mij] then st:=mij+1 else
      end;
cautb:=dr;
end;

begin
assign(f,'scmax.in'); reset(f);
assign(g,'scmax.out'); rewrite(g);
read(f,n);
read(f,x);
q:=1;   a[1]:=x;
v[q]:=x;
b[1]:=1;
gasit:=true;
for i:=2 to n do
    begin
    read(f,x);  a[i]:=x;
    if a[i]<>a[i-1] then gasit:=false;
    if x>v[q] then
       begin
       q:=q+1;  p:=i;
       b[i]:=q;
       v[q]:=x;
       end
          else
       begin
       j:=cautb(q,x);
       v[j]:=x;
       b[i]:=j;
       end;
    end;
writeln(g,q);
z:=q;
if gasit then write(g,a[1])
   else
begin
while (q>0) do begin
      c[q]:=a[p];
      q:=q-1;
      for i:=p-1 downto 1 do
      if (b[i]=q) and (a[i]<c[q+1]) then
         begin
         p:=i;
         break
         end;
      end;
for i:=1 to z do write(g,c[i],' ');
end;

close(f);
close(g);
end.