mma problem...
- To: mathgroup at christensen.cybernetics.net
- Subject: [mg547] mma problem...
- From: Patcavana at aol.com
- Date: Tue, 14 Mar 1995 12:38:58 -0500
If any body would like to give this a try..................
---------------------
>Forwarded message:
>Subj: mma problem...
>Date: 95-03-14 12:35:16 EST
>From: Patcavana
This is a mma notebook with the function StartNet defined below. This
function is for creating a starting topology for a network design algorithm.
There seems to be a problem starting with the first For statement. For
some reason when i = 2, the body of the For is skipped. (see output below).
Also, it gets stuck on i=5. I don't know really what the problem is.
I've tried the same loop structures with different bodies and it did work. I
tried eliminating the parantheses with no difference. I've provided as
much information to help understand the code.
Remove[StartNet]
StartNet[net1_Graph]:=
Block[{g,m,adj,sublist,mndlst,co,l,len},
g=MinimumSpanningTree[net1];ShowLabeledGraph[g];
Print["Edges[g] = ",TableForm[Edges[g]]];
m=NumberOfNeighbors[g];Print["m = ",m];
adj=Neighbors[g];Print["adj = ",adj];
co=Edges[net1];Print["co = ",TableForm[co]];
len=Length[m];Print["Length[m] = ",len];
For[i=1,i<=len,++i,
(Print["i = ",i]; sublist=ListSubsets[m,adj,i];
Print["sublist = ",sublist];
If[sublist=={},Print["sublist empty, i = ",i],
(mndlst=MinimumNeighborDistance[co,sublist];
Print["mndlst = ",mndlst];
l=Length[mndlst];Print["l = ",l];
If[l<2,(Print["mndlst<2"];g=AddEdge[g,Flatten[mndlst]];
Print["Edges[g] = ",TableForm[Edges[g]]]),
(Print["mndlst>=2"];Print["l = ",l];
For[j=1,j<=Length[mndlst],++j,Print["j = ",j];
g=AddEdge[g,Flatten[mndlst[[j]]]]
])])])];
ShowLabeledGraph[g]
]
?StartNet
Global`StartNet
StartNet[net1_Graph] :=
Block[{g, m, adj, sublist, mndlst, co, l, len},
g = MinimumSpanningTree[net1]; ShowLabeledGraph[g];
Print["Edges[g] = ", TableForm[Edges[g]]];
m = NumberOfNeighbors[g]; Print["m = ", m]; adj = Neighbors[g];
Print["adj = ", adj]; co = Edges[net1];
Print["co = ", TableForm[co]]; len = Length[m];
Print["Length[m] = ", len];
For[i = 1, i <= len, ++i,
Print["i = ", i]; sublist = ListSubsets[m, adj, i];
Print["sublist = ", sublist];
If[sublist == {}, Print["sublist empty, i = ", i],
mndlst = MinimumNeighborDistance[co, sublist];
Print["mndlst = ", mndlst]; l = Length[mndlst];
Print["l = ", l]; If[l < 2,
Print["mndlst<2"]; g = AddEdge[g, Flatten[mndlst]];
Print["Edges[g] = ", TableForm[Edges[g]]],
Print["mndlst>=2"]; Print["l = ", l];
For[j = 1, j <= Length[mndlst], ++j,
Print["j = ", j]; g = AddEdge[g, Flatten[mndlst[[j]]]]]]]]\
; ShowLabeledGraph[g]]
??Graph
Graph[g,v] is the header for a graph object where g is an adjacency matrix
and v is a list
of vertices.
??MinimumNeighborDistance
MinimumNeighborDistance[co_List,sublist_List] creates a list of neighbor(s)
that are a
minimum distance from a node. The input is the distance/cost matrix co
and a list of
potential minimum neighbors allready determined by ListSubsets. The output
is a list of
one neighbor which is closest to the given node. In the event that there
is a tie with a
second neighbor, both nodes will be returned.
MinimumNeighborDistance[co_List, sublist_List] :=
Block[{len, minm, minpair, ii, jj},
minm = 1000; minpair = {{}}; len = Length[sublist];
For[i = 1, i <= len, ++i, ii = sublist[[i,1]]; jj = sublist[[i,2]];
If[co[[ii,jj]] == minm, minpair = Append[minpair, {ii, jj}]];
If[co[[ii,jj]] < minm, minm = co[[ii,jj]]; minpair = {{ii, jj}}]];
minpair]
??MinimumSpanningTree
MinimumSpanningTree[g] uses Kruskal's algorithm to find a minimum spanning
tree of graph g.
Attributes[MinimumSpanningTree] = {Protected}
MinimumSpanningTree[DiscreteMath`Combinatorica`private`g_Graph] :=
Module[{DiscreteMath`Combinatorica`private`edges =
Edges[DiscreteMath`Combinatorica`private`g],
DiscreteMath`Combinatorica`private`set =
InitializeUnionFind[V[DiscreteMath`Combinatorica`private`g]]},
FromUnorderedPairs[Select[Sort[ToUnorderedPairs[DiscreteMath`Combinatorica`pri
vate\
`g], Element[DiscreteMath`Combinatorica`private`edges, #1] <=
Element[DiscreteMath`Combinatorica`private`edges, #2] & ],
If[FindSet[#1[[1]], DiscreteMath`Combinatorica`private`set] !=
FindSet[#1[[2]], DiscreteMath`Combinatorica`private`set],
DiscreteMath`Combinatorica`private`set =
UnionSet[#1[[1]], #1[[2]], DiscreteMath`Combinatorica`private`set];
True,
False] & ], Vertices[DiscreteMath`Combinatorica`private`g]]] /;
UndirectedQ[DiscreteMath`Combinatorica`private`g]
??ShowLabeledGraph
ShowLabeledGraph[g] displays graph g according to its embedding, with each
vertex labeled
with its vertex number. ShowLabeledGraph[g,l] uses the ith element of list
l as the label
for vertex i.
Attributes[ShowLabeledGraph] = {Protected}
ShowLabeledGraph[DiscreteMath`Combinatorica`private`g_Graph] :=
ShowLabeledGraph[DiscreteMath`Combinatorica`private`g,
Range[V[DiscreteMath`Combinatorica`private`g]]]
ShowLabeledGraph[DiscreteMath`Combinatorica`private`g1_Graph,
DiscreteMath`Combinatorica`private`labels_List] :=
Module[{DiscreteMath`Combinatorica`private`pairs =
ToOrderedPairs[DiscreteMath`Combinatorica`private`g1],
DiscreteMath`Combinatorica`private`g =
NormalizeVertices[DiscreteMath`Combinatorica`private`g1],
DiscreteMath`Combinatorica`private`v},
DiscreteMath`Combinatorica`private`v =
Vertices[DiscreteMath`Combinatorica`private`g];
Show[Graphics[Join[PointsAndLines[DiscreteMath`Combinatorica`private`g],
(Line[Chop[DiscreteMath`Combinatorica`private`v[[#1]]]] & ) /@
DiscreteMath`Combinatorica`private`pairs,
DiscreteMath`Combinatorica`private`GraphLabels[DiscreteMath`Combinatorica`priv
ate\
`v, DiscreteMath`Combinatorica`private`labels]]],
{AspectRatio -> 1, PlotRange ->
DiscreteMath`Combinatorica`private`FindPlotRange[DiscreteMath`Combinatorica`pr
ivate\
`v]}]]
??Edges
Edges[g] returns the adjacency matrix of graph g.
Attributes[Edges] = {Protected}
Edges[Graph[DiscreteMath`Combinatorica`private`e_, _]] :=
DiscreteMath`Combinatorica`private`e
??NumberOfNeighbors
NumberOfNeighbors[g_Graph] creates a list of the number of neighbors of all
nodes in
minimum spanning tree g.
NumberOfNeighbors[g_Graph] := Length /@ ToAdjacencyLists[g]
??Neighbors
Neighbors[g_graph] creates an adjacency list of all nodes of graph g. Input
is minimum
spanning tree g. Output is an adjacency list of graph g.
Neighbors[g_Graph] := ToAdjacencyLists[g]
??ListSubsets
ListSubsets[m_List,adj_List,i_Integer] creates a list of all possible
combinations of 2
element subsets of neighbors of node i (node i must have at least two
neighbors). Input
is list m containing the number of neighbors of all nodes, adj is and
adjacency list of
all nodes and i is an integer specifying which node you want to get the
combination of
neighbors.
ListSubsets[m_List, adj_List, i_Integer] :=
Block[{sublist, len}, sublist = {}; len = Length[m];
If[m[[i]] >= 2, KSubsets[adj[[i]], 2], {}]]
net1=Graph[{{0, 69.4262, 21.9545, 86.1626, 79.9062, 44.1814},
......here is a definition of an object..........
{69.4262, 0, 68.542, 82.8734, 43.4166, 50.636},
{21.9545, 68.542, 0, 104.317, 90.2718, 59.6154},
{86.1626, 82.8734, 104.317, 0, 44.0114, 45.607},
{79.9062, 43.4166, 90.2718, 44.0114, 0, 38.4838},
{44.1814, 50.636, 59.6154, 45.607, 38.4838, 0}},
{{83, 37}, {31, 83}, {94, 56}, {3, 5}, {4, 49}, {39, 33}}];
g=MinimumSpanningTree[net1];
m=NumberOfNeighbors[g]
{2, 1, 1, 1, 3, 2}
adj=Neighbors[g]
{{3, 6}, {5}, {1}, {5}, {2, 4, 6}, {1, 5}}
co=Edges[net1]
{{0, 69.4262, 21.9545, 86.1626, 79.9062, 44.1814},
{69.4262, 0, 68.542, 82.8734, 43.4166, 50.636},
{21.9545, 68.542, 0, 104.317, 90.2718, 59.6154},
{86.1626, 82.8734, 104.317, 0, 44.0114, 45.607},
{79.9062, 43.4166, 90.2718, 44.0114, 0, 38.4838},
{44.1814, 50.636, 59.6154, 45.607, 38.4838, 0}}
sublist=ListSubsets[m,adj,5]
{{2, 4}, {2, 6}, {4, 6}}
MinimumNeighborDistance[co,sublist]
{{4, 6}}
StartNet[net1] ................the program is executed
here..........................
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 0
0 0 0 0 1 0
0 1 0 1 0 1
1 0 0 0 1 0
m = {2, 1, 1, 1, 3, 2}
adj = {{3, 6}, {5}, {1}, {5}, {2, 4, 6}, {1, 5}}
co = 0 69.4262 21.9545 86.1626 79.9062 44.1814
69.4262 0 68.542 82.8734 43.4166 50.636
21.9545 68.542 0 104.317 90.2718 59.6154
86.1626 82.8734 104.317 0 44.0114 45.607
79.9062 43.4166 90.2718 44.0114 0 38.4838
44.1814 50.636 59.6154 45.607 38.4838 0
Length[m] = 6
i = 1
sublist = {{3, 6}}
mndlst = {{3, 6}}
l = 1
mndlst<2
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 0
0 1 0 1 0 1
1 0 1 0 1 0
i = 3 ............it
skipped i=2, for some reason.........................
sublist = {}
sublist empty, i = 3
i = 4
sublist = {}
sublist empty, i = 4
i = 5
sublist = {{2, 4}, {2, 6}, {4, 6}}
mndlst = {{4, 6}}
l = 1
mndlst<2
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 1
0 1 0 1 0 1
1 0 1 1 1 0
i = 5
..............................it gets
stuck on i=5 forever, i max is 6.........................
sublist = {{2, 4}, {2, 6}, {4, 6}}
mndlst = {{4, 6}}
l = 1
mndlst<2
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 2
0 1 0 1 0 1
1 0 1 2 1 0
i = 5
sublist = {{2, 4}, {2, 6}, {4, 6}}
mndlst = {{4, 6}}
l = 1
mndlst<2
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 3
0 1 0 1 0 1
1 0 1 3 1 0
i = 5
sublist = {{2, 4}, {2, 6}, {4, 6}}
mndlst = {{4, 6}}
l = 1
mndlst<2
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 4
0 1 0 1 0 1
1 0 1 4 1 0
$Aborted
Edges[g] = 0 0 1 0 0 1
0 0 0 0 1 0
1 0 0 0 0 1
0 0 0 0 1 16
0 1 0 1 0 1
1 0 1 16 1 0