Cod sursa(job #172096)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 5 aprilie 2008 19:01:06
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.8 kb
var f,g:text;
    v:array['a'..'z']of longint;
    x,i,k:char;
    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
    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]);
         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]);
            break;
          end;
      end;
   k:=i;
   if (c=n)then break;
  end;
close(f);
close(g);
end.