Cod sursa(job #164691)

Utilizator marius21Marius Petcu marius21 Data 24 martie 2008 18:05:05
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
var a,t:array[0..1000000] of char;
c:array[1..1000000] of boolean;
j,lst,i,n:longint;
cls:char;
f,g:text;

procedure merge(si,sj:longint);
var nr,di,dj,i,j,m:longint;
begin
 if si<sj then begin
  m:=(si+sj)div 2;
  merge(si,m);
  merge(m+1,sj);
  i:=si;
  j:=m+1;
  nr:=0;
  while (i<=m) and (j<=sj) do
   if a[i]<=a[j] then begin
    inc(nr);
    t[nr]:=a[i];
    inc(i);
    end else begin
    inc(nr);
    t[nr]:=a[j];
    inc(j);
    end;
  while (i<=m) do begin
   inc(nr);
   t[nr]:=a[i];
   inc(i);
   end;
  while (j<=sj) do begin
   inc(nr);
   t[nr]:=a[j];
   inc(j);
   end;
  for i:=1 to nr do
   a[si+i-1]:=t[i];
  end;
 end;

begin
assign(f,'ordine.in');
assign(g,'ordine.out');
reset(f);
rewrite(g);
while not eoln(f) do begin
   inc(n);
   read(f,a[n]);
   end;
merge(1,n);
lst:=1;
cls:='*';
for i:=1 to n do begin
   while c[lst] do
      inc(lst);
   for j:=lst to n do
      if (not c[lst])and(a[j]<>cls) then
         break;
   c[j]:=true;
   cls:=a[j];
   write(g,cls);
   end;
writeln(g);
close(f);
close(g);
end.