Part (a)

g=Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,3\[UndirectedEdge]2,3\[UndirectedEdge]4,3\[UndirectedEdge]5,2\[UndirectedEdge]5,4\[UndirectedEdge]5}];

To make it look like the graph on the exam

g=Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,3\[UndirectedEdge]2,3\[UndirectedEdge]4,3\[UndirectedEdge]5,2\[UndirectedEdge]5,4\[UndirectedEdge]5},VertexStyle->{1->Red,5->Black,LightBlue},VertexSize->Medium,VertexLabelStyle->{1->Directive[White,14,Bold],5->Directive[White,14,Bold],Directive[Black,14,Bold]},
VertexLabels->Table[i->Placed["Name",{1/2,1/2}],{i,VertexList[g]}],VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}}]

Export["labelledcircuit.pdf",%]

edges=EdgeList[g]
vertices=VertexList[g]

n=VertexCount[g]
m=EdgeCount[g]

Number of spanning trees is the product of nonzero eigenvalues of Laplacian, divided by the size of the graph

laplacian=Normal[KirchhoffMatrix[g]];
MatrixForm[laplacian]

evs=Eigenvalues[laplacian]

nonzeroevs=Delete[evs,Position[evs,0][[1,1]]]

Product[i,{i,nonzeroevs}]

Simplify[%]/n

Number of spanning trees is the determinant of any cofactor of the Laplacian

We can use the command Minors to see the determinants of each cofactor

Table[Minors[laplacian][[i,i]],{i,1,n}]

Here’s a look at the (1-1) cofactor and its determinant

MatrixForm[laplacian[[2;;5,2;;5]]]

Det[%]

Or just sketch them all

It’s not too hard to identify the 8 spanning trees on the subgraph spanned by vertices 2, 3, 4, 5.  That gives you 16 spanning trees, those eight with the edge 1-2 and those eight with the edge 1-3.  Then, there are five more that have 2-3 and can use both the edge 1-2 and 1-3 instead of 2-3.  That’s 21.  There are other ways of doing this, for example, using the fact that # spanning trees on G = # spanning trees on G-e + # spanning trees on G/e.

st={{1\[UndirectedEdge]2,2\[UndirectedEdge]5,5\[UndirectedEdge]4,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,2\[UndirectedEdge]3,5\[UndirectedEdge]4,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,2\[UndirectedEdge]3,5\[UndirectedEdge]4,2\[UndirectedEdge]5},{1\[UndirectedEdge]2,2\[UndirectedEdge]5,2\[UndirectedEdge]3,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,2\[UndirectedEdge]5,5\[UndirectedEdge]3,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]2,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,2\[UndirectedEdge]5,5\[UndirectedEdge]4,5\[UndirectedEdge]3},{1\[UndirectedEdge]2,3\[UndirectedEdge]5,5\[UndirectedEdge]4,2\[UndirectedEdge]3},
{1\[UndirectedEdge]3,2\[UndirectedEdge]5,5\[UndirectedEdge]4,4\[UndirectedEdge]3},{1\[UndirectedEdge]3,2\[UndirectedEdge]3,5\[UndirectedEdge]4,4\[UndirectedEdge]3},{1\[UndirectedEdge]3,2\[UndirectedEdge]3,5\[UndirectedEdge]4,2\[UndirectedEdge]5},{1\[UndirectedEdge]3,2\[UndirectedEdge]5,2\[UndirectedEdge]3,4\[UndirectedEdge]3},{1\[UndirectedEdge]3,2\[UndirectedEdge]5,5\[UndirectedEdge]3,4\[UndirectedEdge]3},{1\[UndirectedEdge]3,3\[UndirectedEdge]5,3\[UndirectedEdge]2,4\[UndirectedEdge]3},{1\[UndirectedEdge]3,2\[UndirectedEdge]5,5\[UndirectedEdge]4,5\[UndirectedEdge]3},{1\[UndirectedEdge]3,3\[UndirectedEdge]5,5\[UndirectedEdge]4,2\[UndirectedEdge]3},
{1\[UndirectedEdge]2,1\[UndirectedEdge]3,5\[UndirectedEdge]4,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,1\[UndirectedEdge]3,5\[UndirectedEdge]4,2\[UndirectedEdge]5},{1\[UndirectedEdge]2,2\[UndirectedEdge]5,1\[UndirectedEdge]3,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,3\[UndirectedEdge]5,3\[UndirectedEdge]1,4\[UndirectedEdge]3},{1\[UndirectedEdge]2,3\[UndirectedEdge]5,5\[UndirectedEdge]4,1\[UndirectedEdge]3}
};
smallg=Graph[{1\[UndirectedEdge]2,1\[UndirectedEdge]3,3\[UndirectedEdge]2,3\[UndirectedEdge]4,3\[UndirectedEdge]5,2\[UndirectedEdge]5,4\[UndirectedEdge]5},VertexStyle->{1->Red,5->Black,LightBlue},VertexSize->Small,VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}}];
spanningtrees=Table[Show[HighlightGraph[smallg,tree,GraphHighlightStyle->{"Dashed","Thick"}]],{tree,st}];

