Cod sursa(job #503931)

Utilizator vendettaSalajan Razvan vendetta Data 25 noiembrie 2010 19:34:36
Problema Subsir 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
var
    v,l,u:array[0..5010] of longint;
    n,i,j,k,m,p,o,r:longint;
    f:text;
begin
    assign(F,'subsir2.in');reset(F);
    read(f,n);
    for i:=1 to n do read(f,v[i]);
    close(f);
    v[0]:=-1000000001;
    for i:=n downto 0 do
        begin
        m:=1000000001;
        l[i]:=600002;
        o:=1000000001;
        for j:=i+1 to n do
            if(m>v[j]) and (v[j]>=v[i]) then
                begin
                if(l[j]<l[i]) then
                    begin
                    l[i]:=l[j];
                    o:=v[j];
                    u[i]:=j;
                    end
                else
                    if (l[j]=l[i])and(v[j]<=o) then
                        begin
                        o:=v[j];
                        u[i]:=j;
                        end;
                m:=v[j];
                end;
        if l[i]=600002 then
            begin
            l[i]:=0;
            u[i]:=i;
            end;
        l[i]:=l[i]+1;
        end;
    assign(f,'subsir2.out');rewrite(f);
    writeln(f,l[0]-1);
    r:=u[0];
    for i:=1 to l[0]-1 do
        begin
        write(f,r,' ');
        r:=u[r];
        end;
    writeln(f);
    close(f);
end.