# 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

equivalent serial resistances

and how to convert between star- and triangle topologies

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}}]


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}}]


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}]


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}]


## 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.

• If anything left unclear, comment anytime~ – Wjx Aug 21 '16 at 15:32
• I will appreciate a good solution a ton, as I've been trying to solve this problem for days. And also, this is the last piece of this big program. I'll contribute the code when the program is eventually completed. – Wjx Aug 21 '16 at 15:33
• I don't really get what you mean by resistences between point 1, 3 and 11. Isn't the resistance only defined between two individual points; for that problem I think I found a solution – Sascha Aug 21 '16 at 16:00
• I can't write a complete answer for now, but I once had a similar problem and removed "single dead ends" (19-12,16-10,...) as follows: //1. Create adjacency matrix. 2. Check for vertices connected only to one point. 3. Remove them. 4. Repeat. // For the other ones (e.g. 14-13-0-12) you should find another algorithm. – Gypaets Aug 21 '16 at 16:00
• The restriction to graph theory seems a bit strange, since the algebra is straightforward, especially in Mathematica with Eliminate. And, of course, the algebra can take you other places... – John Doty Aug 21 '16 at 22:22

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"]


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}]


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

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


• Well, it seems that I missed this method of direcly find paths~ Allow me to think for one day and confirm the correctness of this method before I select this. – Wjx Aug 21 '16 at 23:20
• Very very helpful! thanks a lot! – Wjx Aug 22 '16 at 12:26

You can define a function that implements your rules. Its argument is a list of r[i,j,v] dummy functions that denote a resistance v between points iand j.

2) Parallel resistances:

network[a___, r[i_, j_, v1_], b___, r[i_, j_, v2_], c___] :=network[r[i, j, v1 v2/(v1 + v2)], a, b, c]
network[a___, r[i_, j_, v1_], b___, r[j_, i_, v2_], c___] :=network[r[i, j, v1 v2/(v1 + v2)], a, b, c]


2) Sequential resistances, get read of vertex in the middle if it is not connected to a third vertex:

 network[a___, r[j_, i_, v1_], b___, r[j_, k_, v2_], c___] :=
network[r[i, k, v1 + v2], a, b, c] /;Length[Cases[{a, b, c}, r[___, j, ___]]] == 0
network[a___, r[j_, i_, v1_], b___, r[k_, j_, v2_], c___] :=
network[r[i, k, v1 + v2], a, b, c] /;Length[Cases[{a, b, c}, r[___, j, ___]]] == 0
network[a___, r[i_, j_, v1_], b___, r[j_, k_, v2_], c___] :=
network[r[i, k, v1 + v2], a, b, c] /;Length[Cases[{a, b, c}, r[___, j, ___]]] == 0
network[a___, r[i_, j_, v1_], b___, r[k_, j_, v2_], c___] :=
network[r[i, k, v1 + v2], a, b, c] /;Length[Cases[{a, b, c}, r[___, j, ___]]] == 0


## Example

network[r[1, 2, a], r[2, 3, b], r[3, 4, c], r[4, 5, d], r[2, 4, e]]
(*network[r[1, 5, a + d + ((b + c) e)/(b + c + e)]]*)


For more complicated examples star-triangle transformation rule have to be implemented.

• ererer, I don't mean this, What you've done I've done it, so please focus on my problem of deleting unnecessary things :) Also, when dealing with more complex networks, this approach will be quite slow, and the visulization process of this method will be hard due to the structure of your program. – Wjx Aug 21 '16 at 23:16
• @Wjx Actually I would be glad to help, but perhaps I've not fully understood your question. At first your say "Some resistence's existence contribute nothing to the entire network", but then you focus on the path between 1 and 4. Why is that? Why do you think the pass between 5 and 6 is less important? Maybe you should specify more precisely what you want. Also as Sascha has already pointed out, what is exact meaning of "resistances between points 1, 3 and 11" ? – yarchik Aug 22 '16 at 6:37
• by saying resistence between points, I mean to derive a simplified resistence network consists only of these three points which can fully simulates the original network's behaviour, so when only two points are endpoints, I need to get a graph with two points and one resistence, but when more than 2 points is presented, I need to get a part of FullGraph which use weight to specify the resistence. – Wjx Aug 22 '16 at 12:26
• check this: mathematica.stackexchange.com/questions/124528/… maybe you can add another solution too~ – Wjx Aug 22 '16 at 13:11