Cod sursa(job #559880)

Utilizator ForkeySandoiu Fernando Forkey Data 18 martie 2011 10:33:25
Problema Ordine Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
program sir;
var v:array[0..255] of integer;
    u:array[0..255] of char;
    s:string;
    c,a:char;
    n,x,i,p:integer;
    f,g:text;
    ok:boolean;
begin
    assign(f,'ordine.in');
    reset(f);
    assign(g,'ordine.out');
    rewrite(g);
    readln(f,s);
    n:=length(s);
    for i:=ord('a') to ord('z') do
        v[i]:=0;
    for i:=1 to n do
        begin
           x:=ord(s[i]);
           v[x]:=v[x]+1;
       end;
    p:=0;
    u[0]:=' ';
    for i:=1 to n do
        begin
           c:='a';
    while ((v[ord(c)]=0) or (c=u[p])) and (c<='z') do
        c:=succ(c);
    if c>'z' then
       while v[ord(c)]=0 do
        c:=succ(c);
    p:=p+1;
    u[p]:=c;
    v[ord(c)]:=v[ord(c)]-1;
    end;
    ok:=true;
    while ok=true do
       begin
          ok:=false;
          for i:=n downto 3 do
               if ord(u[i])=ord(u[i-1]) then
                  begin
                     a:=u[i-1];
                     u[i-1]:=u[i-2];
                     u[i-2]:=a;
                    ok:=true;
                   end;
         end;
    ok:=true;
    while ok=true do
       begin
          ok:=false;
          for i:=3 to n do
               if (ord(u[i-2])>ord(u[i-1])) and (u[i-1]<>u[i-3]) and (u[i-2]<>u[i]) then
                  begin
                     a:=u[i-1];
                     u[i-1]:=u[i-2];
                     u[i-2]:=a;
                    ok:=true;
                   end;
         end;
    for i:=1 to n do
        write(g,u[i]);
    writeln(g);
    close(f);close(g);
end.