Queens Problem

Author

Eric W. Weisstein
September 8, 2016

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Games/QueensProblem.nb.

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

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

Maximum number

?QueenGraph

Non-attacking queens

solns=Table[With[{q=QueenGraph[n]},Select[Subsets[n^2],EmptyGraphQ[Subgraph[q,#]]&]],{n,5}];//Timing

Possible numbers of non-attacking queen solutions:

Tally[Length/@#]&/@solns//Column

Maximum numbers of non-attacking queens:

Max[Length/@#]&/@solns

Piecewise[{{n-1,n==2||n==3}},n]

Counts of maximum solutions:

Tally[Length/@#][[-1,2]]&/@solns

A000170

Do[With[{q=QueenGraph[n]},
Print[{n,Count[Developer`ToPackedArray[Subsets[Range[n^2],{n}]],_?(EmptyGraphQ[Subgraph[q,#]]&)]//Timing}]],{n,6}]

Figure

MaximumQueenGraphs[n_]:=Module[{q=QueenGraph[n],solns},solns=Select[Subsets[Range[n^2],{Piecewise[{{n-1,n==2||n==3}},n]}],EmptyGraphQ[Subgraph[q,#]]&];
HighlightGraph[q,#,VertexSize->.2]&/@solns
]

g1=GraphicsGrid[Partition[MaximumQueenGraphs[2],UpTo[4]]]

g2=GraphicsGrid[Partition[MaximumQueenGraphs[3],UpTo[4]]]

g3=GraphicsGrid[Partition[MaximumQueenGraphs[4],UpTo[4]]]

Column[{g1,g2,g3}]

Figure for n==8

MatrixForm/@(queens={{{0,0,1,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,1,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{1,0,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,0,1},{0,0,0,0,1,0,0,0}},{{0,1,0,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,1},{0,0,1,0,0,0,0,0},{1,0,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,0,1,0,0,0}},{{0,0,0,0,0,1,0,0},{0,0,1,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,1,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,0,1},{1,0,0,0,0,0,0,0},{0,0,0,0,1,0,0,0}},{{0,0,1,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,1},{0,1,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{1,0,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,0,1,0,0,0}},{{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,0,1},{1,0,0,0,0,0,0,0},{0,0,1,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,1,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,0,1,0,0,0}},{{0,0,0,0,0,0,1,0},{0,1,0,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,1,0,0,0,0,0},{1,0,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,0,1},{0,0,0,0,1,0,0,0}},{{0,1,0,0,0,0,0,0},{0,0,0,0,0,1,0,0},{1,0,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,0,0,1},{0,0,1,0,0,0,0,0},{0,0,0,0,1,0,0,0}},{{1,0,0,0,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,1},{0,0,1,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,1,0,0,0,0},{0,1,0,0,0,0,0,0},{0,0,0,0,1,0,0,0}},{{1,0,0,0,0,0,0,0},{0,0,0,0,1,0,0,0},{0,0,0,0,0,0,0,1},{0,0,0,0,0,1,0,0},{0,0,1,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,1,0,0,0,0,0,0},{0,0,0,1,0,0,0,0}},{{0,1,0,0,0,0,0,0},{0,0,0,1,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,1},{0,0,1,0,0,0,0,0},{1,0,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,0,1,0,0,0}},{{0,0,0,0,0,1,0,0},{0,0,1,0,0,0,0,0},{1,0,0,0,0,0,0,0},{0,0,0,0,0,0,0,1},{0,0,0,1,0,0,0,0},{0,1,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{0,0,0,0,1,0,0,0}},{{0,0,0,1,0,0,0,0},{0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,1},{0,1,0,0,0,0,0,0},{0,0,0,0,0,0,1,0},{1,0,0,0,0,0,0,0},{0,0,1,0,0,0,0,0},{0,0,0,0,1,0,0,0}}})

Show[GraphicsArray[Partition[Graphics[ChessPieces[StringJoin[Flatten[#/.{0->" ",1->"w"}]],OutputFormat->"Display",FontSize->13.50],
DisplayFunction->Identity,
AspectRatio->Automatic,
PlotRange->{{-4,4},{-4,4}}]&/@queens,4]],ImageSize->500]

EPS

Show[GraphicsArray[Partition[Graphics[ChessPieces[StringJoin[Flatten[#/.{0->" ",1->"w"}]],OutputFormat->"Display",FontSize->10],
DisplayFunction->Identity,
AspectRatio->Automatic,
PlotRange->{{-4,4},{-4,4}}]&/@queens,4]],ImageSize->500]

Minumum number

pieces="      w   w                            w   w            w";

Display

Show[Graphics[ChessPieces[pieces,OutputFormat->"Display"],AspectRatio->Automatic,PlotRange->{{-4,4},{-4,4}}]]

Export as EPS

Show[Graphics[ChessPieces[pieces,OutputFormat->"EPS"],AspectRatio->Automatic,PlotRange->{{-4,4},{-4,4}}]]