Cod sursa(job #197300)

Utilizator theratmantheratman theratman Data 3 iulie 2008 12:20:49
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var f,g:text;
    x:char;
    i,l:longint;
    a:array[1..26]of longint;
begin
assign(f,'ordine.in');reset(f);
assign(g,'ordine.out');rewrite(g);
while not eof(f) do begin
 while not eoln(f) do begin
  read(f,x);
  inc(a[ord(x)-96])
 end;
 readln(f);
end;
for i:=1 to 25 do
 if a[i]>1 then begin
  l:=i+1;
  while a[l]=0 do inc(l);
  while a[i]>1 do begin
   write(g,chr(i+96));
   dec(a[i]);
   if a[l]>0 then begin
    write(g,chr(l+96));
    dec(a[l]);
   end;
   while a[l]=0 do
    inc(l);
  end;
  write(g,chr(i+96));
 end
  else
   if a[i]>0 then
    write(g,chr(i+96));
if a[26]=1 then write(g,'z');
close(f);
close(g);
end.