Cod sursa(job #120463)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 5 ianuarie 2008 15:30:50
Problema Ordine Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.3 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 eoln(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)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]);
   writeln(f);
   close(f);
end.