Dear all,
Many have perhaps done the infamous equivalent resistor of a cube question in their physics or (electrical) engineering classes. It is quite tricky as one can not reduce the resistors using the simple series-rule and parallel-rule for resistors. One has to do some more work: use symmetry or linear algebra to get to the right answer. I was actually interested in the equivalent resistor for an icosahedron:
Now imagine that all the edges are replaced by 1-Ohm resistors, what is the equivalent resistor of this network? The way of solving this is by using Kirchhoffs rules.
For every vertex the sum of the current must be 0 (what goes in must go out, otherwise it would accumulate at that vertex). For every edge I can relate the voltages at the ends of the edges (vertices).
V[a] - V[b] = i[a,b] r[a,b]
Since I presume all the resistors to be 1 ohm, this reduces the equation to:
V[a] - V[b] = i[a,b]
where we assume that V is in Volts and i in Amperes (i.e. both in derived SI units without prefixes). By applying a 1 volt difference between opposite ends and figure out how much current will flow we can calculate the equivalent resistance as 1/current.
I programmed this elaborate function to do all of that for me given a polyhedron:
ClearAll[EquivalentResistance,EquivalentResistanceHelper]
EquivalentResistance::invalidstartstop="Start and Stop should be distinct integers between 1 and `1` (inclusive)";
EquivalentResistance[poly_String]:=EquivalentResistance[poly,All]
EquivalentResistance[poly_String,Max]:=Block[{edges,dm,beginend},
edges=PolyhedronData[poly,"EdgeIndices"];
dm=DistanceMatrix[PolyhedronData[poly,"VertexCoordinates"]//N];
beginend=FirstPosition[dm,Max[dm],{2}];
Dataset[EquivalentResistanceHelper[poly,beginend]]
]
EquivalentResistance[poly_String,All]:=Block[{startsends},
startsends=Subsets[Union@@PolyhedronData[poly,"EdgeIndices"],{2}];
Dataset[Association[Thread[startsends->(EquivalentResistanceHelper[poly,#]&/@startsends)]]]
]
EquivalentResistance[poly_String,start_Integer]:=Block[{other},
other=DeleteCases[Union@@PolyhedronData[poly,"EdgeIndices"],start];
EquivalentResistance[poly,Thread[{start,other}]]
]
EquivalentResistance[poly_String,startsends:{{_,_}..}]:=Dataset[Association[Thread[startsends->(EquivalentResistanceHelper[poly,#]&/@startsends)]]]
EquivalentResistance[poly_String,{start_Integer,stop_Integer}]:=Dataset[EquivalentResistanceHelper[poly,{start,stop}]]
EquivalentResistanceHelper[poly_String,{start_Integer,stop_Integer}]:=Block[{resistors,edges,inout,begin,end,beginend,vertices,currentrulesin,currentrulesout,currentrules,voltrules,equations,variables,sols,totalcurrent,graphout,eqout,fullsolout,resout,i,V},
resistors=edges=PolyhedronData[poly,"EdgeIndices"];
If[1<=start<=Max[edges]\[And]1<=stop<=Max[edges]\[And]start=!=stop,
{begin,end}=beginend={start,stop};
edges=Join[edges,inout={{0,begin},{end,Max[edges]+1}}];
{begin,end}=beginend={0,Max[edges]};
graphout=HighlightGraph[Graph[UndirectedEdge@@@edges,VertexLabels->"Name",PlotRangePadding->Scaled[.15]],beginend~Join~(Style[#,Red]&/@(UndirectedEdge@@@resistors))];
vertices=DeleteCases[Union@@edges,Alternatives@@beginend];
currentrulesout=Table[Select[edges,First[#]==v&],{v,vertices}];
currentrulesin=Table[Select[edges,Last[#]==v&],{v,vertices}];
currentrulesin=Total/@Apply[i,currentrulesin,{2}];
currentrulesout=Total/@Apply[i,currentrulesout,{2}];
currentrules=Thread[currentrulesin-currentrulesout==0];
voltrules=Join[V[#1]-V[#2]==i[#1,#2]&@@@edges[[;;-3]],V[#1]==V[#2]&@@@edges[[-2;;]],{V[begin]==1,V[end]==0}];
equations=Join[voltrules,currentrules];
variables=DeleteDuplicates[Cases[equations,i[_,_]|V[_],\[Infinity]]];
sols=Sort@Solve[equations,variables][[1]];
totalcurrent=i[0,start]/.sols;
<|"Polyhedron"->poly,"Graph"->graphout,"Start"->start,"Stop"->stop,"Equations"->equations,"Solutions"->sols,"EquivalentResistance"->1/totalcurrent|>
,
Message[EquivalentResistance::invalidstartstop,Max[edges]];
Abort[]
]
]
Two-vertex specification
So how do we call this function? Well, there are several ways:
EquivalentResistance["Cube", {1, 2}]
This will give use the equivalent resistance between vertex 1 and 2 of a cube-network of resistors. It gives back a dataset:
Where the red-edges are 1-ohm resistors and the blue lines are our test-leads with no resistance. You can also see the equations and solutions to those equations:
with as many equations as solutions as it should.
Opposite ends
In addition, one can query the function like:
EquivalentResistance["Cube", Max]
which will find two 'opposite' ends of the cube, and calculate the resistance accordingly:
This is the classical problem many of us have solved in school (5/6 Ohm).
Multiple two-vertex specifications
One can also supply multiple pairs:
EquivalentResistance["Cube", {{1, 2}, {1, 6}, {1, 8}}]
giving a more elaborate dataset back:
Start vertex only
If one supplies only the starting point, it will find the resistance for all the other vertices:
EquivalentResistance["Cube", 3]
in this case it will find all the resistance with starting point 3:
All
Lastly one can specify All (or nothing)
EquivalentResistance["Cube", All] (* same as EquivalentResistance["Cube"] *)
to get a dataset with all possible combinations: 28 cases for a cube (8 edges: Pochhammer[7, 2]/2=28).
Solve original problem
Let's calculate the equivalent resistance for opposite points for all the platonic solids:
Dataset[Normal[EquivalentResistance[#,Max][{"Polyhedron","EquivalentResistance"}]]&/@PolyhedronData["Platonic"]]
giving:
Note that dataset shows numerical approximations of the actual values. The values are actually exact:
Values /@ Normal[%]
giving:
{{Cube,5/6},{Dodecahedron,7/6},{Icosahedron,1/2},{Octahedron,1/2},{Tetrahedron,1/2}}
Other examples
It also works (fast) with larger networks; say a bucky-ball shape:
EquivalentResistance["TruncatedIcosahedron", Max]
We can also make a table for all the non-compound polyhedrons what the equivalent resistances are:
alldata={#,EquivalentResistance[#,Max]["EquivalentResistance"]}&/@Select[Complement[PolyhedronData[],PolyhedronData["Compound"]],StringQ];
SortBy[Append[#,N[Last[#]]]&/@alldata,Last]//Grid
Some observations: some have an equivalent resistance smaller than 1, others bigger than 1. Somehow I would've expected that all would be smaller than 1 (there are always multiple paths to the ends). Also note that one gets very elaborate fractions for the more complex polyhedrons!
Conclusion
I hope you like this short exploration. One can easily extend this to arbitrary networks with arbitrary resistors. The methodology is the same: set up all the 'current rules', set up 'voltage rules', and some boundary conditions and solve it using Solve.