Cod sursa(job #120459)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 5 ianuarie 2008 15:23:35
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
var v:array[0..40]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 m:=v[ord(c)-96];
   end;
   close(f);
   for i:=1 to n do
   if(m>=(n-i+1)div 2+1)then begin j:=1;
                                   while(v[j]<>m)or(j+96=ord(u[i-1]))or(v[j]=0)do
                                   j:=j+1;
                                   u[i]:=chr(j+96);
                                   v[j]:=v[j]-1;
                                   m:=0;
                                   for j:=1 to 30 do
                                   if v[j]>m then m:=v[j];
                                        end
                                   else begin j:=1;
                                              while(j+96=ord(u[i-1]))or(v[j]=0)do
                                              j:=j+1;
                                              u[i]:=chr(j+96);
                                              v[j]:=v[j]-1;
                                              m:=0;
                                              for j:=1 to 30 do
                                              if v[j]>m then m:=v[j];
                                        end;
   assign(f,'ordine.out');
   rewrite(f);
   for i:=1 to n do
   write(f,u[i]);
   close(f);
end.