Resistance Distance

Author

Eric W. Weisstein
March 1, 2018

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/ResistanceDistance.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/ResistanceDistance.html.

©2018 Wolfram Research, Inc. except for portions noted otherwise

Compute

Matrix Form

Array[a,{3,3}]//TraditionalForm

W=Array[a,{3,3}]

Y=Table[#,{3}]&/@Tr[W,List]

Y+Transpose[Y]//TraditionalForm

W/.a[x_,y_]:>a[x,x]+a[y,y]//TraditionalForm

Moses

From Peter Moses
April 18, 2012

resistanceDistance[connectionData_]:=Module[{Laplace=Normal[(SparseArray[Band[{1,1}]->(Plus@@(-#1)&)/@#1]+#1&)[SparseArray[Thread[Flatten[({Reverse[#1],#1}&)/@connectionData,1]->-1]]]]},({#1,Det[Delete[Transpose[Delete[Laplace,{{#1[[1]]},{#1[[2]]}}]],{{#1[[1]]},{#1[[2]]}}]]/Det[Delete[Transpose[Delete[Laplace,{#1[[1]]}]],{#1[[1]]}]]}&)/@Subsets[Range[Length[Laplace]],{2}]]

resistanceDistance[GraphData["CuboctahedralGraph","EdgeIndices"]]//Timing

resistanceDistance[GraphData["TruncatedIcosahedralGraph","EdgeIndices"]]//Short//Timing

Graph.m

Select[GraphData["Properties"],StringMatchQ[#,"Resis*"]&]

ResistanceMatrix[GraphData["CuboctahedralGraph"]]//Timing

ResistanceMatrix[GraphData["CuboctahedralGraph"]]//Timing

ResistanceMatrix[Graph["TruncatedIcosahedralGraph"]]//Short//Timing

ResistanceMatrix[GraphData["TruncatedIcosahedralGraph"]]//Short//Timing

Representation

ResistanceMatrix[Graph["IcosahedralGraph"]]

s=SparseArray[Automatic,{12,12},0,{1,{{0,11,22,33,44,55,66,77,88,99,110,121,132},{{2},{3},{4},{5},{6},{7},{8},{9},{10},{11},{12},{1},{3},{4},{5},{6},{7},{8},{9},{10},{11},{12},{1},{2},{4},{5},{6},{7},{8},{9},{10},{11},{12},{1},{2},{3},{5},{6},{7},{8},{9},{10},{11},{12},{1},{2},{3},{4},{6},{7},{8},{9},{10},{11},{12},{1},{2},{3},{4},{5},{7},{8},{9},{10},{11},{12},{1},{2},{3},{4},{5},{6},{8},{9},{10},{11},{12},{1},{2},{3},{4},{5},{6},{7},{9},{10},{11},{12},{1},{2},{3},{4},{5},{6},{7},{8},{10},{11},{12},{1},{2},{3},{4},{5},{6},{7},{8},{9},{11},{12},{1},{2},{3},{4},{5},{6},{7},{8},{9},{10},{12},{1},{2},{3},{4},{5},{6},{7},{8},{9},{10},{11}}},{1/2,11/30,7/15,11/30,11/30,7/15,7/15,11/30,11/30,7/15,7/15,1/2,7/15,11/30,7/15,7/15,11/30,11/30,7/15,7/15,11/30,11/30,11/30,7/15,1/2,7/15,7/15,11/30,11/30,11/30,11/30,7/15,7/15,7/15,11/30,1/2,11/30,11/30,7/15,7/15,7/15,7/15,11/30,11/30,11/30,7/15,7/15,11/30,11/30,7/15,1/2,11/30,7/15,11/30,7/15,11/30,7/15,7/15,11/30,11/30,1/2,7/15,7/15,11/30,7/15,11/30,7/15,11/30,11/30,7/15,7/15,1/2,11/30,11/30,7/15,11/30,7/15,7/15,11/30,11/30,7/15,1/2,7/15,11/30,7/15,11/30,7/15,11/30,11/30,7/15,11/30,7/15,11/30,7/15,11/30,7/15,7/15,11/30,1/2,11/30,7/15,11/30,7/15,7/15,11/30,7/15,11/30,7/15,1/2,11/30,7/15,11/30,7/15,11/30,11/30,7/15,11/30,7/15,11/30,1/2,7/15,7/15,11/30,7/15,11/30,7/15,11/30,7/15,11/30,1/2,11/30,7/15}}]

ByteCount[s]

n=Normal[s];

m=Max[Denominator[n]]

ByteCount[SparseArray[n m]]

Normal[SparseArray[n m]]

ByteCount[Normal[SparseArray[n m]]]

SparseArray[n m]/m==s

Platonic

ResistanceList[g_System`Graph]:=Module[{l=Rest[Union[Flatten[ResistanceMatrix[g]]]],m},
{m=Max[Denominator[l]],m l}
]

Multispectrum table

Grid[{#,Sequence@@ResistanceList[GraphData[#]]}&/@GraphData["Platonic"],Alignment->{{Left,Decimal,Left}},Dividers->All]

WeightedAdjacencyGraph

wg=WeightedAdjacencyGraph[ResistanceMatrix[GraphData[#]]]&/@GraphData["Platonic"]

SimpleGraph/@wg

RecognizeGraph/@%

Matrix grid

Grid[{#,ResistanceMatrix[GraphData[#]]}&/@GraphData["Platonic"],Alignment->Left,Dividers->All]//TraditionalForm

ArrayPlot

GraphicsGrid[{ArrayPlot[
ResistanceMatrix[GraphData[#]],
ColorFunction->(Hue[3#]&),
ColorFunctionScaling->False,
PlotLabel->TextCell[GraphData[#,"Name"],TextAlignment->Center,PageWidth->100],BaseStyle->{FontSize->9,FontSlant->Italic}
]&/@GraphData["Platonic"]},ImageSize->600,Spacings->-10]

GraphicsGrid[{ArrayPlot[
ResistanceMatrix[GraphData[#]],
ColorFunction->Hue,
ColorFunctionScaling->False,
PlotLabel->TextCell[GraphData[#,"Name"],TextAlignment->Center,PageWidth->100],BaseStyle->{FontSize->9,FontSlant->Italic}
]&/@GraphData["Platonic"]},ImageSize->600,Spacings->-10]

Archimedean

Multispectrum table

Grid[{#,Sequence@@ResistanceList[GraphData[#]]}&/@GraphData["Archimedean"],Alignment->{{Left,Decimal,Left}},Dividers->All]

WeightedAdjacencyGraph

wg=WeightedAdjacencyGraph[ResistanceMatrix[GraphData[#]]]&/@GraphData["Archimedean"]

g=SimpleGraph/@wg

RecognizeGraph/@g

CompleteGraphQ/@g

ArrayPlot

GraphicsGrid[Partition[ArrayPlot[ResistanceMatrix[GraphData[#]],PlotLabel->TextCell[GraphData[#,"Name"]<>If[MemberQ[{"CuboctahedralGraph","SnubCubicalGraph"},#],"\n",""],TextAlignment->Center,PageWidth->100,Hyphenation->True],BaseStyle->{FontSize->9,FontSlant->Italic}]&/@GraphData["Archimedean"],UpTo[5]],ImageSize->600,Spacings->{-10,30}]

ArrayPlot with ColorFunction->Hue

GraphicsGrid[Partition[ArrayPlot[
ResistanceMatrix[GraphData[#]],
ColorFunction->Hue,
PlotLabel->TextCell[GraphData[#,"Name"]<>If[MemberQ[{"CuboctahedralGraph","SnubCubicalGraph"},#],"\n",""],TextAlignment->Center,PageWidth->100,Hyphenation->True],BaseStyle->{FontSize->9,FontSlant->Italic}]&/@GraphData["Archimedean"],UpTo[5]],ImageSize->600,Spacings->{-10,30}]

ArrayPlot with ColorFunction->Hue,ColorFunctionScaling->False

GraphicsGrid[Partition[ArrayPlot[
ResistanceMatrix[GraphData[#]],
ColorFunction->Hue,ColorFunctionScaling->False,
PlotLabel->TextCell[GraphData[#,"Name"]<>If[MemberQ[{"CuboctahedralGraph","SnubCubicalGraph"},#],"\n",""],TextAlignment->Center,PageWidth->100,Hyphenation->True],BaseStyle->{FontSize->9,FontSlant->Italic}
]&/@GraphData["Archimedean"],UpTo[5]],ImageSize->600,Spacings->{-10,30}]

Grid[{#,Hue/@Union[Flatten[Normal[ResistanceMatrix[GraphData[#]]]]]}&/@GraphData["Archimedean"],Alignment->Left]

GreatRhombicosidodecahedralGraph overlaps blues because of values 0.6 and 1.6

Union[Flatten[Normal[ResistanceMatrix[GraphData["GreatRhombicosidodecahedralGraph"]]]]]//N

ArrayPlot with ColorFunction->Hue/Black,ColorFunctionScaling->False

GraphicsGrid[Partition[ArrayPlot[
ResistanceMatrix[GraphData[#]],
ColorFunction->(If[#==0,White,Hue[#]]&),
ColorFunctionScaling->False,
PlotLabel->TextCell[GraphData[#,"Name"]<>If[MemberQ[{"CuboctahedralGraph","SnubCubicalGraph"},#],"\n",""],TextAlignment->Center,PageWidth->100,Hyphenation->True],BaseStyle->{FontSize->9,FontSlant->Italic}
]&/@GraphData["Archimedean"],UpTo[5]],ImageSize->600,Spacings->{-10,30}]

MatrixPlot

GraphicsGrid[Partition[MatrixPlot[
ResistanceMatrix[GraphData[#]],
FrameTicks->None,PlotLabel->TextCell[GraphData[#,"Name"]<>If[MemberQ[{"CuboctahedralGraph","SnubCubicalGraph"},#],"\n",""],TextAlignment->Center,PageWidth->100,Hyphenation->True],BaseStyle->{FontSize->9,FontSlant->Italic}]&/@GraphData["Archimedean"],UpTo[5]],ImageSize->600,Spacings->{-10,30}]