Описание
Задан ориентированный граф с N вершинами, пронумерованными целыми числами от 1 до N

Задание
Напишите программу, которая подсчитывает количество различных путей между всеми парами вершин графа


Входные данные
Входной файл содержит количество вершин графа N (1
N33) и список дуг графа, заданных номерами начальной и конечной вершин

Выходные данные
Вывести в выходной файл матрицу N
×N, элемент (i,j) которой равен числу различных путей, ведущих из вершины i в вершину j, или "-1", если существует бесконечно много таких путей


Например:

ONTHEWAY.IN
5
1 2
2 4
3 4
4 1
5 3
1 1

ONTHEWAY.OUT
-1 -1 0 -1 0
-1 -1 0 -1 0
-1 -1 0 -1 0
-1 -1 0 -1 0
-1 -1 1 -1 0





Идеи
Вычисление степеней матрицы смежности.

Комментарии
Пусть А=[aij] - матрица смежности графа, т.е. aij равно 1, если граф содержит дугу из вершины i в вершину j, и 0 в противном случае. Матрица А задает количество путей из одного ребра между всеми парами вершин графа

Аналогичным образом, элементы аijk матрицы Аk определяют количество путей из k ребер [Шень95, п.9.1; Кристофидес 78, п.1.8]. Следовательно, матрица В=A+A2+...+AN-1 для каждой пары вершин (i,j) определяет суммарное количество путей из i в j, состоящих не более чем из N-1 ребра

Для каждой пары вершин (i,j) заданного графа мы имеем одну из следующих двух возможностей:

Таким образом, ненулевые позиции матрицы (I+B)AN=AN+AN+1+...+A2N-1 соответствуют тем парам вершин, число путей между которыми бесконечно. В эти позиции результирующей матрицы необходимо занести значения "-1". В остальные позиции следует перенести числа из матрицы В

Следует отметить, что для выполнения описанных вычислений нужно использовать переменные типа
Double или Extended. Максимальное число, которое может появиться в результирующей матрице, равняется 231=MaxLongInt+1


Упражнения

  1. Докажите последнее утверждение и постройте соответствующий пример

  2. Придумайте, как вычислить В, используя лишь O(log N) операций над матрицами

     




Решение

{$A+,B-,D+,E+,F-,G-,I-,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}

{$M 65520,0,655360}
 
program ontheway;

c
onst
NMax=33;
type LongInt = Comp;
     setByte = set Of Byte;
     PKnot = ^TKnot;
     TKnot = record
               Next:PKnot;
               N:Byte;
             end;
     TGraph=Array[1..NMax] of PKnot;
var A,B:TGRaph;
    N:Integer;
    Res:Array[1..NMax,1..NMax] of longInt;
    Is:Array[1..NMax] of Boolean;
 
Procedure New(var q:PKnot);
Begin
  System.New(q);
  q^.Next:=Nil;
  q^.N:=0;
End;
 
Procedure Add(Var A:TGraph;i,j:Integer);
Var q:PKnot;
Begin
  new(q);
  q^.Next:=A[i];
  A[i]:=q;
  q^.N:=j;
End;
 
