Cod sursa(job #111426)

Utilizator taloibogdanTaloi Bogdan Cristian taloibogdan Data 29 noiembrie 2007 20:15:15
Problema Ordine Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.57 kb
Program ordine;
type ar=array[0..1100000] of char;
Var f:text;
    n,m,l,i,j,x,min,cs:longint;
    h:array[0..30] of longint;
    a:ar;
    b:array[1..1100000] of longint;
    aa:char;
procedure inserare(var s:ar; var j:longint; ff:char; p:longint);
var i:longint;
 begin
  j:=j+1;
  for i:=j+1 downto p+1 do
     begin
      s[i]:=s[i-1];
     end;
  s[p]:=ff;
 end;
Begin
  assign(f,'ordine.in');
  reset(f);
  n:=0;
  m:=0;
  while not(Eoln(f)) do
  begin
   inc(n);
   read(f,aa);
   inc(h[ord(aa)-ord('a')+1]);
if ord(aa)-ord('a')+1>m then m:=ord(aa)-ord('a')+1;
  end;
  close(f);
  assign(f,'ordine.out');
  rewrite(f);
 { l:=0;
  if h[1]>0 then
  begin
  inc(l);
  a[l]:='a';
  dec(h[1]);
  b[1]:=l
  end;}
  for x:=1 to m do
   begin
    min:=30;
    cs:=0;
    for i:=1 to m do begin if (i<min)and(h[i]>0)and(chr(i-1+ord('a'))<>a[x-1]) then min:=i; if (((n-x+1) div 2)+1=h[i])and(chr(i-1+ord('a'))<>a[x-1]) then cs:=i; end;
    if cs>0 then begin a[x]:=chr(cs-1+ord('a')); dec(h[cs]); end
            else begin a[x]:=chr(min-1+ord('a')); dec(h[min]);end;
   end;
{   if (a[l]<>chr(i-2+ord('a'))) then
   if h[i-1]>0 then
     begin
      inc(l);
      a[l]:=chr(i-2+ord('a'));
      dec(h[i-1]);
      b[i-1]:=l;
     end;
   if (a[l]<>chr(i-1+ord('a'))) then
   if h[i]>0 then
     begin
      inc(l);
      a[l]:=chr(i-1+ord('a'));
      dec(h[i]);
      b[i]:=l;
     end;
   while(h[i-1]>0) and (h[i]>0) do
        begin
         if a[l]=chr(i-2+ord('a')) then
         begin
          inc(l);
          a[l]:=chr(i-1+ord('a'));
          dec(h[i]);
          b[i]:=l;
          inc(l);
          a[l]:=chr(i-2+ord('a'));
          dec(h[i-1]);
          b[i-1]:=l;
         end
                                     else
         begin
          inc(l);
          a[l]:=chr(i-2+ord('a'));
          dec(h[i-1]);
          b[i-1]:=l;
          inc(l);
          a[l]:=chr(i-1+ord('a'));
          dec(h[i]);
          b[i]:=l;
         end;
        end;      }
{  for j:=m downto 1 do
    if h[j]>0 then
     begin
      i:=b[j]+1;
      while(h[j]>0)and(i<=l) do
       begin
        inc(i);
        if (a[i]<>chr(j-1+ord('a'))) and (a[i-1]<>chr(j-1+ord('a'))) then begin inserare(a,l,chr(j-1+ord('a')),i); dec(h[j]); end;
       end;
      i:=l+2;
      while(h[j]>0) do
       begin
        dec(i);
        if (a[i]<>chr(j-1+ord('a'))) and (a[i-1]<>chr(j-1+ord('a'))) then begin inserare(a,l,chr(j-1+ord('a')),i); dec(h[j]); end;
       end;
     end;}
  for i:=1 to n do Write(f,a[i]);
  close(f);
End.