Cod sursa(job #119720)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 2 ianuarie 2008 22:35:04
Problema Ordine Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
const fi='ordine.in';
      fo='ordine.out';
var
   f:text;
   A:array[1..1000000] of char;
   Ap:Array['a'..'z'] of longint;
   p,i,u:longint;
   c:char;
   s:string;
Begin
     assign(f,fi);reset(f);
     while Not eof(f) do
     begin
          read(f,c);
          Ap[c]:=Ap[c]+1;
     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] do
                                  s:=s+c;
                               c:=succ(c)
                             end
             else c:=succ(c);
     end;
     while s<>'' do begin
        p:=u;
        while A[p]>=s[1] do
              p:=p-1;
        u:=u+1;
        For i:=u downto p+1 do
            A[i]:=A[i-1];
        A[p]:=s[1];
        delete(s,1,1);
     end;
     assign(f,fo);rewrite(f);
     i:=1;
     while A[i]<>#0 do begin
         write(f,A[i]);
         i:=i+1;
         end;
     close(f);
End.