Cod sursa(job #503313)

Utilizator vendettaSalajan Razvan vendetta Data 22 noiembrie 2010 15:19:31
Problema Subsir 2 Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.34 kb
var
    poz,a,l:array[1..5000] of longint;
    p1,min,i,j,n,max,p:longint;
    f,g:text;
begin
    assign(f,'subsir2.in');reset(f);
    assign(g,'subsir2.out');rewrite(g);
    readln(f,n);
    min:=maxint;
    for i:=1 to n do
        begin
            read(f,a[i]);
            if min>a[i] then
                            begin
                                min:=a[i];
                                p1:=i;
                            end;
        end;
    l[n]:=1;
    poz[n]:=-1;
    for i:=n-1 downto p1 do
        begin
            l[i]:=1;
            poz[i]:=-1;
            min:=maxint;
            for j:=i+1 to n do
                if (a[j]<min) and (a[i]<a[j]) and (l[i]<=1+l[j]) then
                                    begin
                                        if a[j]<min then min:=a[j];
                                        l[i]:=1+l[j];
                                        poz[i]:=j;
                                    end;
        end;
    max:=l[1];p:=1;
    for i:=2 to n do
        if max<l[i] then
                        begin
                            max:=l[i];
                            p:=i;
                        end;
    writeln(g,max);
    i:=p;
    while i<>-1 do
        begin
            write(g,i,' ');
            i:=poz[i];
        end;
    close(f);close(g);
end.