Cod sursa(job #162792)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 20 martie 2008 18:07:39
Problema Ordine Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var a : array[0..30] of longint;
    lit : array[0..30] of char;
    i,n,j,x,ii,k : longint;
    c : char;
    f,g : text;
    ok,ok2 : boolean;
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);   }
i:=0;
repeat
if n>0 then
begin
ok:=false; inc(x); ok2:=false;
  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]);ok2:=true;
        dec(a[ii]);ok:=true;{dec(n); }
        {solve(ii);}i:=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]); ok2:=true;
              dec(a[k]);{ dec(n);}
              {solve(k);}i:=k;
              break;
            end;
end;
until not ok2;

close(g);
end.