Cod sursa(job #120213)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 4 ianuarie 2008 17:03:57
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
program alex;
var f:text;
    p1,p2,j,d,min,max:longint;
    i,a,h,y:char;
    c:array['a'..'z']of longint;
    b:array[1..1000]of char;
begin
assign(f,'ordine.in');reset(f);
d:=0;
while not eof(f) do
      begin
      read(f,a);
      c[a]:=c[a]+1;
      d:=d+1;
      end;
close(f);
p1:=1;
p2:=2;
i:=chr(ord('a')-1);
repeat
i:=chr(ord(i)+1);
repeat
if p1<p2 then min:=p1
         else min:=p2;
max:=0;
for y:=chr(ord(i)+1)to 'z' do
        if c[y]>max then begin
                         max:=c[y];
                         h:=y;
                         end;
    if c[i]<>0 then if(max<=(d-min+1)div 2) then begin
                                      b[min]:=i;
                                      min:=min+2;
                                      c[i]:=c[i]-1;
                     if p1<p2 then p1:=min
                              else p2:=min;
                                            end
                                        else begin
                                             b[min]:=h;
                                             c[h]:=c[h]-1;
                                              if p1<p2 then p1:=min+2
                                                       else p2:=min+2;
                                             end
                                             else
until c[i]=0;
until i='z';
assign(f,'ordine.out');rewrite(f);
for j:=1 to d do
    write(f,b[j]);
close(f);
end.