Cod sursa(job #162779)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 20 martie 2008 17:48:49
Problema Ordine Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
var a : array[0..30] of longint;
    lit : array[0..30] of char;
    i,n,j,x : longint;
    c : char;
    f,g : text;
procedure finish;
begin
  close(g);
  halt;
end;
procedure solve(i : longint);
var ii,k :longint;
    ok : boolean;
begin
if n>0 then
begin
ok:=false; inc(x);
  for ii:=1 to 26 do
    if (a[ii]=(n-x+1)div 2+1)and(lit[ii]<>lit[i]) then
      begin
        write(g,lit[ii]);
        dec(a[ii]);ok:=true;{dec(n); }
        solve(ii);
      end;
      if not ok then
        for k:=1 to 26 do
            if (a[k]<>0)and(lit[k]<>lit[i]) then
            begin
              write(g,lit[k]);
              dec(a[k]);{ dec(n);}
              solve(k);
              break;
            end;
end
else finish;
end;
begin
assign(f,'ordine.in');reset(f);
assign(g,'ordine.out');rewrite(g);
while not eof(f) do
begin
  while not eoln(f) do
  begin
    read(f,c);
    inc(a[ord(c)-96]);
    inc(j);
  end;
  readln(f);
end;
n:=j;
for i:=1 to 26 do
    lit[i]:=chr(i+96);
solve(0);
close(g);
end.