Pensieve header: Drawing the n-dimensional cube Q[n] and Hamilton circuits in it.

V[n_] := V[n] = StringJoin @@@ Tuples[{"0","1"},n];
V[3]

EE[n_] := Flatten[Table[
StringInsert[v,"*",k],
{v,V[n-1]}, {k,n}
]];
EE[3]

Q[n_] := Graph[
V[n],
Table[
StringReplace[ee,"*"->"0"]\[UndirectedEdge]StringReplace[ee, "*"->"1"],
{ee, EE[n]}
]
];
Q[1]

Q[2]

Q[3]

Q[4]

Q[5]

Q[6]

Q[7]

Q[8]

HC[2]={"00","01","11","10","00"};
HC[n_] := Module[{γ,γp, v},
γ=HC[n-1];
{(Subscript[v, 0]),(Subscript[v, 1])}=Take[γ, 2];
γp = Drop[γ, 1];
Join[(#<>"0")& /@ γp,(#<>"1")& /@ Reverse@γp, {(Subscript[v, 1])<>"0"}]
];
HC[3]

ShowHC[n_] := HighlightGraph[Q[n], UndirectedEdge@@@Partition[HC[n], 2,1]];
ShowHC[2]

ShowHC[3]

ShowHC[4]

ShowHC[5]

QQ[n_] := Graph[
V[n],
Table[
StringReplace[ee,"*"->"0"]\[UndirectedEdge]StringReplace[ee, "*"->"1"],
{ee, EE[n]}
],
EdgeStyle -> Black
];
QQ[4]