Cod sursa(job #138781)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 19 februarie 2008 09:51:22
Problema Subsir 2 Scor 52
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
program subsir2;
type vect = array [1..5000] of longint;
var A,B : vect;
    m,n,mn : longint;
    i,j,l,p : integer;
    f : text;
    ok : boolean;
begin
assign(f,'subsir2.in');
reset(f);
readln(f,n);
mn := 1000001;
for i := 1 to n do begin
read(f,A[i]);
if mn>A[i] then begin
                mn := A[i];
                p := i;
                end;
end;
close(f);


l := 1;
B[l] := p;

repeat
m := 1000001;
ok := true;
for i := p to n do
if A[i]<m then
          if A[i]>mn then begin
                          m := A[i];
                          j := i;
                          ok := false;
                          end;
mn := m;
p := j;
l := l +1;
B[l] := p;
until ok;

assign(f,'subsir2.out');
rewrite(f);
writeln(f,l-1);

for i := 1 to l-1 do
write(f,B[i],' ');
close(f);

end.