Procedure Init;
Var i,j:Integer;
Begin
  Assign(Input,'
ontheway.in');
  ReSet(Input);
 
  Read(N);
  For i:=1 to N do begin
    A[i]:=Nil;
    B[i]:=Nil;
  End;
  FillChar(Is,SizeOf(Is),false);
 
  while not seekEof do begin
    read(i,j);
    Add(A,i,j);
    Add(B,j,i);
    if (i=j) then Is[i]:=true;
  end;
 
  Close(Input);
End;
 
Var F:Array[1..NMax] of Integer;
    Was:Array[1..NMax] of Boolean;
    Order:Array[1..NMax] of Integer;
    Cnt,cntComp:Integer;
    Cond:Array[1..NMax,0..NMax] of Integer;
    numKnots:Array[1..NMax] of Integer;
 
Procedure firstDeep(k:Integer);
var q:Pknot;
Begin
  q:=A[k];
  Was[k]:=True;
  while q<>Nil do begin
    if not Was[q^.N] then
      firstDeep(q^.N);
 
    q:=q^.next;
  end;
 
  Inc(Cnt);
  Order[N-Cnt+1]:=k;
End;
 
Procedure secondDeep(k:Integer);
Var q:PKnot;
Begin
  q:=B[k];
  Was[k]:=True;
  inc(Cond[cntComp,0]); Cond[cntComp,Cond[cntComp,0]]:=k;
  F[k]:=cntComp;
  Inc(numKnots[cntComp]);
 
  while q<>Nil do begin
    if not Was[q^.N] then
      secondDeep(q^.N);
 
    q:=q^.Next;
  end;
End;
 
Procedure strongSearch;
Var i:Integer;
Begin
  FillChar(F,SizeOf(F),0);
  FillChar(Was,SizeOf(Was),False);
  Cnt:=0;
  for i:=1 to N do
    if not Was[i] then
      firstDeep(i);
 
  FillChar(Was,SizeOf(Was),false);
  FillChar(Cond,SizeOf(Cond), 0);
  FillChar(numKnots, SizeOf(numKnots),0);
  cntComp:=0;
  for i:=1 to N do
    if not Was[Order[i]] then begin
      inc(cntComp);
      secondDeep(Order[i]);
    end;
End;
 
Var newGraph:Array[1..NMax,1..NMax] of Boolean;
 
Procedure GenNewGraph;
Var i,j:Integer;
    q:PKnot;
Begin
  fillChar(newGraph, SizeOf(newGraph), false);
  for i:=1 to cntComp do
    newGraph[i,i]:=True;
 
  for i:=1 to cntComp do
    for j:=1 to Cond[i,0] do begin
      q:=A[Cond[i,j]];
      while q<>Nil do begin
        newGraph[i,F[q^.N]]:=true;
        q:=q^.Next;
      end;
    end;
End;
 
Var resNew:Array[1..NMax,1..NMax] of longInt;
 
Procedure calculateWays;
Var i,j,k:Integer;
Begin
  for i:=1 to cntComp do
    for j:=1 to cntComp do
      if newGraph[i,j] then
        if ( (numKnots[i]>1) or Is[Cond[i,1]] ) or
           ( (numKnots[j]>1) or Is[Cond[j,1]] ) then
          resNew[i,j]:=-1
        else
          if (i<>j) then resNew[i,j]:=1
          else resNew[i,j]:=0
      else resNew[i,j]:=0;
 
  for k:=1 to cntComp do
    for i:=1 to cntComp do
      for j:=1 to cntComp do
        if (resNew[i,j]=-1) or (resNew[i,k]=-1) and (resNew[k,j]<>0) or
           (resNew[k,j]=-1) and (resNew[i,k]<>0) then
          resNew[i,j]:=-1
        else
          resNew[i,j]:=resNew[i,j]+resNew[i,k]*resNew[k,j];
End;
 
Procedure calculateResults;
Var i,j,k,m:Integer;
Begin
  FillChar(Res, sizeOf(Res), 0);
 
  for i:=1 to cntComp do
    for j:=1 to cntComp do
      for k:=1 to Cond[i,0] do
        for m:=1 to Cond[j,0] do
          Res[Cond[i,k], Cond[j,m]]:=resNew[i,j];
End;
 
Procedure printResults;
Var i,j:Integer;
Begin
  Assign(Output,'
ontheway.out');
  ReWrite(Output);
 
  for i:=1 to N do begin
    for j:=1 to N do
      Write(Res[i,j]:0:0,' ');
    WriteLn;
  end;
 
  Close(Output);
End;
 
Begin
  Init;
  strongSearch;
  genNewGraph;
  calculateWays;
  calculateResults;
  printResults;
End.

 


© Особенности национальных задач по информатике