13
$\begingroup$

I'd like to draw hypercube projections like those on the Wikipedia page: 6-cube graph

I tried with 

HypercubeGraph[6]

but the graph does not look right; it is not symmetric, it is rotated by some degrees and some vertices that should be merged together (represented on the above figure with different colors) are not. Then I found the Wolfram MathWorld page that suggests GraphData might be helpful.

GraphData[{"Hypercube", 6}, "EdgeRules"];
Graph[%]

Produces a similar graph as HypercubeGraph but now it is more symmetric.

GraphData[{"Hypercube", 6}, "EdgeList"];
Graph[%]

Produces a different graph, even more symmetric but the vertices are obviously still not merged:

Mathematica graph

Since I'd like to draw several different hypercube graphs manually merging the vertices is not an option. What's the easiest way to draw symmetric hypercube graphs in Mathematica with some vertices merged like in the example from Wikipedia?

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ There isn't even the same number of vertices in the outer ring.., I'm afraid that Mathematica can't do better than that. $\endgroup$
    – Öskå
    Commented May 20, 2014 at 12:21
  • 1
    $\begingroup$ Can you explain more about how you need the vertices merged? $\endgroup$
    – Szabolcs
    Commented Oct 17, 2015 at 12:20

1 Answer 1

Reset to default
3
$\begingroup$

Perhaps the way GraphData works has changed in the last five years, but the code suggested by Mathworld, GraphData[{"Hypercube", n}], seems to work:

GraphicsRow@Table[GraphData[{"Hypercube", n}], {n, 6}]

enter image description here

With colors:

gg = GraphData[{"Hypercube", 6}];
vc = PropertyValue[gg, VertexCoordinates];
colors = {1 -> Red, 2 -> Orange, 4 -> Yellow, _Integer -> Automatic};
dupes = vc /. Counts@vc;
HighlightGraph[gg, MapIndexed[Reverse@*Style, dupes /. colors]]

enter image description here

(The option VertexSize fails to work on the graph gg. Maybe it's a bug.)

Improve this answer
$\endgroup$
3
  • $\begingroup$ Any idea how to generalize it for any n? Is there a simple formula for the projection matrix that produces this embedding? $\endgroup$
    – swish
    Commented Apr 12 at 22:26
  • 1
    $\begingroup$ @swish It's given by coordinates of points around a half-circle. I think this shows what you want: Block[{n = 8, projection}, projection = Table[{Cos[Pi t/n], Sin[Pi t/n]}, {t, 0, n - 1}]; Graphics[{ GraphicsComplex[ Tuples[{0, 1}, n] . projection, {Line[AdjacencyMatrix[HypercubeGraph[n]]["NonzeroPositions"]], Red, Point[Range[2^n]]} ]} ]] $\endgroup$
    – Michael E2
    Commented Apr 13 at 1:34
  • $\begingroup$ Perfect! Thanks, Michael! $\endgroup$
    – swish
    Commented Apr 13 at 1:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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