Developing.ru

Код: Выделить всё

procedure Dijkstra(var M:TMapOfLong; v,x,y:longint; var work:TMasOfBool; var way:TMasWay);
var
i,j,minv,u:longint;
t:array[1..maxV] of boolean;
b:array[1..maxV,1..2] of longint;
d:array[1..maxV] of longint;
begin
fillchar(t,sizeof(t),true);
fillchar(way,sizeof(way),0);
fillchar(w,sizeof(w),0);
for i:=1 to V do d[i]:=maxlongint;
d[x]:=0;
minv:=x;
for i:=1 to V-1 do
begin
u:=minv;
t[u]:=false;
min:=maxlongint;
for j:=1 to V do if t[j] then
begin
if (M[u,j]>0) and (work[M[u,j]]) and (d[j]>d[u]+1) then
begin
d[j]:=d[u]+1;
b[j,1]:=u;
b[j,2]:=M[u,j];
end;
if d[j]<min then
begin
min:=d[j];
minv:=j;
end;
end;
if (min=maxlongint) then break;
end;
if t[y] then exit;
i:=y;
while (i<>x) do
begin
inc(way[0]);
way[way[0]]:=b[i,2];
i:=b[i,1];
end;
for i:=1 to way[0] div 2 do
begin
j:=way[i];
way[i]:=way[way[0]-i+1];
way[way[0]-i+1]:=j;
end;
end.

Код: Выделить всё

unit DijkstraUnit;

interface

type
  TPointLabel = record
    name: string;
    path: Real;
    finded: Boolean;
  end;

  TPointLabels = array of TPointLabel;

procedure InitPoints(n: Integer; var Points: TPointLabels);
procedure Dijkstra(p, n: Integer);

var
  Points: TPointLabels;
  SourceMatrix, ResMatrix: array of array of Real;

implementation

procedure InitPoints(n: Integer; var Points: TPointLabels);
var
  i: Integer;
begin
  for i := 0 to n - 1 do
  begin
    Points[i].name := '';
    Points[i].finded := False;
    Points[i].path := 9.9E307;
  end;
end;

procedure Dijkstra(p, n: Integer);
var
  k, i: Integer;
  MinInd: Integer;
  MinValue: Real;
  TmpMinInd: Integer;
  TmpMinValue: Real;
begin
  MinInd := p - 1;
  MinValue := 0;
  Points[MinInd].finded := True;
  Points[MinInd].path := 0;
  for k := 0 to n - 1 do
  begin
    TmpMinInd := MinInd;
    TmpMinValue := 9.9E307;
    for i := 0 to n - 1 do
    begin
      if SourceMatrix[MinInd, i] > 0 then //если последняя точка с постоянной меткой соединена с текущей (i) точкой
        if SourceMatrix[MinInd, i] + MinValue < Points[i].path then //если найденный путь меньше
          Points[i].path := SourceMatrix[MinInd, i] + MinValue;
      end;
      if not Points[i].finded then
        if Points[i].path <= TmpMinValue then
        begin
          TmpMinValue := Points[i].path;
          TmpMinInd := i;
        end;
    end;
    if TmpMinInd <> MinInd then
    begin
      MinValue := TmpMinValue;
      MinInd := TmpMinInd;
      Points[MinInd].finded := True;
    end
    else
      Break;
  end;
  //for i := 0 to n - 1 do
    //WriteLn('p', i + 1, ': ', Points[i].path: 4: 1);
end;

end.

Код: Выделить всё

//обнуляем счетчики и считаем все узлы рабочими
Nd:=0;
fillchar(u,sizeof(u),0);
fillchar(work,sizeof(work),true);
for ctnum:=0 to n-1 do
for v1:=1 to V do
for v2:=1 to V do
begin
//если имеется запрос на трафик типа ctnum из узла v1 в узел v2 
if D[ctnum][v1,v2]>0 then
begin
//находим кратчайший путь
Dijkstra(M,V,v1,v2,work,way);
inc(Nd);
//отмечаем ребра входящие в основной путь
fillchar(pp,sizeof(pp),false);
for i:=1 to way[0] do
begin
pp[way[i]]:=true;
end;
//считаем первой ребро пути вышедшим из строя
work[way[1]]:=false;
//ищем новый путь
Dijkstra(M,V,v1,v2,work,way1);
//отмечаем ребра входящие в обходной путь
for j:=1 to way1[0] do
begin
if not pp[way1[j]] then inc(u[way1[j]]);
end;
//снова делаем первое ребро пути рабочим
work[way[1]]:=true;
end;
end;
//подсчитываем коэффиценты
for i:=1 to e do koef[i]:=1+u[i]/Nd;