Heisenberg group

HeisenbergGroupCayleyGraph[mod_Integer]:=Module[{heisen3,vec,vac},heisen3=Sort[{{1,#[[1]],#[[2]]},{0,1,#[[3]]},{0,0,1}}&/@Tuples[Range[0,mod-1],{3}]];​​vec=Select[heisen3,Total[Flatten[#]]4&];​​he=Union[Sort[Flatten[Position[heisen3,#]&/@#]]&/@Flatten[Table[{#,Mod[#.vec[[v]],mod]}&/@heisen3,{v,1,3}],1]];​​vac=Union[Flatten[he,1]];​​Graph3D[UndirectedEdge@@@he,VertexCoordinatesThread[vacvec]]]
In[]:=
HeisenbergGroupCayleyGraph[mod_Integer]:=Module[{heisen3,vec,vac,heisen3edge},heisen3=Sort[{{1,#[[1]],#[[2]]},{0,1,#[[3]]},{0,0,1}}&/@Tuples[Range[0,mod-1],{3}]];​​vec=Select[heisen3,Total[Flatten[#]]4&];​​heisen3edge=Union[Sort[{#[[1,2]],#[[1,3]],#[[2,3]]}&/@#]&/@Flatten[Table[{#,Mod[#.vec[[v]],mod]}&/@heisen3,{v,1,3}],1]];​​vac=Union[Flatten[heisen3edge,1]];​​hg=Graph3D[UndirectedEdge@@@heisen3edge,VertexCoordinatesThread[vacvac]]]
In[]:=
mod=6;​​heisen3=Sort[{{1,#[[1]],#[[2]]},{0,1,#[[3]]},{0,0,1}}&/@Tuples[Range[0,mod-1],{3}]];​​vec=Select[heisen3,Total[Flatten[#]]4&];​​heisen3edge=Union[Sort[{#[[1,2]],#[[1,3]],#[[2,3]]}&/@#]&/@Flatten[Table[{#,Mod[#.vec[[v]],mod]}&/@heisen3,{v,1,3}],1]];​​vac=Union[Flatten[heisen3edge,1]];​​hg=Graph3D[UndirectedEdge@@@heisen3edge,VertexCoordinatesThread[vacvac]]
In[]:=
Out[]=
HeisenbergGroupCayleyGraph[3]
In[]:=
Out[]=
GraphNeighborhoodVolumes[#,{1}]&[HeisenbergGroupCayleyGraph[6]]
In[]:=
1{1,7,29,80,164,210,216}
Out[]=
GraphNeighborhoodVolumes[#,{1}]&[HeisenbergGroupCayleyGraph[20]]
In[]:=
1{1,7,29,83,189,379,697,1199,1953,3003,4026,4978,5740,6300,6780,7180,7500,7740,7900,7980,8000}
Out[]=
First[Values[%]]
In[]:=
{1,7,29,83,189,379,697,1199,1953,3003,4026,4978,5740,6300,6780,7180,7500,7740,7900,7980,8000}
Out[]=
Table[GraphNeighborhoodVolumes[#,{1}]&[HeisenbergGroupCayleyGraph[n]],{n,25}]
In[]:=
Part
:Part 1 of {} does not exist.
Part
:Part 2 of {} does not exist.
Part
:Part 3 of {} does not exist.
General
:Further output of Part::partw will be suppressed during this calculation.
Out[]=
Differences[{1,7,29,83,189,379,697,1199,1953,3039},4]
In[]:=
{4,12,12,12,12,12}
Out[]=
FindSequenceFunction[{7,29,83,189,379,697,1199,1953,3039},n]
In[]:=
1
6
(54-86n+81
2
n
-10
3
n
+3
4
n
)
Out[]=
%204/.nn-1
In[]:=
1
6
(54-86(-1+n)+81
2
(-1+n)
-10
3
(-1+n)
+3
4
(-1+n)
)
Out[]=
Expand[%]
In[]:=
39-
145n
3
+
43
2
n
2
-
11
3
n
3
+
4
n
2
Out[]=
Table[%,{n,10}]
In[]:=
{9,7,29,83,189,379,697,1199,1953,3039}
Out[]=
First/@Values[Rest[%198]]
In[]:=
Out[]=
ListLogLogPlot[%]
In[]:=
Out[]=
mod=6;​​heisen3=Sort[{{1,#[[1]],#[[2]]},{0,1,#[[3]]},{0,0,1}}&/@Tuples[Range[0,mod-1],{3}]];​​vec=Select[heisen3,Total[Flatten[#]]4&];​​heisen3edge=Union[Sort[{#[[1,2]],#[[1,3]],#[[2,3]]}&/@#]&/@Flatten[Table[{#,Mod[#.vec[[v]],mod]}&/@heisen3,{v,1,3}],1]];​​vac=Union[Flatten[heisen3edge,1]];​​hg=Graph3D[UndirectedEdge@@@heisen3edge,VertexCoordinatesThread[vacvac]]
In[]:=
Out[]=
CayleyGraph[SymmetricGroup[4]]
In[]:=
Out[]=