Cod sursa(job #607914)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 13 august 2011 19:14:50
Problema Ordine Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
Program ordine;
 var a:array ['a'..'z'] of longint;
    i,j,n:longint;
    c,lim,precedent:char;
    t:boolean;
    fi,fo:text;
begin
assign(fi,'ordine.in');
 assign(fo,'ordine.out');
reset(fi);
 rewrite(fo);
while not seekeof(fi) do begin
                          inc(n);
                           read(fi,c);
                           inc(a[c]);
                          end;
lim:='a'; precedent:='#';
for i:=1 to n do
 for c:='a' to 'z' do
  if (a[c]=(n-i+1) div 2+1) and (a[c]>0) and (c<>precedent) then begin
                                               write(fo,c);
                                               dec(a[c]);
                                               precedent:=c;
                                               break;
                                               end
  else if (a[c]>0) and (c<>precedent) then begin
                                               write(fo,c);
                                               dec(a[c]);
                                               precedent:=c;
                                               break;
                                               end;

close(fo);
end.