GraphicsGrid[Partition[spanningtrees,7]]

Export["allspanningtrees.pdf",%]

Part b.  Find the currents flowing through each edge.

To get started, we choose directions.

directedg=Graph[{1\[DirectedEdge]2,1\[DirectedEdge]3,3\[DirectedEdge]2,3\[DirectedEdge]4,3\[DirectedEdge]5,2\[DirectedEdge]5,4\[DirectedEdge]5},VertexSize->Medium,EdgeStyle->{3\[DirectedEdge]2->{Dashed,Thick}},VertexStyle->{1->Red,5->Black,LightBlue},VertexLabelStyle->{1->Directive[White,14,Bold],5->Directive[White,14,Bold],Directive[Black,14,Bold]},
VertexLabels->Table[i->Placed["Name",{1/2,1/2}],{i,VertexList[g]}],EdgeShapeFunction->GraphElementData[{"FilledArrow","ArrowSize"->.05}],
VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}}]

directededges=EdgeList[directedg]

boundarymatrix=Normal[IncidenceMatrix[directedg]]

vvect=Table[Subscript[v,i],{i,vertices}]

wvect=Table[(Subscript[v,edge[[1]]]-Subscript[v,edge[[2]]]),{edge,edges}]

source=1;sink=5;

vertexcurrents=ConstantArray[0,{n}];
vertexcurrents[[VertexIndex[g,source]]]=-1;
vertexcurrents[[VertexIndex[g,sink]]]=1;
vertexcurrents

sols=Solve[{boundarymatrix.wvect==vertexcurrents,(Subscript[v, sink])==0},Join[vvect]]

absolutevoltages=(vvect/.sols)[[1]]

currents=wvect/.sols[[1]]

currentmatrix=ConstantArray[0,{n,n}];
Do[
If[MemberQ[directededges,i\[DirectedEdge]j],currentmatrix[[i,j]]=-absolutevoltages[[j]]+absolutevoltages[[i]]],{j,1,n},{i,1,n}]

Let’s get a picture

graphoptions={VertexSize->Medium,VertexStyle->{source->Red,sink->Directive[Black],LightBlue},VertexLabelStyle->{source->Directive[White,14,Bold],sink->Directive[White,14,Bold],Directive[Black,14,Bold]},EdgeLabels->"EdgeWeight",EdgeLabelStyle->Directive[Black,14,Bold],EdgeShapeFunction->GraphElementData[{"UnfilledArrow","ArrowSize"->.05}],EdgeStyle->{Thick,Opacity[.5]}};

currentweightedg=WeightedAdjacencyGraph[currentmatrix/.(0->Infinity),VertexLabels->Table[i->Placed["Name",{1/2,1/2}],{i,VertexList[WeightedAdjacencyGraph[currentmatrix]]}],graphoptions,VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}}]

Export["currentlabelledgraph.pdf",%]

Part c

Looking back at the spanning trees, we see ten of them that use the edge in question (it’s 2-3 according to how I numbered the vertices).  Of those ten, five of them have the property that the unique path from source to sink passes through the edge in question.  Three pass through from 2->3 and two pass through from 3->2.

GraphicsGrid[{Table[Show[spanningtrees[[i]]],{i,{2,6,7}}],Table[Show[spanningtrees[[i]]],{i,{11,12}}]}
]

Export["23spanningtrees.pdf",%]

So, the current flows from 2 --> 3 with a strength of (3-2)/21=1/21, which is consistent with our computations obtained from Kirchoff’s current laws.

Part d

For this part, we need to add an edge.  We’ll rename the resulting graph.

pagerankgraph=Graph[{1\[DirectedEdge]2,1\[DirectedEdge]3,2\[DirectedEdge]3,3\[DirectedEdge]4,3\[DirectedEdge]5,2\[DirectedEdge]5,4\[DirectedEdge]5,sink->source},VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}}]

a=Normal[AdjacencyMatrix[pagerankgraph]]

d=Table[Total[a[[i]]],{i,1,n}];
c=Table[a[[j,i]]/d[[j]],{i,1,n},{j,1,n}];
MatrixForm[c]

The principal eigenvector is the pageranks, but we normalize so the sum is one.

pageranks=Eigenvectors[c][[1]]/Total[Eigenvectors[c][[1]]]

vertexlabels=Table[i->Style[pageranks[[i]],12,Bold],{i,n}];

labelledpagerankgraph=Graph[{1\[DirectedEdge]2,1\[DirectedEdge]3,2\[DirectedEdge]3,3\[DirectedEdge]4,3\[DirectedEdge]5,2\[DirectedEdge]5,4\[DirectedEdge]5,sink->source},VertexCoordinates->{{1,3},{0.5,2},{2,2.5},{2,1.5},{1,1}},VertexLabels->vertexlabels];

GraphPlot[labelledpagerankgraph,VertexRenderingFunction->({LightBlue,EdgeForm[Black],Disk[#,.15],Black,Text[#2/.PropertyValue[labelledpagerankgraph,VertexLabels],#1]}&)]