1
$\begingroup$

I've been using the built-ins HypercubeGraph[n] and TuranGraph[2 n, n] to explore properties of the $1$-skeletons of the $n$-hypercube and $n$-orthoplex, respectively. I'd like to expand this search to the $n$-demihypercube (a.k.a. the halved cube). Is there a built-in for the demihypercube graph? Or is there a sensible way to modify the HypercubeGraph to get the demihypercube graph?

If we think of the hypercube as being the convex hull of $\{0,1\}^n$, the demihypercube is the convex hull of $$\{(b_1, b_2, \dots, b_n) \in \{0, 1\}^n \mid b_1 + b_2 + \dots + b_n \text{ is even} \}.$$


(I'm a quite new Mathematica user—mostly I just use built-ins to compute simple things for the On-Line Encyclopedia of Integer Sequences.)

$\endgroup$
3
  • 2
    $\begingroup$ I think this is a very interesting question; I'm willing to offer a 100 rep bounty to anyone who can answer this. $\endgroup$
    – J. M.'s torpor
    Apr 25 '20 at 2:26
  • $\begingroup$ This link may be helpful: mathworld.wolfram.com/HalvedCubeGraph.html $\endgroup$ Apr 25 '20 at 16:25
  • $\begingroup$ According to MathWorld, you could just do DemicubeGraph[n_Integer?Positive] := GraphPower[HypercubeGraph[n - 1], 2], then. $\endgroup$
    – J. M.'s torpor
    Apr 25 '20 at 16:30
1
$\begingroup$

Somewhat anticlimactically, it turns out the corresponding notebook in the MathWorld entry already shows a lot of ways.

For instance, "HalvedCube" is already known to GraphData[]:

Table[GraphData[{"HalvedCube", k}], {k, 7}] // GraphicsRow

demicube graphs

Otherwise, there are a bunch of alternative definitions, e.g.

DemicubeGraph[n_Integer?Positive] := GraphPower[HypercubeGraph[n - 1], 2]

DemicubeGraph[5]

5-demicube graph

IsomorphicGraphQ[%, GraphComplement[GraphData["ClebschGraph"]]]
   True

or

HalvedCubeGraph[n_, opts___] := Module[{dom = Tuples[{0, 1}, {n - 1}], edges},
      edges = UndirectedEdge @@@ Select[Flatten[Table[{i, j}, {i, 2^(n - 1)},
                                                      {j, i, 2^(n - 1)}], 1],
                                        0 < HammingDistance @@ dom[[#]] <= 2 &];
      Graph[Range[2^(n - 1)], edges, opts]]

HalvedCubeGraph[4]

4-demicube graph

IsomorphicGraphQ[%, GraphData["SixteenCellGraph"]]
   True
$\endgroup$
1
  • $\begingroup$ Perhaps anticlimactic, but it's just what I was looking for. Thanks! $\endgroup$ Apr 26 '20 at 0:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.