Cod sursa(job #180072)

Utilizator madmanjonesJones the one madmanjones Data 16 aprilie 2008 16:50:26
Problema Jocul Flip Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.99 kb
var i,nrp,max,nrmax,j,n,aux,p,pmax:integer;
    nr,nrsort:array[1..10000] of integer;

function sort(x:longint):longint;
         var i,c:byte;
             xx,y:longint;
         begin
              y:=0;
              for i:=9 downto 0 do begin
              xx:=x;
                   repeat
                         c:=xx mod 10;
                         if c=i then y:=y*10+c;
                         xx:=xx div 10;
                   until xx=0;
         end;
         sort:=y;
         end;

procedure citire;

          var i:integer;
          f:text;
          begin
          assign(f,'pluton.in'); reset(f);
               readln(f,n);
               for i:=1 to n do begin
                        readln(f,nr[i]);
                        nrsort[i]:=sort(nr[i]);
                        end;
               close(f);
                        end;
begin
     citire;
     nrp:=0;
     max:=0;
     nrmax:=0;
     i:=1;
     while i<=n do begin
           j:=i+1;
           p:=i;
           while j<=n do begin
                 if nrsort[i]=nrsort[j] then begin
                                        i:=i+1;
                                        aux:=nr[i];
                                        nr[i]:=nr[j];
                                        nr[j]:=aux;
                                        aux:=nrsort[i];
                                        nrsort[i]:=nrsort[j];
                                        nrsort[j]:=aux;
                                        end;
                 j:=j+1;
                 end;
           i:=i+1;
           inc(nrp);
           if i-p>max then begin
                           max:=i-p;
                           nrmax:=1;
                           pmax:=p;
                           end
                       else if i-p=max then inc(nrmax);
           end;
           writeln(nrp);
           writeln(max);
           writeln(nrmax);
          for i:=pmax to pmax+max-1 do writeln(nr[i],' ');
end.