Алгоритмы на графах

//Поиск вершин, недостижимых из заданной вершины графа.
//Программа реализована на языке программирования Turbo-C++

\begin{verbatim}
#include <iostream.h>
#include <fstream.h>
//- - - - - - - - - - - - - - - - - - - - - -
int n,s;
int c[20][20];
int r[20];
//- - - - - - - - - - - - - - - - - - - - - -
int load();
int save();
int solve();
//- - - - - - - - - - - - - - - - - - - - - -
int main(){
  load();
  solve();
  save();
  return 0;
}
//- - - - - - - - - - - - - - - - - - - - - -
int load(){
  int i,j;
  ifstream in("input.txt");
  in"n"s;
  s--;
  for (i=0; i<n; i++)
    for (j=0; j<n; j++)
      in"c[i][j];
  in.close();
  return 0;
}

int save(){
  int i;
  ofstream out("output.txt");
  for (i=0; i<n; i++)
   if (r[i]==0)
    out"i+1"" ";
  out.close();
  return 0;
}
//- - - - - - - - - - - - - - - - - - - - - -
int solve(){
  int i,h,t;
  int q[400];
  for (i=0; i<n+1; i++) q[i]=0;
  r[s]=1;
  h=0;
  t=1;
  q[0]=s;
  while (h<t){
    for (i=0;i<n;i++)
      if ((c[q[h]][i]>0)&(r[i]==0)){
    q[t]=i;
    t++;
    r[i]=1;
      }
    h++;
  }
  return 0;
}

{>
Реализация на Turbo-Pascal.
Поиск циклов в графе
<}

{$R-,I-,S-,Q-}

const MAXN       = 40;
      QUERYSIZE  = 600;

type vert = record x: integer; s: array [1..MAXN] of integer; end;

var c   : array [1..MAXN,1..MAXN] of integer;
    n   : integer;

wr  : vert;

res : array [1..MAXN] of string;
    resv: integer;
    ss  : string;

procedure load;
var i,j: integer;
begin
  assign(input,'input.txt');
  reset(input);
   read(n);
   for i:=1 to n do
     for j:=1 to n do
       read(c[i][j]);
  close(input);
end;

function saveway(i:integer):string;
var e:string;
begin
  str(i,e);
  if (wr.s[i]=-1) then
    saveway:=e+' '
  else
    saveway:=saveway(wr.s[i])+e+' ';
end;

p>function findss(s: string): boolean;
var i         : integer;
    l1,l2,rs  : string;
    i1,i2,i22 : integer;

begin
  findss:=false;
  l2:=copy(s,1,pos(' ',s)-1);
  i2:=length(l2);
  i22:=length(s);
  for i:=1 to resv do begin
    l1:=copy(res[i],1,pos(' ',res[i])-1);
    i1:=length(l1);
    rs:=copy(res[i],1,length(res[i])-i1)+res[i];
    if (length(res[i])+i2=i22+i1)and(pos(s,rs)>0)
    then begin
      findss:=true;
      exit;
    end;
  end;
end;

procedure solve;
var h,t,i,j: integer;
    q      : array [1..QUERYSIZE] of vert;
    e      : string;
begin
   resv:=0;
   fillchar(res,sizeof(res),0);

for i:=1 to n do begin
     fillchar(q[i],sizeof(q[i]),0);
     q[i].x:=i;
     q[i].s[i]:=-1;
   end;

t:=n+1;
   h:=1;
   while h<t do begin
     for i:=1 to n do
       if (c[q[h].x,i]>0) then begin
          if (q[h].s[i]=-1) then begin
            wr:=q[h];
            str(i,e);
            ss:=saveway(q[h].x)+e;
            if (not findss(ss)) then begin
               inc(resv);
               res[resv]:=ss;
            end;
          end;
          if (q[h].s[i]=0) then begin
            q[t]:=q[h];
            q[t].x:=i;
            q[t].s[i]:=q[h].x;
            inc(t);
          end;
       end;
     inc(h);
   end;

close(output);
end;

procedure save;
var i: integer;
begin
  assign(output,'output.txt');
  rewrite(output);
  for i:=1 to resv do
    writeln(res[i]);
  close(output);
end;

begin
  load;
  solve;
  save;
end.