Cod sursa(job #164721)

Utilizator marius21Marius Petcu marius21 Data 24 martie 2008 18:55:48
Problema Ordine Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var a:array['a'..'z'] of longint;
i,n:longint;
c,j,cls:char;
f,g:text;
ok:boolean;

begin
assign(f,'ordine.in');
assign(g,'ordine.out');
reset(f);
rewrite(g);
while not eoln(f) do begin
   inc(n);
   read(f,cls);
   inc(a[cls]);
   end;
cls:='*';
for i:=1 to n do begin
   ok:=false;
   c:='*';
   for j:='a' to 'z' do begin
      if a[j]>=(n-i+1) div 2 +1 then begin
         c:=j;
         break
         end;
      if not ok and (a[j]<>0) and (j<>cls)and (c='*') then begin
         ok:=true;
         c:=j;
         end;
      end;
   cls:=c;
   dec(a[c]);
   write(g,cls);
   end;
writeln(g);
close(f);
close(g);
end.