Cod sursa(job #145355)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 28 februarie 2008 19:11:12
Problema Dusman Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
const nmax=1000;
type stiva=array[1..nmax] of integer;
var f,g:text;
    a:array[1..nmax,1..nmax] of 0..1;
    x,y,l,m,n,i,o:longint;
    st:stiva;
Function valid(k:integer):boolean;
var
   i:longint;
   q:boolean;
begin
     q:=True;
     { elem. distincte }
     For i:=1 to k-1 do
         if st[k]=st[i] then begin
            q:=False;
            break;
            end;
     if q then
          if (a[st[k],st[k-1]]=1) and (k>1) then q:=false;
     valid:=q;
end;
procedure back(k:longint);
var i,j:longint;
begin
     if k=N+1 then begin
                   o:=o+1;
                   if o=L then begin
                      For j:=1 To N-1 do
                          write(f,st[j],' ');
                      write(f,st[N]);
                      end;
                   end
              else begin
                        { succesorul }
                        For i:=1 To N do
                            begin
                                 St[k]:=i;
                                 if valid(k) then back(k+1);
                            end;
                   end;

end;
begin
     assign(f,'dusman.in');reset(f);
     readln(f,n,l,m);
     for i:=1 to m do begin
         readln(f,x,y);
         a[x,y]:=1;
         a[y,x]:=1;
     end;
     close(f);
     assign(f,'dusman.out');rewrite(f);
     back(1);
     close(f);
End.