Cod sursa(job #607916)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 13 august 2011 19:27:23
Problema Ordine Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
program ordine;
 var a:array['a'..'z'] of longint;
     c,min,precedent:char;
     b1:array [1..1 shl 15] of char;
     i,n:longint;
     fi,fo:text;
begin
assign(fi,'ordine.in');
settextbuf(fi,b1);
reset(fi);
assign(fo,'ordine.out');
rewrite(fo);
while not seekeof(fi) do begin
                          read(fi,c);
                           a[c]:=a[c]+1;
                           inc(n);
                             end;
precedent:=chr(ord('z')+1);
for i:=1 to n do begin
                  min:=chr(ord('z')+1);
                   for c:='a' to 'z' do begin
                          if (a[c]=(n-i+1) div 2+1) and (a[c]<>0) then begin
                                                                       min:=c;
                                                                        break;
                                                                       end;
                          if (c<min) and (a[c]>0) and (precedent<>c) then  min:=c;
                                          end;
                   write(fo,min);
                   a[min]:=a[min]-1;
                   precedent:=min;
                  end;
close(fo);
end.