Cod sursa(job #119693)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 2 ianuarie 2008 18:54:19
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.72 kb
const fi='ordine.in';
      fo='ordine.out';
var
   f:text;
   Ap:Array['a'..'z'] of longint;
   ch,c:char;
Begin
     assign(f,fi);reset(f);
     while Not eof(f) do
     begin
          read(f,c);
          Ap[c]:=Ap[c]+1;
     end;
     close(f);
     assign(f,fo);rewrite(f);
     c:='a';
     While c<'z' do
     begin
          if Ap[c]>0 then begin
                     write(f,c);
                     Ap[c]:=Ap[c]-1;
                     ch:=Succ(c);
                     While (Ap[ch]=0) do
                       ch:=Succ(ch);
                    if ch in ['a'..'z'] then write(f,ch);
                    Ap[ch]:=Ap[ch]-1;
          end
           else c:=Succ(c);
     end;
     close(f);
End.