var fi,fo:text;
    a,t,v:array[1..5005] of longint;
    n,i,k,p:longint;

 procedure solve;
  var i,j,minv,int,mina,minin:longint;
      min,vl,cj,ct,nr,aux,nrr:longint;
   begin
    for i:=n downto 1 do
     if (v[i]>minv) and (i<n-1) then
      begin
       a[i]:=1;
       t[i]:=i;
      end
     else
     begin
      nr:=1;
      nrr:=1;
      minv:=v[i+1];
      mina:=a[i+1];
      cj:=i+1;
      for j:=i+2 to n do
      begin
         if v[j]<minv then
          begin
           nr:=0;
           minv:=v[j];
           mina:=nr;
           cj:=j;
          end
         else
         if v[j]=minv then
          begin
           inc(nr);
           mina:=nr;
          end;
         if v[j]>minv then
           inc(nr);
       end;
      mina:=nr;
      if minv>=v[i] then
       begin
        a[i]:=mina+1;
        t[i]:=cj;
       end
        else
       begin
        a[i]:=1;
        t[i]:=i;
       end;
    end;
   for i:=1 to n do
    write(fo,t[i],' ');
   writeln(fo);
   for i:=1 to n do
    write(fo,a[i],' ');
   writeln(fo);
   min:=v[1];
   minin:=1;
   for i:=2 to n do
     if v[i]<min then
       begin
        min:=v[i];
        minin:=i;
       end;
   writeln(fo,a[minin]);
   write(fo,minin,' ');
   ct:=2;
   vl:=t[minin];
   i:=t[minin];
   while ct<a[minin] do
    begin
     write(fo,vl,' ');
     inc(ct);
     vl:=t[vl];
     i:=t[i];
    end;
   write(fo,vl);
  end;




begin
 assign(fi,'subsir2.in'); reset(fi);
 assign(fo,'subsir2.out'); rewrite(fo);
 readln(fi,n);
 for i:=1 to n do
   read(fi,v[i]);
 solve;
close(fi);
close(fo);
end.