Cactus Graph

Author

Eric W. Weisstein
November 17, 2017

This notebook downloaded from http://mathworld.wolfram.com/notebooks/GraphTheory/CactusGraph.nb.

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

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

Enumeration

A000083

1, 1, 2, 4, 9, 23, 63, 188, 596, 1979, 6804, 24118, 87379, 322652, 1209808, 4596158, 17657037, 68497898, 268006183, 1056597059, 4193905901, 16748682185, 67258011248, 271452424286, 1100632738565, 4481533246014

Table[Total[Boole[CactusGraphQ/@ConnectedGraphs[n]]],{n,9}]//Timing

Total[Boole[Get[#]]]&/@FileNames["*.m",FileNameJoin[{$GraphDataDirectory,"Nodes","Cactus"}]]

seq=DeleteCases[Import["https://oeis.org/A000083/b000083.txt","Table"],{}][[All,2]]

FindLinearRecurrence[Take[seq,{5,100}]]//Head//Timing

FindLinearRecurrence[Take[seq,{5,200}]]//Head//Timing

FindGeneratingFunction[Take[seq,50],x]//Head//Timing

Graphic

New

GraphicsGrid[DeleteCases[Table[Select[Graphs[n],CactusGraphQ]/.g_System`Graph:>SetProperty[g,{VertexSize->If[n==1,.03,{"Scaled",.1}],System`VertexStyle->Red,System`EdgeStyle->Black}],{n,5}],{}],ImageSize->500,Spacings->80]

Old

GraphicsGrid[Flatten[Partition[#,5,5,1,{}]&/@Map[Show[GraphData[#,"Image"],PlotLabel->TextCell[Style[GraphData[#,"Name"],Italic],PageWidth->80,TextAlignment->Center]]&,Drop[c,-2],{2}],1],ImageSize->500,Dividers->{All,{True,Thick,Thick,Thick,Thick,True,True}}]

Nontrivial

ncacti=SortBy[Complement[GraphData["Cactus"],GraphData["Pseudotree"]],GraphData[#,"V"]&]

GraphicsGrid[Partition[Show[GraphData[#,"Image"],PlotLabel->TextCell[Style[GraphData[#,"Name"],Italic],PageWidth->100]]&/@ncacti,6,6,{1,1},{}],Dividers->All,ImageSize->600]

Pans

GraphData[{"Pan",14},"Classes"]

GraphData["Pan","Pseudotree"]

GraphData[{"Pan",15},"Cactus"]

GraphData[{"Pan",13}]

GraphData[{"Pan",15}]

gs={"ButterflyGraph","FishGraph",{"Pan",15}}

Checks

?CactusGraphQ

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQ[GraphData[#]]}&/@GraphData[;;10],g],{_,x_,x_}]//Timing

Antenna Graph

c=GraphData["AntennaGraph","UndirectedCycles"]

Length/@Intersection@@@Subsets[c,{2}]

With[{g="AntennaGraph"},CactusGraphQ[GraphData[g],GraphData[g,"UndirectedCycles"]]]

GraphData["AntennaGraph"]

AGraph

c=GraphData["AGraph","UndirectedCycles"]

Length/@Intersection@@@Subsets[c,{2}]

With[{g="AGraph"},CactusGraphQ[GraphData[g],GraphData[g,"UndirectedCycles"]]]

GraphData["AGraph"]

Algorithm

CactusGraphQ[g_System`Graph,c_List]:=ConnectedGraphQ[g]&&Max[Length/@(Intersection@@@Subsets[c,{2}])]<2

CactusGraphQ2[g_System`Graph,c_List]:=ConnectedGraphQ[g]&&Switch[Length[c],
0|1,True,
2,Length[Intersection@@c]<2,
_,(Length[Intersection@@#]<2)&/@(And@@Subsets[c,{2}])]

CactusGraphQ2[g_System`Graph]:=CactusGraphQ2[g,GraphCycles[g]]

CactusGraphQ[GraphData[{"Windmill",{5,4}}]]//Timing

CactusGraphQ2[GraphData[{"JohnsonSkeleton",53}],cyc]//Timing

Select[GraphData[;;6],CactusGraphQ[GraphData[#]]=!=CactusGraphQ2[GraphData[#]]&]

CactusGraphQ/@GraphData/@GraphData[;;7];//Timing

CactusGraphQ2/@GraphData/@GraphData[;;7];//Timing

CactusGraphQ3[g_System`Graph]:=ConnectedGraphQ[g]&&CactusGraphQ[g,GraphCycles[g],True]
CactusGraphQ3[g_System`Graph,c_List,True]:=Switch[Length[c],0|1,True,2,Length[Intersection@@c]<2,_,(Length[Intersection@@c[[#]]]<2)&/@(And@@Developer`ToPackedArray[Subsets[Range[Length[c]],{2}]])]

Select[GraphData[;;6],CactusGraphQ[GraphData[#]]=!=CactusGraphQ3[GraphData[#]]&]

CactusGraphQ[GraphData[{"DutchWindmill",{3,3}}]]

CactusGraphQ[GraphData[{"DutchWindmill",{3,3}}],"MaxIterations"->5]

FindFundamentalCycles

c1=GraphData["Cactus",2;;8]

Is a cactus is |fc| < 2 (but this is just the same as having 0 or 1 cycles):

c2=Select[GraphData["Connected",2;;8],Length[FindFundamentalCycles[GraphData[#]]]<2&]

Complement[c2,c1]

GraphicsGrid[Partition[GraphData/@c2,UpTo[8]],ImageSize->700]

But there are additional cacti with more than one cycle:

extra=Complement[c1,c2]

GraphicsGrid[Partition[GraphData/@extra,UpTo[8]],ImageSize->700]

FindFundamentalCycles[GraphData["ButterflyGraph"]]

GraphData[{"DutchWindmill",{3,3}},"Graph","Labeled"]

c=FindFundamentalCycles[GraphData[{"DutchWindmill",{3,3}}]]

s=Map[Sort,c,{2}]

c3=Select[GraphData["Connected",2;;8],And@@DisjointQ@@@Subsets[Map[Sort,FindFundamentalCycles[GraphData[#]],{2}],{2}]&]

Complement[c3,c1]

Complement[c1,c3]

c1===c3

CactusGraphQByFindFundamentalCycles[g_System`Graph]:=And@@DisjointQ@@@Subsets[Map[Sort,FindFundamentalCycles[g],{2}],{2}]

DeleteCases[{#,GraphData[#,"Cactus"],CactusGraphQByFindFundamentalCycles[GraphData[#]]}&/@GraphData["Connected",2;;8],{_,x_,x_}]

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQByFindFundamentalCycles[GraphData[#]]}&/@GraphData["Connected",2;;10],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQByFindFundamentalCycles[GraphData[#]]}&/@GraphData["Connected",2;;20],g],{_,x_,x_}]//Timing

CactusGraphQByFindFundamentalCycles2[g_System`Graph]:=Module[{c=FindFundamentalCycles[g],res},
If[Length[c]<2,Return[True]];
res=Subsets[Map[Sort,c,{2}],{2}];
If[Length[res]==1,DisjointQ@@res[[1]],DisjointQ@@@And@@res]
]

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQByFindFundamentalCycles2[GraphData[#]]}&/@GraphData["Connected",2;;20],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQByFindFundamentalCycles2[GraphData[#]]}&/@GraphData["Connected",2;;100],g],{_,x_,x_}]//Timing

DeleteCases[Monitor[{g=#,GraphData[#,"Cactus"],CactusGraphQ[GraphData[#]]}&/@GraphData["Connected",2;;20],g],{_,x_,x_}]//Timing

CactusGraphQ[GraphData["K3"],Debug->True]