Star-mesh transformation in Mathematica

Question

Are there possibly mathematica modules that perform the star-mesh transform, in the context of electrical circuit theory? Given a resistor network/graph as input.

More context:

---

We start off with a graph $G$ of $n$ nodes and a total of $n(n-1)/2$ undirected edges. To each edge, between nodes $i$ and $j$, a value $f_{ij}$ is assigned, with $f$ a given function $f:i,j\to \mathbb{R}$ [*]. If for a given pair of nodes, their edge value is less than a given threshold (so $f<\delta$) then they are considered as disconnected.

Now with the graph $G$ defined as given above, we want to perform the star-mesh transformation on the graph, until a single edge is left. Question was, whether Mathematica has relevant built-in modules that would be considerably helpful in implementing the star-mesh transformation (which in short, keeps removing nodes and updating the edge set and edge values afterwards [**]).

[*]: Any dummy function may be chosen for the purposes of illustration. For instance, a simple function that takes as input the distance between two nodes as input.

[**]: Additional details: For a generic graph $G,$ sequentially, a node is removed (for instance starting from the node with least neighbours), and upon each removal, additional (edges)weights are introduced as follows: if the removen node (r) has $x$ neighbours, then $x(x-1)/2$ weights between each pair of its neighbours are updated. For each pair $a,b$ of its neighbours there can be only two cases:

• $a,b$ were already conneted to one another by an edge with weight $w_0,$ in which case their weight is updated to $w=w_0+w_{ra}w_{rb}/\sum_i w_{ri}$ where the sum goes over all neighbours of $r.$

• $a,b$ were not previously connected, in which case an edge is added between them with the weight $w=w_{ra}w_{rb}/\sum_i w_{ri}.$

Answer 1

Let us represent the network with its weighted adjacency matrix. The matrix elements will be the conductances.

Then starMesh[matrix, i] will perform the transformation using node i as the star centre.

removeNode[matrix_, i_] := Delete[Delete[#, i] & /@ matrix, i]

zeroDiagonal[m_] := UpperTriangularize[m, 1] + LowerTriangularize[m, -1]

starMesh[matrix_?SymmetricMatrixQ, i_] :=     
 Module[{res = matrix, ind, star, mesh},
  ind = Flatten@Position[matrix[[i]], _?Positive, {1}];
  star = matrix[[i, ind]];
  mesh = zeroDiagonal@Outer[Times, star, star] / Total[star];
  res[[ind, ind]] += mesh;
  removeNode[res, i]
 ]

removeNode[matrix, i] is a helper function that deletes the ith row and column of the matrix. This is used to remove the star centre.

zeroDiagonal[matrix] is a helper function that replaces the diagonal of matrix with zeros.

In starMesh, ind is the indexes of nodes connected to i (i.e. nonzero elements in the matrix—I used Positive for simplicity).

star is a vector containing the impedances in the star structure.

mesh is the weighted adjacency matrix of the mesh.