Cod sursa(job #115553)

Utilizator marius21Petcu Marius marius21 Data 16 decembrie 2007 12:57:33
Problema Dusman Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 2, Clasele 5-8 Marime 2.08 kb
var a:array[0..1001] of longint;
x:array[0..1001,0..1001] of boolean;
f,g:text;
min,p,aa,b,n,k,m,i,j:longint;
ok:boolean;

procedure change(var x,y:longint);
var aux:longint;
begin
aux:=x;
x:=y;
y:=aux;
end;

function inainte(j,i:longint):boolean;
begin
if (j=i-1) or (i=j-1) then
        inainte:=x[a[i],a[j]]
         else
         if j<i then inainte:=x[a[j],a[i-1]] else inainte:=x[a[j],a[i+1]]
end;

function inapoi(i,j:longint):boolean;
begin
if (j=i-1) or (i=j-1) then
        inapoi:=x[a[i],a[j]] else
inapoi:=x[a[i],a[j-1]];
end;

begin
assign(f,'dusman.in');
assign(g,'dusman.out');
reset(f);
rewrite(g);
read(f,n,k,m);
for i:=1 to n do
        a[i]:=i;
for i:=1 to m do begin
        read(f,aa,b);
        x[aa,b]:=true;
        x[b,aa]:=true;
        end;
for i:=n-1 downto 1 do begin
        if (x[a[i],a[i+1]]) then begin
                ok:=true;
                for j:=i-1 downto 1 do
                        if not(x[a[j],a[i+1]] or inainte(j,i)) then begin
                                change(a[i],a[j]);
                                ok:=false;
                                break;
                                end;
                if ok then
                for j:=i+2 to n do
                        if not(x[a[j],a[i]] or inainte(j,i+1) or x[a[i+1],a[j+1]] or inapoi(i+1,j)) then begin
                                change(a[i+1],a[j]);
                                break;
                                end;
                end;
        end;
for j:=1 to k do begin
ok:=false;
for i:=n-1 downto 1 do begin
        min:=maxlongint;
        p:=0;
        for k:=i+1 to n do
                if (a[i]<a[k]) and (min>a[k]) and not(x[a[k],a[i-1]] or inainte(k,i) or x[a[i],a[k+1]] or inapoi(i,k)) then begin
                        min:=a[k];
                        p:=k;
                        end;
        if p<>0 then  begin
                change(a[p],a[i]);
                ok:=true;
                break;
                end;
        end;

end;
for i:=1 to n do write(g,a[i]);
close(f);
close(g);
end.