Skip to main content

list manipulation - How to delete unnecessary resistances in a resistance network


I'm still dealing with resistance network processing and got one problem left: how to delete unnecessary resistances?




Background



Let's assume we are junior high students and know nothing about Kirchhoff's laws. We only know about how to calculate parallel resistances


parallel


equivalent serial resistances


line


and how to convert between star- and triangle topologies


conv


However, the first step of the calculation process is to determine which resistances are relevant and which are not (when looking at the equivalent resistance between some points in the network). At this I got stuck.




Main Problem


From now on I'll use edges in graphs to represent resistances



Some resistance's existence contribute nothing to the entire network:


For example, when calculating resistance between point 1 and point 4 in this network:


Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 5 <-> 2, 6 <-> 3}, VertexLabels -> "Name", 
VertexCoordinates -> {{0, 0}, {1, 1}, {2, 1}, {3, 0}, {0, 2}, {3, 2}}]

net1


point 5 and point 6 is totally useless, So I want a program to delete edge 5<->2 and 6<->3 as well as vertex 5 and 6, generate a graph like this:


Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4}, VertexLabels -> "Name", 
VertexCoordinates -> {{0, 0}, {1, 1}, {2, 1}, {3, 0}}]


net2


A more complex form can be like:


 Graph[{0 <-> 13, 13 <-> 14, 14 <-> 0, 0 <-> 1, 12 <-> 1, 0 <-> 12, 
10 <-> 16, 4 <-> 9, 9 <-> 10, 10 <-> 4, 11 <-> 9, 11 <-> 10,
1 <-> 2, 2 <-> 3, 1 <-> 4, 1 <-> 5, 1 <-> 6, 4 <-> 8, 8 <-> 7,
5 <-> 7, 6 <-> 3, 7 <-> 3, 11 <-> 4, 12 <-> 17, 17 <-> 18,
18 <-> 19, 4 <-> 15, 15 <-> 20, 20 <-> 4, 10 <-> 21}]

net3


With resistances between point 1, 3 and 11 concerned.



The final result of this test graph shall be


Graph[{4 <-> 9, 9 <-> 10, 10 <-> 4, 11 <-> 9, 11 <-> 10, 1 <-> 2, 
2 <-> 3, 1 <-> 4, 1 <-> 5, 1 <-> 6, 4 <-> 8, 8 <-> 7, 5 <-> 7,
6 <-> 3, 7 <-> 3, 11 <-> 4}]

net4




Some Notes


I'm trying to write things out using only methods in graph theory or similar techniques, thus it's not desired to use Kirchhoff's laws or solve the network via classical network analysis. Any other way involving list-manipulation, graph manipulation, etc. are acceptable.



Answer




I am not sure if this completely answers your question; if not I hope it at least gets you further to an actual solution


Take for instance the second of the two networks you presented


g = Graph[{0 <-> 13, 13 <-> 14, 14 <-> 0, 0 <-> 1, 12 <-> 1, 0 <-> 12,
10 <-> 16, 4 <-> 9, 9 <-> 10, 10 <-> 4, 11 <-> 9, 11 <-> 10,
1 <-> 2, 2 <-> 3, 1 <-> 4, 1 <-> 5, 1 <-> 6, 4 <-> 8, 8 <-> 7,
5 <-> 7, 6 <-> 3, 7 <-> 3, 11 <-> 4, 12 <-> 17, 17 <-> 18,
18 <-> 19, 4 <-> 15, 15 <-> 20, 20 <-> 4, 10 <-> 21},
VertexLabels -> "Name"]

original network



with FindPath you can find all routes between two points in your network (1 and 11 in this case) as follows


sol = FindPath[g, 1, 11, Infinity, All]

A simple visualization for this could be


Manipulate[HighlightGraph[g, PathGraph[sol[[n]]]], {n, 1, Length@sol, 1}]

animated gif


To get the network containing only the relevant nodes you could use Subgraph as in


Subgraph[g, sol // Flatten // DeleteDuplicates, VertexLabels -> "Name"]


network


Comments