proistos.pas

来自「This ar the basic programs that i did in」· PAS 代码 · 共 72 行

Program Proistosescu;
{Cristian Proistosescu cls XI-C , Problema Nr. 12-cu intersectii}
type matrice=array[1..6,1..6] of byte;
type stiva=array[1..100] of integer;
var Ma:matrice;
    f:text;
    st:stiva;
    as,ev:boolean;
    n,x,y,k:integer;
procedure citire;
    var u,v:integer;
    begin
    assign(f,'p12.txt');
    reset(f);
    readln(f,n);
    read(f,u);readln(f,v);
    read(f,u);readln(f,v); {am eliminat primele 2 strazi}
    while (not eof(f)) do begin
        read(f,u); readln(f,v);
        Ma[u,v]:=1; Ma[v,u]:=1;
    end;
    Ma[u,v]:=0;
    Ma[v,u]:=0;  {am eliminat ultima strada}
    end;
procedure init(var st:stiva; k:integer);
     begin
         st[k]:=0;
     end;
procedure succesor(var st:stiva;k:integer; var as:boolean);
     begin;
     if st[k]<n then begin as:=true;inc(st[k]); end
                else as:=false;
     end;
procedure valid(st:stiva; k:integer; var ev:boolean);
     var i:integer;
     begin
        ev:=true;
        for i:=1 to k-1 do
            if st[i]=st[k] then ev:=false;
        if Ma[st[k-1],st[k]]=0 then ev:=false;
     end;
function  solutie:boolean;
    begin
    solutie:=((st[1]=x) and (st[k]=y));
    end;
procedure tipar;
    var i:integer;
    begin
    for i:=1 to k do
    write(st[i],' ');
    writeln;
    end;
begin
citire;
write('dati intersectia de pornire');
readln(x);
write('dati intersectia de final');
readln(y);
st[1]:=x;
k:=2; init(st,k);
while K>1 do begin
     repeat
          succesor(st,k,as);
          if as then valid(st,k,ev);
     until (not as) or (as and ev);
     if as then if solutie  then tipar
                            else begin inc(k); init(st,k); end
                else dec(k);
end;
readln;
end.