Cod sursa(job #109729)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 25 noiembrie 2007 12:34:08
Problema Ordine Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 5-8 Marime 1.76 kb
var v:array[0..28]of longint;
    u:array[1..1000000]of char;
    n,i,j,k,m,l:longint;
    c:char;
    f:text;
begin
   assign(f,'ordine.in');
   reset(f);
   while not eof(f) do
   begin
   n:=n+1;
   read(f,c);
   v[ord(c)-96]:=v[ord(c)-96]+1;
   if v[ord(c)-96]>m then begin m:=v[ord(c)-96];
                                l:=1;
                          end
                     else
   if v[ord(c)-96]=m then l:=l+1;
   end;
   close(f);
   assign(f,'ordine.out');
   rewrite(f);
   for i:=1 to n do
   begin
   if((n-i)div(l)+(n-i)mod(l)>=m)and
         ((n-i)div(2)+(n-i)mod(2)>=m) then begin j:=1;
                                           while(v[j]=0)or(chr(96+j)=u[i-1])do
                                           j:=j+1;
                                           u[i]:=chr(96+j);
                                           if v[j]=m then l:=l-1;
                                           v[j]:=v[j]-1;
                                     end
                                else begin j:=1;
                                           while(v[j]<m)or(chr(96+j)=u[i-1])do
                                           j:=j+1;
                                           u[i]:=chr(96+j);
                                           if v[j]=m then l:=l-1;
                                           v[j]:=v[j]-1;
                                     end;
   if l=0 then begin m:=0;
                     for j:=1 to 26 do
                     if v[j]>m then begin m:=v[j];
                                          l:=1;
                                    end
                               else
                     if(v[j]=m)then l:=l+1;
               end;
   end;
   for i:=1 to n do
   write(f,u[i]);
   writeln(f);
   close(f);
end.