|
%I #20 Jan 26 2024 10:14:31
%S 84,2000,205920,39187952,21856506798,32510786132592,124523589644006520
%N Number of maximal matchings in the n X n torus grid graph.
%H Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/Matching.html">Matching</a>
%H Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/MaximalIndependentEdgeSet.html">Maximal Independent Edge Set</a>
%H Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/TorusGridGraph.html">Torus Grid Graph</a>
%t a[n_] := Module[{maxCycle, addition, basis, compatibleQ},
%t maxCycle =
%t Select[Tuples[{0, 1}, n],
%t And[#*RotateRight[#] == ConstantArray[0, n],
%t AllTrue[# + RotateRight[#] + RotateLeft[#], # > 0 &]] &];
%t addition[s_] :=
%t With[{G =
%t RelationGraph[And[#1 != #2, AllTrue[#1 - #2, NonNegative]] &,
%t DeleteDuplicates[
%t Map[
%t ReplacePart[#,
%t Map[Rule[#, 0] &,
%t Complement[Range[n],
%t Flatten[Position[s + RotateLeft[s], 0]]]]] &,
%t maxCycle]]]},
%t Map[{s, #} &, Pick[VertexList[G], VertexInDegree[G], 0]]
%t ];
%t basis = Flatten[Map[addition, Tuples[{0, 1, 2}, n]], 1];
%t compatibleQ[{s_, t_}, {p_, q_}] :=
%t And[Position[s, 2] == Position[p, 1],
%t AllTrue[
%t t + RotateRight[t] + q + RotateRight[q] + s + p, # > 0 &]];
%t Tr[MatrixPower[
%t SparseArray[
%t Table[
%t Boole[compatibleQ[tup1, tup2]], {tup1, basis}, {tup2, basis}]],
%t n]]
%t ];
%t Table[a[n], {n, 3, 6}] (* _Pjotr Buys_, Jul 06 2023 *)
%t Table[Length@FindIndependentVertexSet[LineGraph@GraphProduct[CycleGraph[n], CycleGraph[n], "Cartesian"], Infinity, All], {n, 3, 5}] (* _Eric W. Weisstein_, Jan 25 2024 *)
%K nonn,more
%O 3,1
%A _Eric W. Weisstein_, Dec 30 2017
%E a(6) from _Andrew Howroyd_, Dec 30 2017
%E a(7) from _Pontus von Brömssen_, Dec 31 2022
%E a(8)-a(9) from _Pjotr Buys_, Jul 06 2023
|
