       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]:=
g=MinimumSpanningTree[net1];ShowLabeledGraph[g];
Print["Edges[g] = ",TableForm[Edges[g]]];
m=NumberOfNeighbors[g];Print["m = ",m];
co=Edges[net1];Print["co = ",TableForm[co]];
len=Length[m];Print["Length[m] = ",len];
For[i=1,i<=len,++i,
Print["sublist = ",sublist];
If[sublist=={},Print["sublist empty, i = ",i],
(mndlst=MinimumNeighborDistance[co,sublist];
Print["mndlst = ",mndlst];
l=Length[mndlst];Print["l = ",l];
Print["Edges[g] = ",TableForm[Edges[g]]]),
(Print["mndlst>=2"];Print["l = ",l];
For[j=1,j<=Length[mndlst],++j,Print["j = ",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["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["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[], DiscreteMath`Combinatorica`private`set] !=
FindSet[#1[], DiscreteMath`Combinatorica`private`set],
DiscreteMath`Combinatorica`private`set =
UnionSet[#1[], #1[], 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.

??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.

??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
all nodes and i is an integer specifying which node you want to get the
combination  of
neighbors.

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}

{{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}}

{{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

```

• Prev by Date: Help needed !!!
• Next by Date: [VOTE} Moderate news group
• Previous by thread: Help needed !!!
• Next by thread: Re: mma problem...