Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


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