Cod sursa(job #162751)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 20 martie 2008 17:22:53
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
var a : array[1..30] of longint;
    lit : array[1..30] of char;
    i,min : longint;
    c : char;
    f,g : text;
procedure solve(i : longint);
var ii :longint;
    ok : boolean;
begin
ii:=i; ok:=false; dec(i);
  while (i>0)and(a[i]=0) do dec(i);
  if i>0 then
  begin
    write(g,lit[i]);
    dec(a[i]); ok:=true;
  end
    else
    begin
      i:=ii+1;
      while (i<=26)and(a[i]=0)
        do inc(i);
      if i<27 then
      begin
        write(g,lit[i]);
        dec(a[i]); ok:=true;
      end;
    end;
  if ok then solve(i);
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]);
  end;
  readln(f);
end;
for i:=1 to 26 do
    lit[i]:=chr(i+96);
for i:=1 to 26 do
    if a[i]<>0 then
    begin
      min:=i;
      break;
    end;
solve(i+1);
close(g);
end.