(*^

::[paletteColors = 128;
fontset = title, "Times", 24, L2, center, bold, nohscroll;
fontset = subtitle, "Times", 18, L2, center, bold, nohscroll;
fontset = subsubtitle, "Times", 14, L2, center, bold, nohscroll;
fontset = section, "Times", 14, L2, bold, nohscroll, grayBox;
fontset = subsection, "Times", 12, L2, bold, nohscroll, blackBox;
fontset = subsubsection, "Times", 12, L2, nohscroll, whiteBox;
fontset = text, "Times", 12, L2, nohscroll;
fontset = smalltext, "Times", 10, L2, nohscroll;
fontset = input, "Courier", 10, L2, nohscroll;
fontset = output, "Courier", 10, L2, condense, nowordwrap;
fontset = message, "Courier", 10, L2, R65535, nowordwrap;
fontset = print, "Chicago", 12, L2, nowordwrap;
fontset = info, "Courier", 10, L2, nohscroll;
fontset = postscript, "Courier", 12, L2, nowordwrap;
fontset = name, "Geneva", 10, L2, italic, B65535, nowordwrap, nohscroll;
fontset = header, "Times", 10, L2;
fontset = footer, "Times", 12, L2, center;
fontset = help, "Geneva", 10, L2, nohscroll;
fontset = clipboard, "New York", 12, L2;
fontset = completions, "New York", 12, L2, nowordwrap;
fontset = network, "Courier", 10, L2, nowordwrap;
fontset = graphlabel, "Courier", 10, L2, nowordwrap;
fontset = special1, "Times", 12, L2, nowordwrap;
fontset = special2, "Times", 12, L2, center, nowordwrap;
fontset = special3, "Times", 12, L2, right, nowordwrap;
fontset = special4, "New York", 12, L2, nowordwrap;
fontset = special5, "New York", 12, L2, nowordwrap;]
:[font = title; inactive; hscroll; ]
floyd
ALLAN HAYES
Department of Mathematics,The University, Leicester LE1 7RH , UK
Tel. 0533-523883 (Office), 0533-714198 (Home)
fax: 0533 522200, email: hay@le.ac.uk

;[s]
3:0,0;7,1;175,0;176,-1;
2:2,26,18,Times,1,24,0,0,0;1,14,9,Times,0,12,0,0,0;
:[font = text; inactive; ]
Floyd's method for finding least-weight routes in a directed weighted graph.
:[font = section; inactive; startGroup; Cclosed; hscroll; ]
Implementation: Help & Algorithms.
:[font = input; locked; initialization; hscroll; ]
*)
BeginPackage["floyd`"];
(*
;[s]
3:0,0;14,1;19,0;24,-1;
2:2,13,9,Courier,0,10,0,0,0;1,13,9,Courier,1,10,0,0,0;
:[font = input; initialization; hscroll; ]
*)
floydInfo::usage = "Floyd's method for finding leastÐweight routes in a directed weighted graph, given as a square matrix H of numbers(real, integer or infinite) with zeros down the diagonal.\n
Outputs are available in different formats: \n
floydSignposts\n
floydRoutes\n
floydRoutesColumn\n
floydRoutesTable\n
floydRoutesGrid\n
Suitable inputs are constucted by\n
floydGraph\n
Information is separately available on each of these procedures.\n
The basic output format is floydSignposts, which should be consulted first.\n However, one of the other output formats may be more suitable."

floydSignposts::usage = "floydSignposts[H] is:\n
*either a table, T, giving a solution in 'signpost' form:\n
T[[i,j]] = (w, k) indicates that the constructed lightest route from i to j has weight w and the first step from i is to go to k;\n
*or a message like ''{2,7,4,2} is a negative loop'' indicating that the problem is unbounded - repeating this loop would produce arbitrarily light paths.";

