Burning Number

Author

Eric W. Weisstein
February 2, 2024

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

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

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

Sources

http://arxiv.org/pdf/1507.06524.pdf

https://arxiv.org/pdf/2009.10642v1.pdf

Figure

Original

g1=With[{p=PathGraph[Range@4,VertexSize->Large]},
Tree[
Labeled[p,Style[Subscript[Style["P",Italic],4],Directive[24,Black,FontFamily->"Times"]],Left],
{
Tree[HighlightGraph[p,{Style[1,Red]}],{
HighlightGraph[p,{Style[1|2,Orange],Style[3,Red]}],
HighlightGraph[p,{Style[1|2,Orange],Style[4,Red]}]
}],
Tree[HighlightGraph[p,{Style[2,Red]}],{
burned=Labeled[HighlightGraph[p,{Style[1|2|3,Orange],Style[4,Red]}],Style[Row[{Style["b",Italic],"(",Subscript[Style["P",Italic],4],")"," == ",2}],Directive[FontFamily->"Times",16,Black]]]
}
]},
TreeElementStyle->{TreeCases[burned]->LightRed},
ImageSize->600,
TreeLayout->Left]]

g2=With[{p=CompleteGraph[{2,3},VertexSize->Large]},
Tree[
Labeled[p,Style[Subscript[Style["K",Italic],2,3],Directive[24,Black,FontFamily->"Times"]],Left],
{
Tree[HighlightGraph[p,{Style[1,Red]}],{
burned=Labeled[HighlightGraph[p,{Style[1|3|4|5,Orange],Style[2,Red]}],Style[Row[{Style["b",Italic],"(",Subscript[Style["K",Italic],2,3],")"," == ",2}],Directive[FontFamily->"Times",16,Black]]]
}],
Tree[HighlightGraph[p,{Style[3,Red]}],{
HighlightGraph[p,{Style[1|2|3,Orange],Style[4,Red]}],
HighlightGraph[p,{Style[1|2|3,Orange],Style[5,Red]}]
}],
Tree[HighlightGraph[p,{Style[4,Red]}],{
HighlightGraph[p,{Style[1|2|4,Orange],Style[3,Red]}]
}]
},
TreeElementStyle->{TreeCases[burned]->LightRed},
ImageSize->700,
TreeLayout->Left]
]

GraphicsRow[{g1,g2},ImageSize->1500,Dividers->All]

Improved

