Cod sursa(job #109614)

Utilizator ProtomanAndrei Purice Protoman Data 25 noiembrie 2007 12:06:41
Problema Ordine Scor 100
Compilator fpc Status done
Runda preONI 2008, Runda 1, Clasele 5-8 Marime 3.31 kb
var f1,f2:text;
    c,impl:char;
    a:array[1..1000000] of char;
    v,vi,ur,ui,pr,pri:array[1..100] of longint;
    i,j,g,n,r,h,min,min2,ug:longint;
    ok:boolean;

procedure cauta;
begin
        for i:=1 to 30 do
                if v[i]>0 then
                begin
                        min:=i;
                        min2:=ur[i];
                        break;
                end;
end;

procedure executa;
begin
        for i:=1 to n do
                if a[i]='0' then
                begin
                        if a[i-1]=chr(min+96) then
                        begin
                                a[i]:=chr(min2+96);
                                dec(v[min2]);
                        end
                        else
                        begin
                                a[i]:=chr(min+96);
                                dec(v[min]);
                        end;
                        if v[min2]=0 then
                        begin
                                pr[min2]:=ur[min2];
                                min2:=ur[min2];
                        end;
                        if v[min]=0 then
                        begin
                                pr[min2]:=ur[min2];
                                min:=min2;
                                min2:=ur[min2];
                        end;
                end;
end;

procedure caz1;
begin
        h:=n;
        while v[g]>0 do
        begin
                a[h]:=impl;
                dec(h,2);
                dec(v[g]);
        end;
        cauta;
        executa;
end;

procedure caz2;
begin
        h:=n-1;
        while v[g]>0 do
        begin
                a[h]:=impl;
                dec(h,2);
                dec(v[g]);
        end;
        cauta;
        executa;
end;

procedure verificare;
begin
        ok:=true;
        for i:=2 to n do
                if a[i]=a[i-1] then
                        ok:=false;
        for i:=1 to 30 do
                if v[i]<>0 then
                        ok:=false;
        if ok=false then
                for i:=1 to n do
                        a[i]:='0';
end;

begin
        assign(f1,'ordine.in');
        reset(f1);
        assign(f2,'ordine.out');
        rewrite(f2);
        while not eoln(f1) do
        begin
                read(f1,c);
                if c in ['a'..'z'] then
                begin
                        inc(n);
                        inc(v[ord(c)-96]);
                end;
        end;
        vi:=v;
        for i:=1 to 30 do
        begin
                r:=r-v[i];
                if (r<=0)and(v[i]>0) then
                begin
                        r:=-r;
                        impl:=chr(i+96);
                        g:=i;
                end;
        end;
        for i:=1 to 30 do
                if (v[i]>0)and(g<>i) then
                begin
                        pr[i]:=ug;
                        ur[ug]:=i;
                        ug:=i;
                end;
        ui:=ur;
        pri:=pr;
        for i:=1 to n do
                a[i]:='0';
        caz1;
        verificare;
        v:=vi;
        ur:=ui;
        pr:=pri;
        if ok=false then caz2;
        for i:=1 to n do
                write(f2,a[i]);
        close(f1);
        close(f2);
end.