floydRoutes::usage = "floydRoutes[H] is a list of the routes or a negative- loop message (see floydSignposts & floydInfo).";
floydRoutesColumn::usage = "floydRoutesColumn[H] is a column of the routes or a negative-loop message (see floydSignposts & floydInfo).";
floydRoutesTable::usage = "floydRoutesTable[H] is a table of the routes or a negative-loop message(see floydSignposts & floydInfo).";
floydRoutesGrid::usage = "floydRoutesGrid[H] is a table of the routes displayed in a lined grid, or a negative-loop message(see floydSignposts & floydInfo).";
floydGraph::usage = "floydGraph[finrat,min,max,d]\n
(finrat: positive integer or Infinity; min ² max , integers; d, positive integer )\n
is a dxd matrix with all diagonal entries zero, and other entries equal to Infinity or an integer chosen at random between min and max.\n
The proportion of infinite entries is 0 if finrat = Infinity, and approximately 1/finrat otherwise(see floydInfo).";
(*
;[s]
32:0,1;9,0;245,1;259,0;261,1;262,0;265,1;276,0;282,1;299,0;305,1;321,0;327,1;342,0;386,1;396,0;609,1;624,0;660,2;666,0;856,2;858,0;1015,1;1027,0;1140,1;1158,0;1278,1;1295,0;1412,1;1427,0;1571,1;1581,0;1965,-1;
3:16,13,9,Courier,0,10,0,0,0;14,13,9,Courier,1,10,0,0,0;2,13,9,Courier,2,10,0,0,0;
:[font = input; locked; initialization; hscroll; ]
*)
Begin["`private`"];
(*
:[font = input; initialization; endGroup; hscroll; ]
*)
floydSignposts[H_]:= floydSignposts[H] =
Block[{T,d=Length[H],i,j,k,S = 0},
T = Array[{H[[#1,#2]],#2}&,{d,d}];
Do[If[S === 0,
T =
Array[
(If[(T[[#1,k]][[1]]+T[[k,#2]][[1]] < T[[#1,#2]][[1]]),
If[#1 == #2,S=#1];
{T[[#1,k]][[1]]+T[[k,#2]][[1]],T[[#1,k]][[2]]},
T[[#1,#2]]])&,
{d,d}]],
{k,d}];
If[S===0,T,
NegativeLoop[route[S,S,T]]]]

route[i_,j_,SP_]:= Block[{p={i}},
While[(Last[p]!=j)||(p=={i}),p =Append[p,SP[[Last[p],j]][[2]]]];p];
(*route from i to j following the signposts SP*)

floydRoutes[H_]:= floydRoutes[H] =
Block[{T=floydSignposts[H],i,j,d},
If[Head[T]===NegativeLoop,T,
d=Length[T];
Array[{route[#1,#2,T],T[[#1,#2]][[1]]}&,{d,d}]]];

floydRoutesStrings[H_]:= floydRoutesStrings[H] =
Block[{T=floydRoutes[H] ,i,j,d},
If[Head[T]===NegativeLoop,T,
d=Length[T];
Array[
StringForm["`` ``",T[[#1,#2]][[1]],T[[#1,#2]][[2]]]&,
{d,d}]]];

floydRoutesColumn[H_]:= floydRoutesColumn[H] =
Block[{T = floydRoutesStrings[H]},
If[Head[T]===NegativeLoop,T,
ColumnForm[Flatten[T,1]]]];

floydRoutesStringsBorderedArray[H_]:= floydRoutesStringsBorderedArray[H] =
Block[{T = floydRoutesStrings[H],d},
If[Head[T]===NegativeLoop,T,
d=Length[T];
Array[Which[
#1==#2==1,"-->",
#1==1, #2-1,
#2==1, #1-1,
True, T[[#1-1,#2-1]]]&,
{d+1,d+1}]]];

floydRoutesTable[H_]:= floydRoutesTable[H] =
Block[{T = floydRoutesStringsBorderedArray[H],d},
If[Head[T]===NegativeLoop,T,
MatrixForm[T]]];

grid[H_]:= grid[H] =
Block[{T=floydRoutesStringsBorderedArray[H],r,c,dx,dy,i,j},
If[Head[T]===NegativeLoop,T,
{r,c}=Dimensions[T][[{1,2}]];
{dx,dy}= {1/(2c),1/(2r)};
Graphics[
Union[
Table[Text[T[[i,j]],{dx (2 j - 1),1- dy (2 i- 1)}],{i,r},{j,c}],
Table[Line[{{dx 2 j, 0},{dx 2 j,1}}],{j,0,c}],
Table[Line[{{0, dy 2 i},{1,dy 2 i}}],{i,0,r}]
]
,AspectRatio->(r/c)(1/2)]]];

floydRoutesGrid[H_]:=
Block[{T = grid[H]},
If[Head[T]===NegativeLoop,
T,
Show[T]]];

floydGraph[finrat_,min2_,max2_,d_]:=
Block[{i,j},
Table[Which[i==j,0,
finrat =!= Infinity && Random[Integer,{1,finrat}]==1,Infinity,
True,Random[Integer,{min2,max2}]],
{i,d},{j,d}]];
(*finrat: positve integer or Infinity;
min2 ² max2 , integers;
d, positive integer *)

Format[NegativeLoop[a___]] := StringForm["`` is a negative loop.",a]

End[]
EndPackage[];

(*
;[s]
22:0,1;14,0;439,1;444,0;602,1;613,0;815,1;833,0;1104,1;1121,0;1303,1;1334,0;1727,1;1743,0;1919,1;1923,0;2419,1;2434,0;2559,1;2569,0;2881,1;2887,0;3007,-1;
3:11,13,9,Courier,0,10,0,0,0;11,13,9,Courier,1,10,0,0,0;0,13,9,Courier,32,10,0,0,0;
:[font = section; inactive; startGroup; Cclosed; hscroll; ]
Examples
:[font = subsection; inactive; ]
1.
:[font = input; ]
H =
{{0, -1, -1, 0, 2}, {Infinity, 0, 1, 3, 3}, {Infinity, 1, 0, -1, 1}, {5, 1, 3, 0, Infinity}, {3, 3, 3, 1, 0}};
:[font = input; hscroll; ]
Timing[floydSignposts[H]]
:[font = input; hscroll; ]
Timing[floydRoutes[H]]
:[font = input; hscroll; ]
Timing[floydRoutesColumn[H]]
:[font = input; hscroll; ]
Timing[floydRoutesTable[H]]
:[font = input; hscroll; ]
Timing[floydRoutesGrid[H]] (*The grid has to be scaled-up manually*)
:[font = subsection; inactive; hscroll; ]
2.
:[font = input; ]
K =
{{0, 0, 1, Infinity, 0}, {-1, 0, Infinity, 1, 0}, {1, 1, 0, Infinity, 0}, {Infinity, -1, 0, 0, -1}, {1, 0, -1, -1, 0}};
:[font = input; ]
Timing[floydSignposts[K]]
:[font = input; hscroll; ]
Timing[floydRoutes[K]]
:[font = input; hscroll; ]
Timing[floydRoutesColumn[K]]
:[font = input; hscroll; ]
Timing[floydRoutesTable[K]]
:[font = input; hscroll; ]
Timing[floydRoutesGrid[K]]
:[font = subsection; inactive; ]
3. Further examples may be constructed using input generated by floydGraph:
;[s]
3:0,0;65,1;76,0;77,-1;
3:2,14,9,Times,1,12,0,0,0;1,14,9,Times,1,12,0,0,0;0,14,9,Times,1,12,0,0,0;
:[font = input; endGroup; ]
L = floydGraph[finrat_,min2_,max2_,d_]
(* (finrat: positive integer or Infinity;
min ² max , integers;
d, positive integer)
is a dxd matrix with all diagonal entries zero, and other entries equal to Infinity or an integer chosen at random between min and max.
The proportion of infinite entries is 0 if finrat = Infinity, and approximately 1/finrat otherwise.*)
;[s]
3:0,0;1,1;14,0;373,-1;
2:2,13,9,Courier,0,10,0,0,0;1,13,9,Courier,1,10,0,0,0;
:[font = input; ]

^*)