Cod sursa(job #109567)

Utilizator marius21Petcu Marius marius21 Data 25 noiembrie 2007 11:55:41
Problema Ordine Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 5-8 Marime 1.05 kb
var a:array['a'..'z'] of longint;
c,b:array[1..1000000] of char;
f,g:text;
c1,c2,aux:char;
n,i:longint;
begin
assign(f,'ordine.in');
assign(g,'ordine.out');
reset(f);
n:=0;
rewrite(g);
i:=0;
while not eoln(f) do begin
read(f,c1);
inc(a[c1]);
end;
c1:='a';
c2:='b';
while not((c2>'z') or (c1>'z')) do begin
	while (a[c2]=0) and (c2<='z') do
   	inc(c2);
   while ((a[c1]=0) or (c1=c2)) and (c1<='z') do
   	inc(c1);
   if (c2<='z') and (c1<='z') then begin
   	dec(a[c1]);
      dec(a[c2]);
      inc(n,2);
      b[n-1]:=c1;
      b[n]:=c2;
      end;
   end;
aux:=#0;
if c2<='z' then aux:=c2;
if c1<='z' then aux:=c1;
if aux<>#0 then begin
	c[n]:=aux;
	i:=n;
   dec(a[aux]);
   while a[aux]<>0 do begin
   	 dec(i);
       if not((b[i]=aux) or (b[i+1]=aux)) then begin
       	c[i]:=AUX;
         dec(a[aux]);
         end;
       end;
end;
for i:=1 to n do begin
	write(g,b[i]);
   if (c[i]=aux) and (aux<>#0) then write(g,c[i]);
   end;
if (n=0) and (a[aux]=1) then write(g,aux);
writeln(g);	
close(f);
close(g);
end.