Cod sursa(job #172011)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 5 aprilie 2008 16:55:39
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.85 kb
var f,g:text;
    v:array['a'..'z']of longint;
    x,i,j,k:char;
    ok,c,ko,n:longint;
begin
assign(f,'ordine.in');
assign(g,'ordine.out');
reset(f);
rewrite(g);
while not eof(f) do
  begin
    read(F,x);
    inc(n);
    inc(v[x]);
  end;
k:='9';
while true do
  begin
    ok:=0;
    ko:=0;
    for i:='a' to 'z' do
      if (i<>k)and(v[i]=(n-c)div 2+1)then
        begin
          ko:=1;
          break;
        end;
    if (ko=1)then
      begin
         write(G,i);
         dec(v[i]);
         ok:=1;
         inc(c);
      end else
    for i:='a' to 'z' do
      begin
        if (i<>k)and(v[i]>0)then
          begin
            write(g,i);
            inc(c);
            dec(v[i]);
            ok:=1;
            break;
          end;
      end;
   k:=i;
   if (ok=0)then break;
  end;
close(f);
close(g);
end.