Cod sursa(job #109343)

Utilizator matemariaescuMaria Mateescu matemariaescu Data 25 noiembrie 2007 10:20:02
Problema Ordine Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 5-8 Marime 1.44 kb
program ordine;
var car : array ['a'..'z'] of longint;
    a,b,c,x : char;
    n,m:longint;
    fin,fout : text;

function findnext:char;
var i, asta : char;
begin
  for i := x to 'z' do
    begin
      if car[i]<>0 then
        begin
          asta:=i;
          break;
        end;
    end;
  findnext:=asta;
end;

begin
  assign (fin,'ordine.in'); reset(fin);
  assign (fout,'ordine.out'); rewrite(fout);
  while not eoln(fin) do
    begin
      read(fin,x);
      car[x]:= car[x]+1;
      n:=n+1;
    end;
  x:='a';
  a:=findnext;
  if a <> 'z'then
    x:=chr(ord(a)+1);
  b:=findnext;
  write(fout,a);   car[a]:=car[a]-1;   m := m+1;
  if a <> 'z' then
    begin
      write(fout,b); car[b]:=car[b]-1; m:= m+1;
      while m<n do
        begin
          if car[a]<>0 then
            begin
              write(fout,a); car[a]:=car[a]-1; m := m+1;
            end
            else
              begin
                if b <'z'then
                  x:=chr(ord(b)+1);
                a:=b; b:=findnext;
              end;
          if car[b]<>0 then
            begin
              write(fout,b); car[b]:=car[b]-1; m:= m+1;
            end
            else
              begin
                if b <'z'then
                  x:=chr(ord(b)+1);
                b:=findnext;
                write(fout,b); car[b]:=car[b]-1; m:= m+1;
              end;
        end;
    end;
  close(fout);
  close(fin);
end.