Cod sursa(job #468760)

Utilizator lianaliana tucar liana Data 4 iulie 2010 22:11:48
Problema Ordine Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.81 kb
program ordine;
var f, g:text;
    v:array['a'..'z'] of longint;
    c, min, ant:char;
    i, n:longint;
  begin
    assign(f,'ordine.in'); reset(f);
    assign(g,'ordine.out'); rewrite(g);
    while not seekeoln(f) do
      begin
        read(f,c);
        v[c]:=v[c]+1;
        n:=n+1;
      end;
    ant:=chr(ord('z')+1);
    for i:=1 to n do
      begin
        min:=chr(ord('z')+1);
        for c:='a' to 'z' do
          begin
            if (v[c]=(n-i+1) div 2+1) and (v[c]<>0) then
              begin
                min:=c;
                break;
              end;
            if (c<min) and (v[c]>0) and (ant<>c) then
              min:=c;
          end;
        write(g,min);
        v[min]:=v[min]-1;
        ant:=min;
      end;
    writeln(g);
    close(f);
    close(g);
  end.