Htydjtk

I am trying to design the network graph for an electrical circuit. I have done this by hand so far. Here is the code for the voltages graph

g = Graph[{0, 1, 2, 3, 4},

   {0 -> 1, 1 -> 2, 2 -> 1, 3 -> 2, 4 -> 3, 0 -> 4, 4 -> 0, 1 -> 3}];

PropertyValue[g, VertexLabels] = Table[i -> StringForm["(`1`)", i], {i, 0, EdgeCount[basic]}]; 



PropertyValue[{g, 0 -> 1}, EdgeLabels] = Placed[2, {1/2, {1/2, 0}}];

PropertyValue[{g, 1 -> 3}, EdgeLabels] = Placed[10, {1/2, {3/2, 1/2}}];

PropertyValue[{g, 1 -> 2}, EdgeLabels] = Placed[2, {1/2, {-1/2, -1/2}}];

PropertyValue[{g, 0 -> 4}, EdgeLabels] = Placed[3, {1/2, {-1/2, 1/2}}];

Here is the result:

I have a similar one for currents and now I need to apply Kirchhoff's laws and the only way out of this right now is doing it by hand. So my question is: is there any other more efficient way around what I am doing here?

A resistor network can be represented with an undirected (multi-)graph. We are going to orient each edge to obtain a directed graph, so we have a reference for which direction the current is flowing.

Let $B$ be the vertex-edge incidence matrix of the oriented graph. This can be obtained with IncidenceMatrix.

Let $v=(v_1, dots, v_n)$ be the vector of voltages at each node, $j=(j_1, dots, j_m)$ the vector of currents through each edge, and $c = (c_1, dots, c_m)$ the conductance of each resistor.

Let us put a voltage between nodes $s$ and $t$.

Kirchoff's current law tells us that the sum of currents is zero at each node except $s$ and $t$ where it is some $i$ and $-i$ respectively. In matrix notation, the sum of currents at each node is $Bj$.

Ohm's law tells us that $j = c (B^T v)$.

Putting the two together we get the sum of currents at each node as $B C B^T v$ where $C$ is a diagonal matrix obtained from $c$.

Now in Mathematica,

edges = {

   1 -> 2,

   1 -> 2,

   1 -> 3,

   2 -> 4,

   4 -> 3,

   5 -> 6,

   6 -> 4,

   5 -> 1

   };



SeedRandom[42];

conductances = RandomReal[{0.1, 1}, Length[edges]]



g = Graph[edges]

b = IncidenceMatrix[g]



c = DiagonalMatrix@SparseArray[conductances]



s = 1; t = 6; (* index of sink and source node *)

totalCurrent = 1 (* total current from s to t *)

Now we can get the voltages at each node.

voltages = 

 LinearSolve[

   b.c.Transpose[b],

   ReplacePart[

     ConstantArray[0, VertexCount[g]],

     {s -> -totalCurrent, t -> totalCurrent}

   ]

 ]

This system is underdetermined (corresponding to the fact that there's no reference for the voltages and only voltage differences make sense), but luckily Mathematica is smart enough to deal with that.

Get the current through each edge:

currents = conductances (voltages.b)

Get the effective resistance between s and t:

effectiveResistance = (voltages[[t]] - voltages[[s]])/current

Unfortunately, Mathematica is not capable of styling parallel edges differently. Below I'll use a simple graph (no multi-edges) to illustrate how to visualize the result.

Let this be our graph:

ug = Graph[GraphData["GreatRhombicuboctahedralGraph"], 

   GraphStyle -> "BasicBlack", VertexSize -> 0.5];

We orient edges in an arbitrary way:

g = DirectedGraph[ug, "Acyclic"]

Then use the above code, but set the same conductance for all edges,

conductances = N@ConstantArray[1, EdgeCount[g]];

and choose

s = 1; t = 12;

Visualize voltages:

Graph[

 ug,

 VertexStyle -> 

    Thread[VertexList[ug] -> ColorData["Rainbow"] /@ Rescale[voltages]],

 VertexSize -> {s -> 1, t -> 1}

]

Visualize current magnitudes though each edge:

Graph[ug,

 EdgeStyle -> Prepend[

   Thread[EdgeList[ug] -> (ColorData["Rainbow"] /@ Rescale@Abs[currents])],

   Thickness[0.02]],

 VertexSize -> {s -> 1, t -> 1}

]