Cod sursa(job #124869)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 20 ianuarie 2008 09:35:19
Problema Strazi Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasele 11-12 Marime 1.31 kb
program strazi;
type matt = array [1..256,1..256] of integer;
     vect = array [1..256] of integer;
var A : matt;
    M,N,i,j,k,nr : integer;
    f : text;
    B : vect;


procedure scrie;
begin
assign(f,'strazi.out');
rewrite(f);
writeln(f,nr);
for i := 1 to N-1 do
if A[B[i],B[i+1]]=0 then writeln(f,B[i],B[i+1]);
for i := 1 to n do
write(f,B[i]);
close(f);
end;




function valid(p:integer):boolean;
var i,j:integer;
    ok : boolean;
begin
ok := true;
for i := 1 to p do
for j := 1 to p do
if (B[i]=B[j]) and (i<>j) then begin
                                ok := false;
                                break;
                                end;
valid := ok;
end;


procedure valid2(S:matt);
var nr2 : integer;
begin
nr2 := 0;
for i := 1 to N-1 do
if S[B[i],B[i+1]]=0 then nr2 := nr2+1;
if nr2 < nr then begin
                 scrie;
                 nr := nr2;
                 end;

end;



procedure back(p:integer);
var pval : integer;
begin

for pval := 1 to N do begin
B[p] := pval;
if p=n then if valid(p) then valid2(A)
else back(p+1);

end;
end;

begin
nr := 0;
assign(f,'strazi.in');
reset(f);
readln(f,N,M);
for i := 1 to N do
for j := 1 to N do
A[i,j] := 0;

for k := 1 to M do begin
readln(f,i,j);
A[i,j] := 1;
end;

close(f);

back(1);
end.