Cod sursa(job #171997)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 5 aprilie 2008 16:33:33
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 kb
program ordine;
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]);
            ko:=0;
            for j:='a' to 'z' do
              begin
              if (j<>i)and(v[j]>=(n-c)div 2+1)then
                begin
                  ko:=1;
                  break;
                end;
              end;
            if (ko=1)then
              begin
                write(g,j);
                dec(v[j]);
                ok:=1;
                inc(c);
              end else
            for j:='a' to 'z' do
              if (j<>i)and(v[j]>0)then
                begin
                  write(g,j);
                  inc(c);
                  dec(v[j]);
                  break;
                end;
            k:=j;
            ok:=1;
            break;
          end;
      end;
    if (ok=0)then break;
  end;
close(f);
close(g);
end.