Cod sursa(job #111577)

Utilizator silvia_the_bestSilvia Pripoae silvia_the_best Data 30 noiembrie 2007 19:23:15
Problema Ordine Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb
var     sir:array[1..1000000] of char;
        i,j,n:longint;
        aux,c:char;
        ok:boolean;
        f,g:text;
begin
        assign(f,'ordine.in');
        assign(g,'ordine.out');
        reset(f);
        rewrite(g);

        i:=1;
        while not(eoln(f)) do begin
                read(f,sir[i]);
                i:=i+1;
        end;
        n:=i-1;

        ok:=false;
        while ok=false do begin
                ok:=true;
                for i:=1 to n-1 do if sir[i]>sir[i+1] then begin
                        ok:=false;
                        aux:=sir[i];
                        sir[i]:=sir[i+1];
                        sir[i+1]:=aux;
                end;
        end;

        aux:='0';
        ok:=false;
        while ok=false do begin
        for i:=1 to n do begin
                if sir[i]=aux then begin
                        for j:=i to n do if (sir[j]<>sir[i]) then begin
                                c:=sir[j];
                                sir[j]:=sir[i];
                                sir[i]:=c;
                                break;
                        end;
                        if sir[i]=aux then
                                for j:=i-1 downto 1 do if (sir[j]<>aux) then begin
                                        c:=sir[j];
                                        sir[j]:=sir[i];
                                        sir[i]:=c;
                                        break;
                                end;
                        ok:=true;
                        for j:=1 to n do if sir[j]=sir[j+1] then ok:=false;
                end;
                aux:=sir[i];
        end;
        end;
        for i:=1 to n do write(g,sir[i]);
        close(f);
        close(g);
end.