INFOMAN брой 18

{  Даден  е граф. Да се определи дали м/у два върха съществува път с дължина
 (във брой ребра) k и да се покажат всички пътища

 РЕШЕНИЕ: Нека представим графа с матрица на инцидентност A.

 Тогава A^k[i,j] ще определи броя на пътищата с дължина k между i и j.
 A^k[i,i] ще определя броя на циклите с дължина k в който участва i.

 Забележнка:
   A^2 = A*A
   A^3 = A*A^2
     ......
   A^n = A*A^(n-1)

 Две матрици умножаваме по следния начин. Нека A(p,q) и B(q,r).

 Броя на колоните на първата трябва да е равен на броя на редовете на втората.
 Така нека C(q,r) = A*B.

                 q
 Тогава C[i,j] = ä  (A[i,k] * B[k,j])
                k=1

}

const Max = 50;

type
  TGraphMatrix = array[1..Max,1..Max] of integer;

Var
  G: TGraphMatrix;
  N: integer;

procedure ReadGraph(const S:string);
Var
 i,j: integer;
 F: Text;
begin
  FillChar(G, SizeOf(G),0);

  assign(F,S); reset(F);

  readln(F,N);

  while not seekeof(F) do
    begin
      read(F,i);

      while not seekEoln(F) do
       begin
         read(f,j);
         G[i,j]:=1;
       end;

     readln(F);
    end;

  close(F);
end;

procedure WriteGraphM(Var G:TGraphMatrix);
Var
 i,j: integer;
begin
  WriteLn;
  for i:=1 to N do
    begin
      WriteLn;
        for j:=1 to N do
          write(byte(G[i,j]):2);
    end;
  WriteLn;
end;

procedure MulMat(A,B: TGraphMatrix; Var Result:TGraphMatrix);
Var
  i,j,k: integer;
begin
  for i:=1 to N do
    for j:=1 to N do
      begin
        Result[i,j]:=0;

        for k:=1 to N do
          inc(Result[i,j],A[i,k]*B[k,j]);
      end;
end;


procedure Solve;
Var
  R, Path: TGraphMatrix;
  Stack: array[0..Max] of integer;
  k: integer;

procedure WriteWays(u,v: integer; myk:word);
Var
  i: integer;
begin
  Stack[ myk ]:=v;

  if myk = 1 then
    begin
      write(u,' ');
      for i:=1 to k do
        write(Stack[i],' ');
      writeln;
      exit;
    end;

  for i:=1 to N do
    if (Path[myk-1,i] > 0) and (G[i,v]=1) then
      WriteWays(u,i,myk-1);
end;

Var
  l,i,j,u,v: integer;
begin
  Write('брой ребра k='); readln(k);

  if k > n then k:=n;

  R:=G;

  for l:=1 to K-1 do
    MulMat(G,R,R);

  for i:=1 to N do
    for j:=1 to N do
      if R[i,j] > 0 then
        begin
          if i=j then
            writeln(i,' участва в ',R[i,j],' цикъл с дължина ',k,' ребра')
          else
            writeln('съществуват ',R[i,j],' пътя м/у ',i,' и ',j,' с дължина ',k,' ребра');
        end;

  WriteLn;
  WriteLn('Задайте u и v за да видите пътя м/у тях');
  WriteLn;
  Write('u='); readln(u);
  Write('v='); readln(v);

  if R[u,v] = 0 then
    begin
      WriteLn('Няма път м/у ',u,' и ',v);
      exit;
    end
  else
    writeln('има ',R[u,v],' пътя м/у ',u,' и ',v,' с дължина ',k,' ребра');

  R:=G;

  for i:=1 to N do
    Path[1,i]:= R[u,i];

  for l:=1 to k-1 do
    begin
      MulMat(G,R,R);

      for i:=1 to N do
        Path[l+1,i]:=R[u,i];
    end;

  WriteWays(u,v,k);
end;

begin
  ReadGraph('_MATWAY5.INP');
  WriteGraphM(G);

  Solve;
end.