Cod sursa(job #305851)

Utilizator frozen62iceBLue FirE frozen62ice Data 18 aprilie 2009 18:04:36
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
var c,cc,lc,nc:char;
    f,g:text;
    i,nr:longint;
    a:array['a'..'z'] of longint;
begin
assign(f,'ordine.in');reset(f);
assign(g,'ordine.out');rewrite(g);
for c:='a' to 'z' do a[c]:=0;
while not eof(f) do begin
 while not eoln(f) do begin
  read(f,c);
  inc(a[c]);
 end;
 readln(f);
end;
cc:='a';
while (ord(cc)<=ord('z'))and(a[cc]=0) do cc:=chr(ord(cc)+1);
nc:=chr(ord(cc)+1);
while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
if a[cc]<a[nc] then nr:=a[cc]
 else nr:=a[nc];
for i:=1 to nr do begin
 write(g,cc);
 write(g,nc);
end;
dec(a[cc],nr);
dec(a[nc],nr);
lc:=nc;
if a[cc]=0 then begin
 cc:=nc;
 nc:=chr(ord(cc)+1);
 while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
end
 else
  if a[nc]=0 then
   while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
while (ord(nc)<=ord('z'))and(ord(cc)<=ord('z')) do begin
 if cc<>lc then begin
  if a[cc]<a[nc] then nr:=a[cc]
   else nr:=a[nc];
  for i:=1 to nr do begin
   write(g,cc);
   write(g,nc);
  end;
  dec(a[cc],nr);
  dec(a[nc],nr);
  lc:=nc;
  if a[cc]=0 then begin
   cc:=nc;
   nc:=chr(ord(cc)+1);
   while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
  end
   else
    if a[nc]=0 then
     while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
 end
  else
 begin
  if a[cc]<a[nc] then nr:=a[cc]
   else nr:=a[nc];
  for i:=1 to nr do begin
   write(g,nc);
   write(g,cc);
  end;
  dec(a[cc],nr);
  dec(a[nc],nr);
  lc:=cc;
  if a[cc]=0 then begin
   cc:=nc;
   nc:=chr(ord(cc)+1);
   while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
  end
   else
    if a[nc]=0 then
     while (ord(nc)<=ord('z'))and(a[nc]=0) do nc:=chr(ord(nc)+1);
 end;
end;
for c:='a' to 'z' do
 if a[c]<>0 then
  write(g,c);
writeln(g);
close(f);
close(g);
end.