Cod sursa(job #290367)

Utilizator andrici_cezarAndrici Cezar andrici_cezar Data 27 martie 2009 20:21:21
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.99 kb
var f,g:text;
    c,i,j:char;
    a:array['a'..'z']of longint;
begin
assign(f,'ordine.in');reset(f);
assign(g,'ordine.out');rewrite(g);
while not eof(f)do
      begin
      read(f,c);
      a[c]:=a[c]+1;
      end;
for i:='a'to'z'do
    begin
    if a[i]=1 then begin
                   write(g,i);
                   a[i]:=0;
                   end
    else if a[i]>1 then begin
                        while a[i]>0 do
                              begin
                              write(g,i);
                              a[i]:=a[i]-1;
                              for j:='a' to'z'do
                                  if (a[j]>0)and(i<>j) then begin
                                                 write(g,j);
                                                 a[j]:=a[j]-1;
                                                 break;
                                                 end;
                              end;
                        end;
    end;
close(g);
end.