Cod sursa(job #165086)

Utilizator andumMorie Daniel Alexandru andum Data 25 martie 2008 13:21:15
Problema Dusman Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var n,k,kk,m,x,y,i:longint;
    a:array[1..1001,1..1001] of integer;
    st,f:array[1..1001] of integer;
    h,g:text;

procedure back(k:integer);
var i,x:integer;
    ev:boolean;
begin
     if k=n+1 then begin
                   {tiparire solutie}
                    y:=y+1;
                    if y=kk then begin
                                  assign(g,'dusman.out');
                                  rewrite(g);
                                  for i:=1 to n do write(g,st[i],' ');
                                  close(g);
                                  halt;
                                 end;
                   end
              else begin
                   { punem elem. in stiva }
                    for x:=1 to n do
                        begin
                             st[k]:=x;
                             { validare }
                             ev:=True;
                             if f[st[k]]=1 then ev:=false
                                           else if (k>1) and (a[st[k],st[k-1]]=1) then ev:=false;
                             if ev then begin
                                   F[st[k]]:=1;
                                   back(k+1);
                                   F[st[k]]:=0;
                                end;
                        end;
                   end;
end;

begin
     assign(h,'dusman.in');
     reset(h);
     readln(h,n,kk,m);
     for i:=1 to m do begin
                       readln(h,x,y);
                       a[x,y]:=1;
                       a[y,x]:=1;
                      end;
     close(h);
     y:=0;
     back(1);
end.