Cod sursa(job #62895)

Utilizator cezar305Mr. Noname cezar305 Data 24 mai 2007 19:26:12
Problema Subsir 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.33 kb
var f1,f2:text;
    n,i,ind,poz,min,j,h,scm,ming,nr:longint;
    a,v,e,x,y:array[1..5000] of longint;
    ok:boolean;
begin
        assign(f1,'subsir2.in');
        reset(f1);
        assign(f2,'subsir2.out');
        rewrite(f2);
        read(f1,n);
        for i:=1 to n do
                read(f1,a[i]);
        if n<1001 then
        begin
        for i:=n downto 1 do
        begin
                min:=maxlongint;
                ming:=maxlongint;
                for j:=i+1 to n do
                        if a[i]<=a[j] then
                        begin
                                e[j]:=1;
                                if ((v[j]<min)and(a[j]<ming))or((v[j]=min)and(a[j]<ming)) then
                                begin
                                        min:=v[j];
                                        x[i]:=j;
                                end;
                                if a[j]<ming then ming:=a[j];
                        end;
                if min=maxlongint then min:=0;
                v[i]:=min+1;
                for j:=i+1 to n do
                        if (v[j]=v[i])and(a[j]<a[i])and(e[j]=0) then e[i]:=1;
        end;
        min:=maxlongint;
        for i:=1 to n do
        begin
                if (e[i]=0) and (v[i]<min) then
                begin
                        scm:=i;
                        min:=v[i];
                end;

        end;
        writeln(f2,min);
        while scm<>0 do
        begin
                write(f2,scm,' ');
                scm:=x[scm];
        end;
        end;
        if n>1000 then
        begin
        ok:=true;
        ind:=1;
        nr:=-maxlongint;
        while ok=true do
        begin
                ok:=false;
                min:=maxlongint;
                for i:=ind to n do
                        if (a[i]<=min)and(a[i]>=nr) then
                        begin
                                min:=a[i];
                                poz:=i;
                                ok:=true;
                        end;
                if ok=false then break;
                ind:=poz+1;
                inc(j);
                v[j]:=poz;
                nr:=a[j];
        end;
        writeln(f2,j);
        for i:=1 to j do write(f2,v[i],' ');
        end;
        close(f1);
        close(f2);
end.