How do I find all cut vertices (aka articulation points) in a graph?

Given a connected graph $G = (V,E)$, we say that a vertex $v \in V$ is a cut vertex of $G$ if the removal of $v$ from $G$ causes $G$ to become disconnected.

How can I find all cut vertices of a given graph using Mathematica? Apparently there was an ArticulationVertices function in Combinatorica, which the docs say has been superseded by FindVertexCut. However, this new function only finds one cut vertex (if one exists), where the old one found all of them.

I should note that I'm working with some code that uses native Graph objects, and would prefer not to have to deal with Combinatorica`Graphs if possible.

• FindVertexCut returns a list of vertices representing smallest cut, and you want to find all smallest or all possible? – Vitaliy Kaurov Oct 29 '15 at 0:49
• @VitaliyKaurov I want to find a list of all (individual) cut vertices of a graph. I'm not interested in vertex cuts of size greater than 1. – David Zhang Oct 29 '15 at 0:52

One (not particularly efficient) way that occurs to me is to first find the biconnected components of a graph g, for which there is a built-in function (KVertexConnectedComponents). Then, use the fact that a vertex is a cut vertex if and only if it appears in two biconnected components.

components = KVertexConnectedComponents[g, 2];
cutVertices = Flatten[Intersection @@@ Subsets[components, {2}]];
• It doesn't look like a bad solution to me. – Szabolcs Oct 29 '15 at 7:14
• You can improve the performance by pre-sorting the components, i.e. components = Sort /@ KVertexConnectedComponents[g, 2]. – Szabolcs Oct 29 '15 at 7:24

IGraph/M has the function IGArticulationPoints.

g = PathGraph[{1, 2, 3, 4}, VertexLabels -> "Name"]

IGArticulationPoints[g]
(* {3, 2} *)

Speed comparison with KVertexConnectedComponents[g,2] for tiny and huge graphs. The timings are for IGraph/M 0.1.5.

g = ExampleData[{"NetworkGraph", "CondensedMatterCollaborations2005"}];

{VertexCount[g], EdgeCount[g]}
(* {40421, 175692} *)

RepeatedTiming[IGArticulationPoints[g];, 2]
(* {0.064, Null} *)

RepeatedTiming[KVertexConnectedComponents[g, 2];, 2]
(* {0.13, Null} *)

g = PathGraph@Range[10];

RepeatedTiming[IGArticulationPoints[g];, 2]
(* {0.000078, Null} *)

RepeatedTiming[KVertexConnectedComponents[g, 2];, 2]
(* {7.0*10^-6, Null} *)
• A note on performance: in IGraph/M 0.1.5 (not yet released) this takes about the same amount of time as KVertexConnectedComponents[g,2] alone, for not too small graphs. In the current release it might be a bit slower, I haven't tried. – Szabolcs Oct 29 '15 at 8:36