-------------------------------------------------------------------------------------------------
Algorithm For Nearest Neighbor Undirected Weighted Graph
-------------------------------------------------------------------------------------------------
Algorithm For Nearest Neighbor Undirected Weighted Graph
-------------------------------------------------------------------------------------------------
===== INPUT =====
In[]:=
vertices={"A","B","C","D","E","F","G","H"};
Adjacency Matrix:
Symmetric matrix assumed.
A zero entry means no connection.
A zero row means an isolated vertex.
Symmetric matrix assumed.
A zero entry means no connection.
A zero row means an isolated vertex.
In[]:=
adjM={{0,0.1,0.4,0.2,0,0,0,0},{0.1,0,0.1,0.5,0,0,0,0},{0.4,0.1,0,0.3,0,0,0,0},{0.2,0.5,0.3,0,0,0,0,0},{0,0,0,0,0,0,0,0},{0,0,0,0,0,0,0.15,0.25},{0,0,0,0,0,0.15,0,0.35},{0,0,0,0,0,0.25,0.35,0}};
===== COMPUTATION =====
===== COMPUTATION =====
In[]:=
vcount=Length[vertices]
Out[]=
8
In[]:=
zerorows=Table[(Sum[Abs[Extract[Extract[adjM,i],j]],{j,1,vcount}]0),{i,1,vcount}]
Out[]=
{False,False,False,False,True,False,False,False}
In[]:=
vindexhash=CreateDataStructure["HashTable"];
In[]:=
Do[vindexhash["Insert",Extract[vertices,i]i],{i,1,vcount}];
In[]:=
nonzeroweights=Table[If[(Extract[zerorows,i]True),{∞},Select[Extract[adjM,i],(#≠0)&]],{i,1,vcount}]
Out[]=
{{0.1,0.4,0.2},{0.1,0.1,0.5},{0.4,0.1,0.3},{0.2,0.5,0.3},{∞},{0.15,0.25},{0.15,0.35},{0.25,0.35}}
In[]:=
minweights=Table[Min[Extract[nonzeroweights,i]],{i,1,vcount}]
Out[]=
{0.1,0.1,0.1,0.2,∞,0.15,0.15,0.25}
In[]:=
nneighbors=Table[If[(Extract[zerorows,i]True),{Extract[vertices,i]},Table[If[Extract[minweights,i]Extract[Extract[adjM,i],j],Extract[vertices,j],Nothing],{j,1,vcount}]],{i,1,vcount}]
Out[]=
{{B},{A,C},{B},{A},{E},{G},{F},{F}}
here’s where it’s assumed to be undirected
In[]:=
edgepairs=DeleteDuplicates[Flatten[Table[Sort[{Extract[vertices,i],#}]&/@Extract[nneighbors,i],{i,1,vcount}],1]]
Out[]=
{{A,B},{B,C},{A,D},{E,E},{F,G},{F,H}}
In[]:=
edgepaircount=Length[edgepairs]
Out[]=
6
In[]:=
edgepairindices=Table[vindexhash["Lookup",#]&/@Extract[edgepairs,p],{p,1,edgepaircount}]
Out[]=
{{1,2},{2,3},{1,4},{5,5},{6,7},{6,8}}
In[]:=
edgepairweights=Table[If[Extract[zerorows,Extract[Extract[edgepairindices,p],1]]True,∞,Extract[Extract[adjM,Extract[Extract[edgepairindices,p],1]],Extract[Extract[edgepairindices,p],2]]],{p,1,edgepaircount}]
Out[]=
{0.1,0.1,0.2,∞,0.15,0.25}
===== OUTPUT =====
===== OUTPUT =====
In[]:=
leastedges=Table[Annotation[Extract[Extract[edgepairs,p],1]Extract[Extract[edgepairs,p],2],EdgeWeightExtract[edgepairweights,p]],{p,1,edgepaircount}]
Out[]=
{AB,BC,AD,EE,FG,FH}
In[]:=
nng=Graph[leastedges,VertexLabelsAll,VertexLabelStyle"Medium",EdgeLabels"EdgeWeight",EdgeLabelStyleMedium,GraphLayout"RadialDrawing",ImageSizeSmall]
Out[]=