With[{func=List/*Replace[{xy_,{red_:None,orange_:None},wh_}:>Inset[HighlightGraph[CompleteGraph[{2,3},VertexSize->Large],{Style[red,Red],Style[orange,Orange]},Frame->True,Background->If[{red,orange}==={2,1|3|4|5},LightRed,White]],xy,Center,wh]]},
Tree[{},
{
Tree[{1},
{
{2,1|3|4|5}
}],
Tree[{3},
{
{4,1|2|3},
{5,1|2|3}
}],
Tree[{4},
{
{3,1|2|4}
}]
},
TreeLayout->Left,
TreeElementShapeFunction->All->func,
TreeElementSize->All->1.5
]
]

Counts

Computation

Do[Print[{n,(Put[BurningNumber[#]&/@Graphs[n],"BurningNumber_"<>If[n<10,"0",""]<>ToString[n]<>".m"])//Timing}],{n,9}]

All

A369276

Flatten[all=Table[With[{t=Tally[Sort[GraphData[#,"BurningNumber"]&/@GraphData[n]]]},If[FreeQ[t,{1,_}],Prepend[t,{1,0}],t]][[All,-1]],{n,7}]]

all//Column

Flatten[all=Table[With[{t=Tally[Sort[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","BurningNumber","BurningNumber_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]]]]},If[FreeQ[t,{1,_}],Prepend[t,{1,0}],t]][[All,-1]],{n,10}]]

all//Column

Connected

A369278

Flatten[connected=Table[With[{t=Tally[Sort[GraphData[#,"BurningNumber"]&/@GraphData["Connected",n]]]},If[FreeQ[t,{1,_}],Prepend[t,{1,0}],t]][[All,-1]],{n,7}]]

connected//Column

Table[Ceiling[Sqrt[n]],{n,7}]

Flatten[connected=Table[With[{t=Tally[Sort[Get[FileNameJoin[{$GraphDataDirectory,"Nodes","BurningNumber","BurningNumber_"<>If[n<10,"0",""]<>ToString[n]<>".m"}]][[ConnectedGraphIndices[n]]]]]},If[FreeQ[t,{1,_}],Prepend[t,{1,0}],t]][[All,-1]],{n,10}]]

connected//Column

Length/@connected

Table[Ceiling[Sqrt[n]],{n,10}]

Inequalities

connected=DeleteCases[GraphData[#,{"#","BurningNumber","V"}]&/@GraphData["Connected"],{_,_Missing,_}];

disconnected=DeleteCases[GraphData[#,{"#","BurningNumber","V"}]&/@GraphData["Disconnected"],{_,_Missing,_}];

Burning number conjecture

b(G)≤(Ceiling[(Sqrt[n])])

DeleteCases[{#,#2,#3,#2<=Ceiling[Sqrt[#3]]}&@@@connected,{__,True}]

DeleteCases[{#,#2,#3,#2<=Ceiling[Sqrt[#3]]}&@@@disconnected,{__,True}]//Take[#,10]&

Best bound on burning number conjecture

b(G)≤(Ceiling[(((Sqrt[24n+33])-3)/4)])

DeleteCases[{#,#2,#3,#2<=Ceiling[(-3+Sqrt[24#3+33])/4]}&@@@connected,{__,True}]

DeleteCases[{#,#2,#3,#2<=Ceiling[(-3+Sqrt[24#3+33])/4]}&@@@disconnected,{__,True}]//Take[#,10]&

Radius

b(G)≤r+1

connected=DeleteCases[GraphData[#,{"#","BurningNumber","Radius"}]&/@GraphData["Connected"],{_,_Missing,_}];

Cases[connected,{_,x_?(GreaterThan[1]),x_},∞,10]

BurningNumber[GraphData[{6,102}],Debug->True]

FirstCase[connected,{_,x_?(GreaterThan[2]),x_}]

BurningNumber[GraphData[{8,579}],Debug->True]

<<MathWorld`Graphs`

Cases[connected,{_,x_?(GreaterThan[3]),x_},∞,2]

BurningNumber[GraphData[{"Accordion",{12,4}}],Debug->True]

disconnected=DeleteCases[GraphData[#,{"#","BurningNumber","Radius"}]&/@GraphData["Disconnected"],{_,_Missing,_}];

disconnected//Take[#,10]&

DeleteCases[{#,#2,#3,#2≤#3+1}&@@@connected,{__,True}]

DeleteCases[{#,#2,#3,#2≤#3+1}&@@@disconnected,{__,True}]

VertexTransitive

Monitor[Select[GraphData["VertexTransitive",;;8],BurningNumber[GraphData[g=#]]=!=BurningNumber[GraphData[#],"InitialVertices"->{1}]&],g]//Timing

Monitor[Select[GraphData["VertexTransitive",;;9],BurningNumber[GraphData[g=#]]=!=BurningNumber[GraphData[#],"InitialVertices"->{1}]&],g]//Timing

Monitor[Select[DeleteCases[GraphData["VertexTransitive",;;20],{"Empty"|"LadderRung",_}],BurningNumber[GraphData[g=#]]=!=BurningNumber[GraphData[#],"InitialVertices"->{1}]&],g]//Timing

BurningNumber[GraphData[{"Empty",10}]]//Timing

BurningNumber[GraphData[{"Empty",10}],MaxSteps->3,Debug->True]

Disconnected

The burning number of a disconnected graph G with components G1, G2, . . . , Gt, where t ≥ 2, does not necessarily satisfy the equality b(G) = b(G1) + b(G2) + · · · + b(Gt). For example, let G be the disjoint union of t paths of order 2, which has burning number t + 1.

This is because you can start one of the bigger connected components burning and let it go while picking off singletons and other smaller components.

gs={GraphData[{"Tadpole",{3,2}},"Graph","Labeled"],GraphData[{7,66},"Graph","Labeled"]}

BurningNumber/@gs

"Hard" cases

Show[GraphData[#,"Graph","MinimalCrossing"][[1]],PlotLabel->#]&/@{{"Antelope",{6,10}},{"Antelope",{7,8}},{"Antelope",{7,9}},{"Antelope",{7,9}},{"Cubic",{56,2}},{"HexagonalGrid",{1,4,5}},{"HexagonalGrid",{2,3,5}},{"HexagonalGrid",{3,3,3}},{"Jahangir",{10,5}}}

{"Cubic", {56, 2}}

GraphData[{"Cubic",{56,2}}]

With[{debug=True},
(
If[debug,Print[#]];
Print[{#,BurningNumber[GraphData[#],"UseSymmetry"->True,Debug->debug]//Timing}]
)]&/@{{"Cubic",{56,2}}};

{"HexagonalGrid", {1, 4, 5}}

GraphData[{"HexagonalGrid",{1,4,5}}]

With[{debug=True},
(
If[debug,Print[#]];
Print[{#,BurningNumber[GraphData[#],"UseSymmetry"->True,Debug->debug]//Timing}]
)]&/@{{"HexagonalGrid",{1,4,5}}};

> 270 GB

GraphData[{"HexagonalGrid",{1,4,5}},"Radius"]

{"Jahangir", {10, 5}}

GraphData[{"Jahangir", {10,5}}]

GraphicsGrid[Partition[
MapIndexed[Show[#,PlotLabel->(#2[[1]]-1)]&,{g=Annotate[GraphData[{"Jahangir", {10,5}}],VertexSize->.7],
HighlightGraph[g,Style[1,Red]],
HighlightGraph[g,{Style[47,Red],Style[1|2|12|22|32|42,Orange]}],
HighlightGraph[g,{Style[7,Red],Style[1|2|3|12|22|31|32|33|42|46|47|48|51|41|43|21|23|11|13,Orange]}],
HighlightGraph[g,{Style[17,Red],Style[6|7|8|1|50|51|2|3|4|10|11|12|13|14|20|21|22|23|24|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43,Orange]}],
HighlightGraph[g,{Style[27,Red],Style[5|6|7|8|9|1|50|51|2|3|4|10|11|12|13|14|15|16|17|18|19|20|21|22|23|24|25|29|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43|39|35,Orange]}],
HighlightGraph[g,{Style[37,Red],Style[5|6|7|8|9|1|50|51|2|3|4|10|11|12|13|14|15|16|17|18|19|20|21|22|23|24|25|29|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43|39|35|26|27|28|38|36,Orange]}]
}],UpTo[4]]]

Table

GraphDataCountTable["BurningNumber",Join[
{"Antiprism"->368942,"Complete"->040000,"FoldedCube"->004526,"King"->004526,"TorusGrid"->004526},
Thread[{"Ladder","MoebiusLadder","Prism"}->368941],
(* integers *) Thread[{"Empty"}->000027],
(* 2s *) Thread[{"CocktailParty","Dipyramid","DoubleCone","Wheel"}->007395],
(* 3s *) Thread[{"CycleComplement","Gear"}->010701],
(* sqrt(n) *) Thread[{"Cycle","Path"}->003059]]]

Parametrized families

<<MathWorld`Graphs`

Alkane

seq=Table[GraphData[{"Alkane",n},"BurningNumber"],{n,10}]

Cf. A085423

seq={2,3,3,3,4,4,4,4,4,5,5,5,5,5,5,5};

Table[Floor[Log2[3(n+1)]],{n,16}]==seq

Table[Floor[Log2[3(n+1)]],{n,21}]

Do[Print[{gn={"Alkane",n},BurningNumber[AlkaneGraph[n]]//Timing}],{n,20}]//Timing

Andrasfai

seq=Table[GraphData[{"Andrasfai",n},"BurningNumber"],{n,20}]

Do[Print[{gn={"Andrasfai",n},BurningNumber[AndrasfaiGraph[n]]//Timing}],{n,30}];

AlternatingGroup

seq=Table[GraphData[{"AlternatingGroupGraph",n},"BurningNumber"],{n,2,6}]

Do[Print[{GraphData[gn={"AlternatingGroupGraph",n},"#"],BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,2,6}];

Antelope n×n

seq=Table[GraphData[{"Antelope",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Antelope",{n,n}},BurningNumber[GraphData[gn],Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

Do[Print[{gn={"Antelope",{n,n}},BurningNumber[GraphData[gn],Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,8,20}]//Timing

{"Antelope", {8, 8}} needs 113+ GB

Do[Print[{gn={"Antelope",{n,n}},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,8,20}]//Timing

Antiprism

A368942

Entity["Graph",{"Antiprism",n}]["BurningNumber"]

seq=Table[GraphData[{"Antiprism",n},"BurningNumber"],{n,3,25}]//Timing

FullSimplify[Floor[(Sqrt[16n-1]+5)/4]]

Table[Floor[(Sqrt[16n-1]+5)/4],{n,50}]

Floor[(Sqrt[16Range[50]-1]+5)/4]

GeneratingFunction[Floor[(Sqrt[16n-1]+5)/4],n,x]

FindGeneratingFunction[Floor[(Sqrt[16Range[50]-1]+5)/4],x]//Head//Timing

FindGeneratingFunction[Floor[(Sqrt[16Range[100]-1]+5)/4],x]//Head//Timing

Do[Print[{{"Antiprism",n},BurningNumber[AntiprismGraph[n]]//Timing}],{n,3,30}];

Do[Print[{{"Antiprism",n},BurningNumber[AntiprismGraph[n]]//Timing}],{n,34,35}];

{"Antiprism", 34} needs 269+ GB

2+Length[seq={2,3,3,3,3,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6,6,6,6,6,6,6}]

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

FindSequenceFunction[seq,n-2]//Head//Timing

Apollonian

seq=Table[GraphData[{"Apollonian",n},"BurningNumber"],{n,6}]

Barbell

seq=Table[GraphData[{"Barbell",n},"BurningNumber"],{n,3,20}]

(seq=Table[BurningNumber[GraphData[{"Barbell",n}]],{n,3,10}])//Timing

Bishop n×n

seq=Table[GraphData[{"Bishop",{n,n}},"BurningNumber"],{n,20}]

(seq=Table[BurningNumber[GraphData[{"Bishop",{n,n}}]],{n,2,8}])//Timing

BlackBishop n×n

seq=Table[GraphData[{"BlackBishop",{n,n}},"BurningNumber"],{n,20}]

(seq=Table[BurningNumber[GraphData[{"BlackBishop",{n,n}}]],{n,3,10}])//Timing

Centipede

seq=Table[GraphData[{"Centipede",n},"BurningNumber"],{n,10}]

(seq=Table[BurningNumber[GraphData[{"Centipede",n}]],{n,10}])//Timing

Camel n×n

seq=Table[GraphData[{"Camel",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Camel",{n,n}},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

Do[Print[{gn={"Camel",{n,n}},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

{"Camel", {10, 10}} needs 178+ GB

Do[Print[{gn={"Camel",{n,n}},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->True,Method->"Loop"]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

CocktailParty

seq=Table[GraphData[{"CocktailParty",n},"BurningNumber"],{n,20}]

(seq=Table[BurningNumber[GraphData[{"CocktailParty",n}]],{n,20}])//Timing

Complete

A040000

Entity["Graph",{"Complete",n}]["BurningNumber"]

(seq=Table[BurningNumber[GraphData[{"Complete",k}]],{k,20}])//Timing

FindSequenceFunction[l,n]

FindSequenceFunction[Rest[l],n+1]

CompleteBipartite n×n

Entity["Graph",{"CompleteBipartite",{n,n}}]["BurningNumber"]

BurningNumber[System`CompleteGraph[{#,#}]]&/@Range[20]

CompleteTripartite n×n×n

Entity["Graph",{"CompleteTripartite",{n,n,n}}]["BurningNumber"]

BurningNumber[System`CompleteGraph[{#,#,3}]]&/@Range[20]

(seq=Table[BurningNumber[GraphData[{"CompleteBipartite",{k,k}}]],{k,20}])//Timing

CrossedPrism

seq=Table[GraphData[{"CrossedPrism",n},"BurningNumber"],{n,4,24,2}]

Crown

seq=Table[GraphData[{"Crown",n},"BurningNumber"],{n,20}]

CubeConnectedCycle

Entity["Graph",{"CubeConnectedCycle",n}]["BurningNumber"]

seq=Table[GraphData[{"CubeConnectedCycle",n},"BurningNumber"],{n,3,8}]

Cycle

A003059

Entity["Graph",{"Cycle",n}]["BurningNumber"]

seq=Table[GraphData[{"Cycle",n},"BurningNumber"],{n,3,30}]

Table[Ceiling[Sqrt[n]],{n,3,30}]==seq

FindSequenceFunction[seq,n-2]

FullSimplify[%]

FindGeneratingFunction[seq,x]

SeriesCoefficient[-(2/x)-(2/((-1+x) x)),{x,0,n}]

Series[-(2/x)-(2/((-1+x) x)),{x,0,20}]

bug(309403)

FindSequenceFunction[l,n-2]//FunctionExpand

Table[%,{n,3,20}]

https://arxiv.org/pdf/1507.06524.pdf, Corollary 11

Table[Ceiling[Sqrt[n]],{n,3,20}]

FindSequenceFunction[Table[Ceiling[Sqrt[n]],{n,40}],n]//FullSimplify

(seq2=Table[BurningNumber[GraphData[{"Cycle",n}]],{n,3,30}])//Timing

seq2===seq

Do[Print[{{"Cycle",n},BurningNumber[GraphData[{"Cycle",n}]]//Timing}],{n,3,30}];

Empty

A000027

Entity["Graph",{"Empty",n}]["BurningNumber"]

(seq=Table[BurningNumber[GraphData[{"Empty",n}]],{n,9}])//Timing

FindSequenceFunction[l,n]

FibonacciCube

seq=Table[GraphData[{"FibonacciCube",n},"BurningNumber"],{n,15}]

Fiveleaper n×n

seq=Table[GraphData[{"Fiveleaper",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Fiveleaper",{n,n}},BurningNumber[GraphData[gn],Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}];

Flower

seq=Table[GraphData[{"Flower",n},"BurningNumber"],{n,5,20}]

Do[Print[{gn={"Flower",n},BurningNumber[GraphData@gn]//Timing,MaxMemoryUsed[]/10^9.}],{n,5,20}]

Do[Print[{gn={"Flower",n},BurningNumber[GraphData@gn,"UseSymmetry"->False,Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,5,20}]

FoldedCube

A004526

seq=Table[GraphData[{"FoldedCube",n},"BurningNumber"],{n,2,10}]

Table[Floor[n/2]+1,{n,2,10}]==seq

Do[Print[{gn={"FoldedCube",n},BurningNumber[GraphData[gn]]//Timing}],{n,2,10}];

Do[Print[{gn={"FoldedCube",n},BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,2,10}];

Gear

seq=Table[GraphData[{"Gear",n},"BurningNumber"],{n,3,20}]

Giraffe n×n

seq=Table[GraphData[{"Giraffe",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Giraffe",{n,n}},BurningNumber[GraphData[gn],Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

Goldberg

seq=Table[GraphData[{"Goldberg",n},"BurningNumber"],{n,3,20}]

2+Length@DeleteMissing@seq

Do[Print[{gn={"Goldberg",n},BurningNumber[GraphData@gn]//Timing,MaxMemoryUsed[]/10^9.}],{n,3,20}]

Do[Print[{gn={"Goldberg",n},BurningNumber[GraphData@gn,"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,3,6}]

Do[Print[{gn={"Goldberg",n},BurningNumber[GraphData@gn,"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,3,10}]

Grid n×n

Entity["Graph",{"Grid",{n,n}}]["BurningNumber"]

Table[GraphData[{"Grid",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Grid",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->False]//Timing}],{n,10}]//Timing

Do[Print[{gn={"Grid",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,10}]//Timing

Grid n×n×n

Entity["Graph",{"Grid",{n,n,n}}]["BurningNumber"]

Table[GraphData[{"Grid",{n,n,n}},"BurningNumber"],{n,10}]

Do[Print[{gn={"Grid",{n,n,n}},BurningNumber[GraphData[gn]]//Timing}],{n,10}];

Do[Print[{gn={"Grid",{n,n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,10}];

HalvedCube

Table[GraphData[{"HalvedCube",n},"BurningNumber"],{n,10}]

Do[Print[{gn={"HalvedCube",n},BurningNumber[GraphData[gn]]//Timing}],{n,10}];

Do[Print[{gn={"HalvedCube",n},BurningNumber[HalvedCubeGraph[n],"UseSymmetry"->True]//Timing}],{n,11}];

Hanoi

seq=Table[GraphData[{"Hanoi",n},"BurningNumber"],{n,5}]

Do[Print[{gn={"Hanoi",n},BurningNumber[GraphData[gn]]//Timing}],{n,5}]//Timing

Helm

seq=Table[GraphData[{"Helm",n},"BurningNumber"],{n,3,20}]

Table[BurningNumber[HelmGraph[n]],{n,3,10}]//Timing

Hypercube

Inferred for n > 9:

Entity["Graph",{"Hypercube",n}]["BurningNumber"]

seq=Table[GraphData[{"Hypercube",n},"BurningNumber"],{n,0,10}]

Table[Floor[(n+3)/2],{n,0,10}]

Do[Print[{gn={"Hypercube",n},BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,0,10}];

Jahangir

TextGrid[Sort[{GraphData[#,"NotationRules","Jahangir"],#,GraphData[#,"BurningNumber"]}&/@GraphData["Jahangir"]],Dividers->All]

GraphicsGrid[Partition[
MapIndexed[Show[#,PlotLabel->(#2[[1]]-1)]&,{g=Annotate[GraphData[{"Jahangir", {10,5}}],VertexSize->.7],
HighlightGraph[g,Style[1,Red]],
HighlightGraph[g,{Style[47,Red],Style[1|2|12|22|32|42,Orange]}],
HighlightGraph[g,{Style[7,Red],Style[1|2|3|12|22|31|32|33|42|46|47|48|51|41|43|21|23|11|13,Orange]}],
HighlightGraph[g,{Style[17,Red],Style[6|7|8|1|50|51|2|3|4|10|11|12|13|14|20|21|22|23|24|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43,Orange]}],
HighlightGraph[g,{Style[27,Red],Style[5|6|7|8|9|1|50|51|2|3|4|10|11|12|13|14|15|16|17|18|19|20|21|22|23|24|25|29|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43|39|35,Orange]}],
HighlightGraph[g,{Style[37,Red],Style[5|6|7|8|9|1|50|51|2|3|4|10|11|12|13|14|15|16|17|18|19|20|21|22|23|24|25|29|30|31|32|33|34|42|44|45|46|47|48|49|40|41|43|39|35|26|27|28|38|36,Orange]}]
}],UpTo[4]]]

Keller

Entity["Graph",{"Keller",n}]["BurningNumber"]

seq=Table[GraphData[{"Keller",n},"BurningNumber"],{n,5}]

Do[Print[{gn={"Keller",n},BurningNumber[KellerGraph[n]]//Timing}],{n,6}];

King n×n

A004526

Inferred for n > 9:

seq=Table[GraphData[{"King",{n,n}},"BurningNumber"],{n,20}]

Table[Floor[n/2]+1,{n,20}]==seq

Do[Print[{gn={"King",{n,n}},BurningNumber[GraphData[gn]]//Timing}],{n,10}]//Timing

Knight m×n

Entity["Graph",{"Knight",{m,n}}]["BurningNumber"]

Knight n×n

Entity["Graph",{"Knight",{n,n}}]["BurningNumber"]

seq=Table[GraphData[{"Knight",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Knight",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,11}];

Do[Print[{gn={"Knight",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->True]//Timing}],{n,20}]//Timing

Do[Print[{gn={"Knight",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->True,Debug->True]//Timing}],{n,11,20}]//Timing

Ladder

A368941

Entity["Graph",{"Ladder",n}]["BurningNumber"]

seq=Table[GraphData[{"Ladder",n},"BurningNumber"],{n,20}]

Do[Print[{gn={"Ladder",n},BurningNumber[LadderGraph[n]]//Timing}],{n,25}];

{"Ladder", 26} needs XXX+ GB

Length[seq={2,2,3,3,3,3,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6}]

Table[Floor[((n+15)/6)],{n,25}]-seq

FindSequenceFunction[seq,n]//Head//Timing

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

LadderRung

seq=Table[GraphData[{"LadderRung",n},"BurningNumber"],{n,20}]

(seq=Table[BurningNumber[GraphData[{"LadderRung",n}]],{n,7}])//Timing

FindSequenceFunction[l,n]

LucasCube

Table[GraphData[{"LucasCube",n},"BurningNumber"],{n,15}]

Do[Print[{gn={"LucasCube",n},BurningNumber[GraphData[gn],"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,9}];

Do[Print[{gn={"LucasCube",n},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,15}]//Timing

{"LucasCube", 10} needs 156+ GB

MengerSponge

Table[GraphData[{"MengerSponge",n},"BurningNumber"],{n,3}]

Do[Print[{gn={"MengerSponge",n},BurningNumber[GraphData[gn]]//Timing,MaxMemoryUsed[]/10^9.}],{n,3}]//Timing

MoebiusLadder

A368941

Entity["Graph",{"MoebiusLadder",n}]["BurningNumber"]

seq=Table[GraphData[{"MoebiusLadder",n},"BurningNumber"],{n,3,25}]

Table[BurningNumber[MoebiusLadder[n]],{n,3,20}]//Timing

Table[BurningNumber[MoebiusLadder[n]],{n,3,22}]//Timing

Do[Print[{gn={"MoebiusLadder",n},BurningNumber[MoebiusLadder[n]]//Timing}],{n,3,30}];

Do[Print[{gn={"MoebiusLadder",n},BurningNumber[MoebiusLadder[n]]//Timing}],{n,31,32}];

{"MoebiusLadder", 31} requires 153+ GB
{"MoebiusLadder", 32} requires 250+ GB

2+Length[seq={3,3,3,3,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6,6,6,6,6,6,7}]

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

FindSequenceFunction[seq,n-2]

FindLinearRecurrence[Rest@seq]//Head//Timing

Mycielski

Entity["Graph",{"Mycielski",n}]["BurningNumber"]

seq=Table[GraphData[{"Mycielski",n},"BurningNumber"],{n,11}]

Do[Print[{gn={"Mycielski",n},BurningNumber[GraphData[gn]]//Timing}],{n,11}];

Odd

Entity["Graph",{"Odd",n}]["BurningNumber"]

seq=Table[GraphData[{"Odd",n},"BurningNumber"],{n,7}]

Do[Print[{gn={"Odd",n},BurningNumber[GraphData[gn]]//Timing}],{n,7}]//Timing

Pan

seq=Table[GraphData[{"Pan",n},"BurningNumber"],{n,3,20}]

Table[BurningNumber[PanGraph[n]],{n,3,25}]//Timing

Table[BurningNumber[PanGraph[n]],{n,3,26}]//Timing

Path

A003059

Entity["Graph",{"Path",n}]["BurningNumber"]

Table[GraphData[{"Path",n},"BurningNumber"],{n,20}]//Timing

Table[Ceiling[Sqrt[n]],{n,20}]

(seq=Table[BurningNumber[GraphData[{"Path",k}]],{k,2,20}])//Timing

FindSequenceFunction[l,n-1]//FullSimplify

bug(309403)

https://arxiv.org/pdf/1507.06524.pdf, p. 1 and Theorem 10

Table[Ceiling[Sqrt[n]],{n,3,20}]

Table[Ceiling[Sqrt[n]],{n,2,20}]

Pell

Table[GraphData[{"Pell",n},"BurningNumber"],{n,9}]

Do[Print[{gn={"Pell",n},BurningNumber[GraphData[gn],"UseSymmetry"->False,Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,9}];

Do[Print[{gn={"Pell",n},BurningNumber[GraphData[gn],"UseSymmetry"->False,Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,{6}}];

Do[Print[{gn={"Pell",n},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,9}]//Timing

Do[Print[{gn={"Pell",n},BurningNumber[GraphData[gn],Debug->True,"UseSymmetry"->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,6,9}]//Timing

{"Pell", 5} needs 80+ GB

Prism

A368941

Entity["Graph",{"Prism",n}]["BurningNumber"]

Table[GraphData[{"Prism",n},"BurningNumber"],{n,3,25}]

Do[Print[{{"Prism",n},BurningNumber[PrismGraph[n]]//Timing}],{n,3,50}];

{"Prism", 31} requires 219+ GB
{"Prism", 32} requires 191+ GB

2+Length[seq={3,3,3,3,4,4,4,4,4,4,5,5,5,5,5,5,5,5,6,6,6,6,6,6,6,6,6,6,7}]

Rook n×n

seq=Table[GraphData[{"Rook",{n,n}},"BurningNumber"],{n,2,20}]

SierpinskiCarpet

seq=Table[GraphData[{"SierpinskiCarpet",n},"BurningNumber"],{n,4}]

Do[Print[{gn={"SierpinskiCarpet",n},BurningNumber[GraphData[gn]]//Timing,MaxMemoryUsed[]/10^9.}],{n,4}]//Timing

SierpinskiGasket

seq=Table[GraphData[{"SierpinskiGasket",n},"BurningNumber"],{n,5}]

Do[Print[{gn={"SierpinskiGasket",n},BurningNumber[GraphData[gn]]//Timing,MaxMemoryUsed[]/10^9.}],{n,5}]//Timing

Star

2 by https://arxiv.org/pdf/1507.06524.pdf, page 10

Entity["Graph",{"Star",n}]["BurningNumber"]

seq=Table[GraphData[{"Star",n},"BurningNumber"],{n,25}]

(seq=Table[BurningNumber[GraphData[{"Star",k}]],{k,3,20}])//Timing

Sun

Table[GraphData[{"Sun",n},"BurningNumber"],{n,3,20}]

Sunlet

seq=Table[GraphData[{"Sunlet",n},"BurningNumber"],{n,3,20}]

Tetrahedral

seq=Table[GraphData[{"Tetrahedral",n},"BurningNumber"],{n,6,10}]

Do[Print[{gn={"Tetrahedral",n},BurningNumber[GraphData[gn]]//Timing,MaxMemoryUsed[]/10^9.}],{n,6,10}]//Timing

TorusGrid n×n

A004526

Inferred for n > 10:

seq=Table[GraphData[{"TorusGrid",{n,n}},"BurningNumber"],{n,3,20}]

Table[1+Ceiling[n/2],{n,3,20}]==seq

Do[Print[{gn={"TorusGrid",{n,n}},BurningNumber[GraphData[gn]]//Timing}],{n,3,20}]//Timing

Transposition

Entity["Graph",{"Transposition",n}]["BurningNumber"]

Table[GraphData[{"Transposition",n},"BurningNumber"],{n,6}]

Do[Print[{gn={"Transposition",n},BurningNumber[GraphData[gn]]//Timing,MaxMemoryUsed[]/10^9.}],{n,6}]//Timing

Trapezohedron

Entity["Graph",{"Trapezohedron",n}]["BurningNumber"]

Table[GraphData[{"Trapezohedron",n},"BurningNumber"],{n,3,20}]

Triangular

Table[GraphData[{"Triangular",n},"BurningNumber"],{n,2,20}]

TriangularHoneycombAcuteKnight

seq=Table[GraphData[{"TriangularHoneycombAcuteKnight",n},"BurningNumber"],{n,20}]

TriangularHoneycombBishop

l=Table[GraphData[{"TriangularHoneycombBishop",n},"BurningNumber"],{n,20}]

Print[{GraphData[#,"#"],BurningNumber[GraphData[#],Debug->False]//Timing}]&/@Table[{"TriangularHoneycombBishop",n},{n,20}];

TriangularHoneycombKing

Table[GraphData[{"TriangularHoneycombKing",n},"BurningNumber"],{n,3,10}]

TriangularHoneycombObtuseKnight

Table[GraphData[{"TriangularHoneycombObtuseKnight",n},"BurningNumber"],{n,4,20}]

TriangularHoneycombQueen

Table[GraphData[{"TriangularHoneycombQueen",n},"BurningNumber"],{n,20}]

Print[{GraphData[#,"#"],BurningNumber[GraphData[#],Debug->False]//Timing}]&/@Table[{"TriangularHoneycombQueen",n},{n,20}];

TriangularHoneycombRook

Inferred for n > 7:

Table[GraphData[{"TriangularHoneycombRook",n},"BurningNumber"],{n,20}]

Do[Print[{gn={"TriangularHoneycombRook",n},BurningNumber[GraphData[gn]]//Timing}],{n,20}]//Timing

Web

Table[GraphData[{"Web",n},"BurningNumber"],{n,3,20}]

Cf. A182008

Table[Ceiling[Sqrt[2n Log[2]]],{n,5,22}]

Do[Print[{gn={"Web",n},BurningNumber[GraphData[gn]]//Timing}],{n,3,20}];

{"Web", 18} needs 181+ GB

Do[Print[{gn={"Web",n},MaxMemoryUsed[Timing[BurningNumber[GraphData[gn],"UseSymmetry"->True]]]/10.^9}],{n,3,20}];

Wheel

https://arxiv.org/pdf/1507.06524.pdf, p. 5

Entity["Graph",{"Wheel",n}]["BurningNumber"]

(seq=Table[BurningNumber[GraphData[{"Wheel",k}]],{k,4,20}])//Timing

WhiteBishop n×n

seq=Table[GraphData[{"WhiteBishop",{n,n}},"BurningNumber"],{n,2,20}]

Zebra n×n

seq=Table[GraphData[{"Zebra",{n,n}},"BurningNumber"],{n,20}]

Do[Print[{gn={"Zebra",{n,n}},BurningNumber[GraphData[gn],"UseSymmetry"->False]//Timing,MaxMemoryUsed[]/10^9.}],{n,10}];

Do[Print[{gn={"Zebra",{n,n}},BurningNumber[GraphData[gn],Debug->True]//Timing,MaxMemoryUsed[]/10^9.}],{n,20}]//Timing

Algorithm

<<MathWorld`Graphs`

<<IGraphM`

VertexColorList[l_,n_]:=Normal[SparseArray[Thread[l->1],n]]

Check singletons

GraphData["Disconnected",;;5]

TextGrid[{#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#]]}&/@GraphData["Disconnected",2;;5],Dividers->All]

Color isomorphism

<<IGraphM`

p=PathGraph[Range[4]];

IGBlissIsomorphicQ[{p,"VertexColors"->{1,0,0,0}},{p,"VertexColors"->{0,0,0,1}}]

(Subscript[P, 2])

g=PathGraph[Range@2,VertexLabels->Automatic]

v=VertexList[g]

n=VertexCount[g]

fires=List/@SymmetricallyDistinctVertices[g]

Burn[burned_]:=With[{onfire=Union[burned,AdjacencyList[g,burned]]},Union[onfire,{#}]&/@Complement[v,onfire]]

fires=Map[Burn,fires,{1}]

Flatten[fires,1]

iso=GatherBy[Flatten[fires,1],IGBlissCanonicalGraph[{p,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

(Subscript[P, 4])

g=PathGraph[Range@4,VertexLabels->Automatic]

v=VertexList[g]

n=VertexCount[g]

Burn[burned_]:=With[{onfire=Union[burned,AdjacencyList[g,burned]]},Union[onfire,{#}]&/@Complement[v,onfire]]

Start with only distinct vertices

fires=List/@SymmetricallyDistinctVertices[g]

Burn[burned_]:=With[{onfire=Union[burned,AdjacencyList[g,burned]]},Union[onfire,{#}]&/@Complement[v,onfire]]

fires=Map[Burn,fires,{1}]

Flatten[fires,1]

iso=GatherBy[Flatten[fires,1],IGBlissCanonicalGraph[{p,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

Start with all vertices

fires=List/@v

fires=Map[Burn,fires,{1}]

Flatten[fires,1]

iso=GatherBy[Flatten[fires,1],IGBlissCanonicalGraph[{p,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

"2P2+5K1"

g=GraphData["2P2+5K1","Graph","Labeled"]

BurningNumber[g,Debug->True,"UseSymmetry"->False]

BurningNumber[g,Debug->True,"UseSymmetry"->True]

v=VertexList[g]

n=VertexCount[g]

Burn[burned_]:=With[{onfire=Union[burned,AdjacencyList[g,burned]]},Union[onfire,{#}]&/@Complement[v,onfire]]

Round 1

fires=List/@SymmetricallyDistinctVertices[g]

Round 2

fires=Flatten[Burn/@fires,1]

Flatten[fires,1]

Length@%

iso=GatherBy[Flatten[fires,1],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

Flatten[fires,1]//Length

Round 3

fires=Map[Burn,fires,{2}]

iso=GatherBy[Flatten[fires,2],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

fires=fires/.{}->Nothing

Round 4

fires=Map[Burn,fires,{3}]

iso=GatherBy[Flatten[fires,3],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞],{},∞]

Round 5

fires=Map[Burn,fires,{4}]

iso=GatherBy[Flatten[fires,4],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

fires=fires//.{}->Nothing

Round 6

fires=Map[Burn,fires,{5}]

iso=GatherBy[Flatten[fires,5],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

Round 7

fires=Map[Burn,fires,{6}]

iso=GatherBy[Flatten[fires,6],IGBlissCanonicalGraph[{g,"VertexColors"->VertexColorList[#,n]}]&]

Length/@iso

iso[[All,2;;]]

fires=DeleteCases[fires,Alternatives@@Flatten[iso[[All,2;;]],1],∞]

fires=fires//.{}->Nothing

Checks

<<MathWorld`Graphs`

Method->"Map", "UseSymmetry"->False

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->False]}&/@GraphData[;;10],gn],{_,x_,x_}]//Timing

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->False]}&/@GraphData[;;12],gn],{_,x_,x_}]//Timing

Method->"Map", "UseSymmetry"->True

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->True]}&/@GraphData[;;10],gn],{_,x_,x_}]//Timing

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->True]}&/@GraphData[;;12],gn],{_,x_,x_}]//Timing

Method->"Loop", "UseSymmetry"->False

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->False,Method->"Loop"]}&/@GraphData[;;10],gn],{_,x_,x_}]//Timing

Method->"Loop", "UseSymmetry"->True

DeleteCases[Monitor[{gn=#,GraphData[#,"BurningNumber"],BurningNumber[GraphData[#],"UseSymmetry"->True,Method->"Loop"]}&/@GraphData[;;10],gn],{_,x_,x_}]//Timing