Cod sursa(job #119718)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 2 ianuarie 2008 22:15:36
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.47 kb
const fi='ordine.in';
      fo='ordine.out';
var
   f:text;
   A:array[1..64000] of char;
   Ap:Array['a'..'z'] of longint;
   i,u,max,k:longint;
   c,x,ch:char;
   s:string;
Begin
     assign(f,fi);reset(f);
     while Not eof(f) do
     begin
          read(f,c);
          Ap[c]:=Ap[c]+1;
          k:=k+1;
          if Ap[c]>max then begin
                                 max:=Ap[c];
                                 x:=c;
                            end;
     end;
     close(f);
     u:=0;
     c:='a';
     s:='';
     while c<'z' do
     begin
          if Ap[c]>0 then
             if A[u]<>c then begin
                                  u:=u+1;
                                  A[u]:=c;
                                  Ap[c]:=Ap[c]-1;
                                  if s<>'' then begin
                                                     u:=u+1;
                                                     A[u]:=s[1];
                                                     Ap[s[1]]:=Ap[s[1]]-1;
                                                     delete(s,1,1);
                                                end;
                             end
                        else begin
                               for i:=1 to Ap[c]-1 do
                                  s:=s+c;
                               c:=succ(c)
                             end
             else c:=succ(c);
     end;

     assign(f,fo);rewrite(f);
     close(f);
End.