Voltage Graph

Author

Eric W. Weisstein
May 20, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/GraphTheory/VoltageGraph.nb.

For more information, see Eric's MathWorld entry https://mathworld.wolfram.com/VoltageGraph.html.

©2026 Wolfram Research, Inc. except for portions noted otherwise

Figure

grp=GraphData["PetersenGraph","AutomorphismGroup"]

VoltageGraph[GraphData["PetersenGraph"],"MaxResults"->10,Debug->True]

VoltageGraphNotation@%[[1]]

m = 5;
angles = Table[Pi/2 + 2 Pi i/m, {i, 0, m - 1}];

ucoords = AssociationThread[
	Table[u[i], {i, 0, m - 1}],
	Transpose[{Cos[angles], Sin[angles]}]
];

vcoords = AssociationThread[
	Table[v[i], {i, 0, m - 1}],
	(2/5) Transpose[{Cos[angles], Sin[angles]}]
];

coords = Join[ucoords, vcoords];

outerEdges = Table[u[i] <-> u[Mod[i + 1, m]], {i, 0, m - 1}];
spokeEdges = Table[u[i] <-> v[i], {i, 0, m - 1}];
innerEdges = Table[v[i] <-> v[Mod[i + 2, m]], {i, 0, m - 1}];

blue = StandardBlue;
red = StandardRed;
gray = GrayLevel[0.35];

labelStyle[s_] := labelStyle[s, {}];
labelStyle[s_, styles___] := Style[s, 15, FontFamily -> "Times", styles];
edgeLabelStyle[s_, c_] := Style[s, 15, Bold, c, Background -> White, FontFamily -> "Helvetica"];

quotient = Graphics[
	{
		{blue, Thick, Arrow[BezierCurve[{{-1, 0}, {-1.55, 0.65}, {-0.45, 0.65}, {-1, 0}}]]},
		{gray, Thick, Arrow[{{-0.72, 0}, {0.72, 0}}]},
		{red, Thick, Arrow[BezierCurve[{{1, 0}, {0.45, -0.65}, {1.55, -0.65}, {1, 0}}]]},
		{White, EdgeForm[Black], Disk[{-1, 0}, 0.13], Disk[{1, 0}, 0.13]},
		Text[labelStyle["u", Italic], {-1, 0}],
		Text[labelStyle["v", Italic], {1, 0}],
		Text[edgeLabelStyle["1", blue], {-1, 0.78}],
		Text[edgeLabelStyle["0", gray], {0, 0.18}],
		Text[edgeLabelStyle["2", red], {1, -0.78}],
		Text[Style[Row[{"quotient over ", Subscript["ℤ", 5]}], 18, FontFamily -> "Times"], {0, -1.1}]
	},
	PlotRange -> {{-1.8, 1.8}, {-1.25, 1.0}},
	ImageSize -> 310
];

derived = Graph[
	Join[outerEdges, spokeEdges, innerEdges],
	VertexCoordinates -> Normal[coords],
	VertexLabels -> Join[
		Thread[Table[u[i], {i, 0, m - 1}] -> Table[Placed[labelStyle[Subscript[Style["u", Italic], i]], Center], {i, 0, m - 1}]],
		Thread[Table[v[i], {i, 0, m - 1}] -> Table[Placed[labelStyle[Subscript[Style["v", Italic], i]], Center], {i, 0, m - 1}]]
	],
	EdgeStyle -> Join[
		Thread[outerEdges -> blue],
		Thread[spokeEdges -> gray],
		Thread[innerEdges -> red]
	],
	EdgeLabels -> {
		u[0] <-> u[1] -> Placed[edgeLabelStyle["+1", blue], Center],
		u[0] <-> v[0] -> Placed[edgeLabelStyle["0", gray], Center],
		v[0] <-> v[2] -> Placed[edgeLabelStyle["+2", red], Center]
	},
	VertexSize -> 0.22,
	VertexStyle -> White,
	EdgeShapeFunction -> "Line",
	ImageSize -> 390
];

LightModePane@GraphicsRow[{quotient, derived}, Spacings -> 0.4, ImageSize -> 760]