Cod sursa(job #110766)

Utilizator taloibogdanTaloi Bogdan Cristian taloibogdan Data 27 noiembrie 2007 19:25:49
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.83 kb
Program ordine;
type ar=array[0..200000] of char;
Var f:text;
    n,m,l,i,j:longint;
    h:array[0..200000] of longint;
    a:ar;
    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]);
  end;
  i:=1;
  repeat
   inc(i);
   if (a[l]=chr(i-1+ord('a'))) then
   if h[i-1]>0 then
     begin
      inc(l);
      a[l]:=chr(i-2+ord('a'));
      dec(h[i-1]);
     end;
   if (a[l]=chr(i-2+ord('a'))) then
   if h[i]>0 then
     begin
      inc(l);
      a[l]:=chr(i-1+ord('a'));
      dec(h[i]);
     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]);
          inc(l);
          a[l]:=chr(i-2+ord('a'));
          dec(h[i-1]);
         end
                                     else
         begin
          inc(l);
          a[l]:=chr(i-2+ord('a'));
          dec(h[i-1]);
          inc(l);
          a[l]:=chr(i-1+ord('a'));
          dec(h[i]);
         end;
        end;
  until(i=m);
  for j:=1 to m do
     begin
      i:=l+1;
      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 l do Write(f,a[i]);
  close(f);
End.