独立な対称性クラスの個数計算

乗数系のカウント方法：
H^2 (Z_ 2^n, U (1) _ϕ) の計算と等価．
 c, ηは無関係である，ϕ = -1 なる元がひとつあると，再定義によって生成子全てをϕ = -1 にできる点に注意すると，結果はnとϕ = -1 なる元の有無にのみ依存する．
(n,ϕ=-1の有無)
(0,n/a): 1
(1,no): 1
(1,yes): 2
(2,no): 2（交換関係）
(2,yes): 2^2=4
(3,no): 2^3=8（12,23,31間の交換関係）
(3,yes): 2^4=16（TRS+PHS＋Uと思うと，U^2=1と固定して，T,Cとの交換関係）
(4,no): 2^6=64 (12,13,14,23,24,34間の交換関係)
(4,yes): 2^7=128 (例えば，TRS+PHS+U1+U2と思うと，U1^2=U2^2=1と固定して，それぞれT,Cとの交換関係とU1U2=±U2U1の符号)
-  一般に，ϕ=-1なる元が存在しなければ，Z_2^nのn個の生成子の独立な対の数だけ±1の乗数系が存在するから，2^(n(n-1)/2)個．
-  一般に，ϕ=-1なる元が存在する場合は，Z_2^nのn個の生成子の一つaを反ユニタリー，残りb_1,...,b_{n-1}の(n-1)個をユニタリーを思うと，(n-1)個のユニタリーから2^((n-1)(n-2)/2)個．(n-1)個のab_jの自乗の符号から2^(n-1)個．aの自乗の符号から2個．計2^((n-1)(n-2)/2+n-1+1) = 2^(n(n-1)/2+1)個．

- Z2ユニタリ対称性の存在を高々p個許す場合の条件は，n個の生成子に対する(ϕ,η,c)値からなるn×3行列のZ2体としてのランクがn-p以上という条件と等価であることに注意.
- Z2の生成子がn個存在する場合は，Z2ユニタリ対称性は少なくともn-3個存在するため，Z2ユニタリ対称性の存在を高々p個に制限すると，nの探索範囲はn≤p+3でよい．  
- GL(n,2)の基底変換による同一視は，n個の生成子に対するZ_2^3ベクトルのなすn×3行列に対してZ2体としての行基本変形により，標準形に取ることで判断できる．

- H -> iH による対称性クラスの同一視を考慮するには，g (H^(((Subscript[ϕ, g]),(Subscript[η, g]))))(g^(-1))=(Subscript[c, g])H  ->  g (((i H))^(((Subscript[ϕ, g]),(Subscript[η, g]))))(g^(-1))=(Subscript[ϕ, g])(Subscript[η, g])(Subscript[c, g])(i H) であるので，同一視は0,1表記で(ϕ,η,c) ~ (ϕ,η,ϕ+η+c).  これはn個の生成子に対するZ_2^3ベクトルのなすn×3行列に対して右から{{1,0,1},{0,1,1},{0,0,1}}行列をかけることに等しい．

- 変換 H -> iH は乗数系の同一視も引き起こすことに注意．例えば，生成子が{{1,0,0},{0,0,1}}の場合は，独立な乗数系は2^2個あるが，行基本変形により基底を{{1,0,0},{1,0,1}}と取ると，変換H->iHによって基底は{{1,0,0},{1,0,1}}->{{1,0,1},{1,0,0}}と入れ替わるため，非自明なZ2作用を引き起こす．一方で，{{0,0,0},{1,0,0}}の場合の変換先は{{0,0,0},{1,0,1}}であり，これは基底の変換でもとに戻らないため，既に前ステップで同一視が取られているため，新たにH^2(Z_2^2,U(1)_\phi)の同一視を引き起こさない．

（詳細はノートに）

numberFactorsystem[c_]:=Module[{n},n=Length[c];Which[c[[1,1]]==1(*反ユニタリを含む場合*),2^(n*(n-1)/2+1),c[[1,1]]==0(*反ユニタリを含まない場合*),2^(n*(n-1)/2)
]];

(*back up*)
(*
numberFactorsystemforeqbyiH[c_](*H->iHで等価な(ϕ,η,c)に対して，独立な乗数系のカウント*):=Module[{n,ιc,u,r,ιu,ιr,σ,pairs,configs,setιϵ,setϵ,numeqfactorsystem,δθ},
n=Length[c];
ιc=Mod[c.{{1,0,1},{0,1,1},{0,0,1}},2];
{u,r}=HermiteDecomposition[c];
{ιu,ιr}=HermiteDecomposition[ιc];
σ=Mod[Inverse[ιu,Modulus->2].u,2];
If[c[[1,1]]==0(*反ユニタリを含まない場合*),
(
(*ϵ不変量の列挙*)
pairs=Subsets[Range[n],{2}];
configs=Tuples[{0,1},Length[pairs]];
setϵ=Table[ϵ0=SparseArray[Join@@Table[If[v[[k]]==1,With[{i=pairs[[k,1]],j=pairs[[k,2]]},{{i,j}->1}(*上三角の(i,j)のみ*)],{}],{k,Length[pairs]}],{n,n}];ϵ0+ϵ0\[Transpose](*対称行列に*),{v,configs}];
setιϵ(*ϵ不変量のマップ*)=Table[Mod[σ.ϵ.σ\[Transpose],2],{ϵ,setϵ}];
numeqfactorsystem(*同値な乗数系の数*)=Length[Select[setϵ-setιϵ,Norm[#]>0&]]/2;
Return[numberFactorsystem[c]-numeqfactorsystem];
),
(*反ユニタリを含む場合*)(
(*ϵ不変量の列挙*)
pairs=Subsets[Range[n],{2}];
configs=Tuples[{0,1},Length[pairs]];
setϵ=Table[ϵ0=SparseArray[Join@@Table[If[v[[k]]==1,With[{i=pairs[[k,1]],j=pairs[[k,2]]},{{i,j}->1}(*上三角の(i,j)のみ*)],{}],{k,Length[pairs]}],{n,n}];Normal[ϵ0+ϵ0\[Transpose](*対称行列に*)],{v,configs}];
setθ={0,1};
setinv=Tuples[{setϵ,{0,1}}];
setιinv(*ϵ,θ不変量のマップ*)=Table[
ϵ=inv[[1]];θ=inv[[2]];
ϵ0=0*IdentityMatrix[n];
Do[ϵ0[[1,i]]=Mod[Sum[ϵ[[j,k]]*σ[[i,j]]*σ[[i,k]],{j,2,n-1},{k,j+1,n}]+Sum[ϵ[[1,k]]*σ[[i,k]],{k,2,n}]+Sum[ϵ[[j,k]]*σ[[1,j]]*σ[[i,k]],{j,2,n},{k,2,n}],2],{i,2,n}];Do[ϵ0[[i,k]]=Mod[Sum[ϵ[[j,l]]*σ[[i,j]]*σ[[k,l]],{j,2,n},{l,2,n}],2],{i,2,n-1},{k,i+1,n}];
{ϵ0+ϵ0\[Transpose](*対称行列に*),Mod[θ+Sum[ϵ[[1,k]]*σ[[1,k]],{k,2,n}]+Sum[ϵ[[j,k]]*σ[[1,j]]*σ[[1,k]],{j,2,n-1},{k,j+1,n}],2]}
,{inv,setinv}];
(*Print[{MatrixForm[c],{MatrixForm/@setinv[[All,1]],setinv[[All,2]]},{MatrixForm/@setιinv[[All,1]],setιinv[[All,2]]}}];*)
numeqfactorsystem(*同値な乗数系の数*)=Total[Table[If[setinv[[i]]==setιinv[[i]],0,1],{i,Length[setinv]}]]/2;
Return[Length[setinv]-numeqfactorsystem];
)
];
];
*)



numberFactorsystemforeqbyiH[c_]:=Module[{},
n=Length[c];
ιc=Mod[c.{{1,0,1},{0,1,1},{0,0,1}},2];
{u,r}=HermiteDecomposition[c];
{ιu,ιr}=HermiteDecomposition[ιc];
σ=Mod[Inverse[ιu,Modulus->2].u,2];
Which[c[[1,1]]==0(*反ユニタリを含まない場合*),
Which[n==1,Return[1],
n>1,
basis=Subsets[Range[n],{2}];
ιM=Table[{i,k}=ik;{j,l}=jl;Mod[σ[[i,j]]*σ[[k,l]]+σ[[i,l]]*σ[[k,j]],2],{ik,basis},{jl,basis}];
Return[1/2*(2^Length[ιM]+2^Length[NullSpace[Mod[IdentityMatrix[Length[ιM]]-ιM,2],Modulus->2]])];
],
c[[1,1]]==1(*反ユニタリを含む場合*),
Which[n==1,Return[2],
n==2,(
ιMik=Table[σ[[i,k]],{i,Range[2,n]},{k,Range[2,n]}];
ιMi1=Table[{0},{i,Range[2,n]}];
ιM1k={Table[σ[[1,k]],{k,Range[2,n]}]};
ιM11={{1}};
ιM=ArrayFlatten[{{ιMik,ιMi1},{ιM1k,ιM11}}];
Return[1/2*(2^Length[ιM]+2^Length[NullSpace[Mod[IdentityMatrix[Length[ιM]]-ιM,2],Modulus->2]])];
),
n>2,(
basis=Subsets[Range[2,n],{2}];
ιMikjl=Table[{i,k}=ik;{j,l}=jl;Mod[σ[[i,j]]*σ[[k,l]]+σ[[i,l]]*σ[[k,j]],2],{ik,basis},{jl,basis}];
ιMikk=Table[0,{ik,basis},{k,Range[2,n]}];
ιMik1=Table[{0},{ik,basis}];
ιMijl=Table[{j,l}=jl;Mod[σ[[i,j]]*σ[[i,l]]+σ[[1,j]]*σ[[i,l]]+σ[[1,l]]*σ[[i,j]],2],{i,Range[2,n]},{jl,basis}];
ιMik=Table[σ[[i,k]],{i,Range[2,n]},{k,Range[2,n]}];
ιMi1=Table[{0},{i,Range[2,n]}];
ιM1jl={Table[{j,l}=jl;Mod[σ[[1,j]]*σ[[1,l]],2],{jl,basis}]};
ιM1k={Table[σ[[1,k]],{k,Range[2,n]}]};
ιM11={{1}};
ιM=ArrayFlatten[{{ιMikjl,ιMikk,ιMik1},{ιMijl,ιMik,ιMi1},{ιM1jl,ιM1k,ιM11}}];
Return[1/2*(2^Length[ιM]+2^Length[NullSpace[Mod[IdentityMatrix[Length[ιM]]-ιM,2],Modulus->2]])];
)
];
];
];


(*back up*)
(*
countineqsymclass[p_,n_](*n,pを与えたときの独立な対称性クラスの数*):=Module[{},
(*Print["--------Z2の生成子の数： ",n,"Zユニタリー2対称性が高々",p,"個の場合--------"];*)
results={p,n};
If[n==0,Return[{p,0,1,0,1,0,1,0}];Break[]];
gen=Tuples[{0,1},3];
(*Z2^n の生成子に対する全ての (ϕ,η,c) の与え方*)
can=Tuples[gen,n];
(*行の permutation だけの重複を先に潰す*)
can=DeleteDuplicates[Sort/@can];
(*ランク条件：ユニタリーが高々 p 個→rank (mod 2)≥n-p*)
can=Select[can,MatrixRank[#,Modulus->2]≥n-p&];
(*GL(n,2) による基底変換同値を潰す：エルミート標準形を取る*)
can=Mod[HermiteDecomposition[#][[2]],2]&/@can;
can=DeleteDuplicates[can];
cancpx=Select[can,#[[1,1]]==0&](*複素*);
canreal=Select[can,#[[1,1]]==1&](*実*);
AppendTo[results,cancpx//Length];
AppendTo[results,canreal//Length];
AppendTo[results,numberFactorsystem/@cancpx//Total];
AppendTo[results,numberFactorsystem/@canreal//Total];
canonbyiH[c_]:=Mod[HermiteDecomposition[Mod[c.{{1,0,1},{0,1,1},{0,0,1}},2]][[2]],2];
canEqiH={};
canNonEqiH={};
While[Length[can]>0,
c=can[[1]];
ceq=canonbyiH[c];
If[c==ceq,
AppendTo[canEqiH,c];can=Complement[can,{c}];,
AppendTo[canNonEqiH,c];can=Complement[can,{c,ceq}];
];
];
canEqiHcpx=Select[canEqiH,#[[1,1]]==0&](*複素*);
canEqiHreal=Select[canEqiH,#[[1,1]]==1&](*実*);
canNonEqiHcpx=Select[canNonEqiH,#[[1,1]]==0&](*複素*);
canNonEqiHreal=Select[canNonEqiH,#[[1,1]]==1&](*実*);
AppendTo[results,(numberFactorsystemforeqbyiH/@canEqiHcpx//Total)+(numberFactorsystemforeqbyiH/@canNonEqiHcpx//Total)];
AppendTo[results,(numberFactorsystemforeqbyiH/@canEqiHreal//Total)+(numberFactorsystemforeqbyiH/@canNonEqiHreal//Total)];
(*Print["{p,n,#複素,#実,#複素w/乗数系,#実w/乗数系}:",results];*)
Return[results];
];
*)
Needs["Combinatorica`"]
countineqsymclass[p_,n_]:=Module[{results,gen8,comps,can,cancpx,canreal,canonbyiH,canEqiH,canNonEqiH,canEqiHcpx,canEqiHreal,canNonEqiHcpx,canNonEqiHreal,c,ceq},results={p,n};
If[n==0,Return[{p,0,1,0,1,0,1,0}]];
(*行ベクトルの種類は 8 通り={0,1}^3*)gen8=Tuples[{0,1},3];
(*長さ 8 の非負整数ベクトルで，合計が n のもの全て→各行タイプが何回出るかの多重度を表す*)comps=Compositions[n,Length[gen8]];
(*各 comp に対し，その多重度に従って行を並べた行列を作る。すでに行の permutation は潰れているので，ここで作る行列集合に重複はない。*)can=Table[With[{mult=comps[[t]]},Flatten[MapThread[ConstantArray,{gen8,mult}],1]],{t,Length[comps]}];
(*ランク条件：ユニタリーが高々 p 個→rank (mod 2)≥n-p*)can=Select[can,MatrixRank[#,Modulus->2]≥n-p&];
(*GL(n,2) による基底変換同値を潰す：HermiteDecomposition の右側行列を mod 2 で使う*)can=Mod[HermiteDecomposition[#][[2]],2]&/@can;
can=DeleteDuplicates[can];
(*先頭行の φ が 0 か 1 かで複素／実に分類*)cancpx=Select[can,#[[1,1]]==0&];(*複素*)canreal=Select[can,#[[1,1]]==1&];(*実*)AppendTo[results,Length[cancpx]];
AppendTo[results,Length[canreal]];
AppendTo[results,Total[numberFactorsystem/@cancpx]];
AppendTo[results,Total[numberFactorsystem/@canreal]];
(*(\phi,η,c)→(\phi,η,φ+η+c) による同一視*)canonbyiH[c_]:=Mod[HermiteDecomposition[Mod[c.{{1,0,1},{0,1,1},{0,0,1}},2]][[2]],2];
canEqiH={};
canNonEqiH={};
(*orbit サイズ≤2 の Z2 作用なので，While でペアを抜いていく*)While[Length[can]>0,c=First[can];
ceq=canonbyiH[c];
If[c===ceq,AppendTo[canEqiH,c];
can=Rest[can];,AppendTo[canNonEqiH,c];
can=Complement[can,{c,ceq}];];];
canEqiHcpx=Select[canEqiH,#[[1,1]]==0&];
canEqiHreal=Select[canEqiH,#[[1,1]]==1&];
canNonEqiHcpx=Select[canNonEqiH,#[[1,1]]==0&];
canNonEqiHreal=Select[canNonEqiH,#[[1,1]]==1&];
AppendTo[results,Total[numberFactorsystemforeqbyiH/@canEqiHcpx]+Total[numberFactorsystemforeqbyiH/@canNonEqiHcpx]];
AppendTo[results,Total[numberFactorsystemforeqbyiH/@canEqiHreal]+Total[numberFactorsystemforeqbyiH/@canNonEqiHreal]];
results]

計算結果とlatexに

toLaTex[data_]:=Module[{},(*各セルの表示：複素+実 を "c+r" だけにする*)formatCell[{c_,r_}]:=ToString[c]<>"+"<>ToString[r];
(*合計行のセル表示：c+r (=合計) にしておく例*)formatTotalCell[{c_,r_}]:=Module[{s=c+r},ToString[c]<>"+"<>ToString[r]<>" (= "<>ToString[s]<>")"];
(*もし単に c+r だけで良いなら上を formatTotalCell[{c_,r_}]:=ToString[c]<>"+"<>ToString[r];
に変えてください。*)(*各 N 行の TeX 行*)rowStrings=data//Map[Function[row,Module[{nn=row[[1]],cols=row[[2;;4]]},StringRiffle[Join[{StringTemplate["$N=``$"][nn]},formatCell/@cols]," & "]<>" \\\\"]]];
(*列ごとの合計（{複素,実}）*)colData=Transpose[data[[All,2;;4]]];(*3 列分*)sums=({Total[#[[All,1]]],Total[#[[All,2]]]}&)/@colData;
(*合計行*)totalRow=StringRiffle[Join[{"total"},formatTotalCell/@sums]," & "]<>" \\\\";
(*最終的な LaTeX tabular 全体*)texTable=StringRiffle[{"\\begin{table}","\\caption{$p="<>ToString[p]<>"$ (entries are complex+real)}",(*←こう書いておくと親切*)"\\begin{tabular}{c|c|c|c}","\\hline","$N$ & w/o factor system & w/ factor system & $H\\to iH$\\\\","\\hline",Sequence@@rowStrings,"\\hline",totalRow,"\\hline","\\end{tabular}","\\end{table}"},"\n"];
Print[texTable];];

Do[
tab=Table[tmp=countineqsymclass[p,n];{tmp[[2]],tmp[[{3,4}]],tmp[[{5,6}]],tmp[[{7,8}]]},{n,0,p+3}];
toLaTex[tab];
,{p,0,10}];

back up

Clear[numberFactorsystem]
numberFactorsystem[c_,n_]:=Which[MemberQ[c[[All,1]],1](*反ユニタリを含む場合*),Switch[n,1,2,2,2^2,3,2^4,4,2^7],¬MemberQ[c[[All,1]],1](*反ユニタリを含まない場合*),Switch[n,0,1,1,1,2,2,3,2^3,4,2^6]
];
p=1;
Print["-------Z2対称性の数が高々",p,"個の場合--------"];
Print["{n,独立な対称性型の数，乗数系の数}: "]
tmp={};
Do[
(*n(*生成子の数*)=2;*)
gen=Tuples[{0,1},3];
can(*Z_2^n の生成子に対する可能な全ての(ϕ,η,c)の与え方*)=Tuples[gen,n];
can(*ソートして，基底の入れ替えで移り変わるものを消す*)=DeleteDuplicates[Sort/@can];
(*ユニタリーは(0,0,0)．よってユニタリーが高々1個という条件は，n個の生成子に対する(ϕ,η,c)値からなるn×3行列のランクがn-1以上という条件*)
can=Select[can,MatrixRank[#]≥n-p& ];
(*Z_2^n の基底の再定義は，Z_2^nを張るだけのn個の元の選び方によって得られる*)
basischange=Complement[Select[Tuples[{0,1},{n,n}],MatrixRank[#]==n&],{IdentityMatrix[n]}];
l=1;While[Length[can]>l,
a=can[[l]];
eq=Table[Mod[Sum[basischange[[bc,k,i]]*a[[i]],{i,n}],2],{bc,Length[basischange]},{k,n}];
eq=Complement[Sort/@eq,{a}];
(*Print["a=",a,", eq=",eq];*)
can=Complement[can,eq];
(*Print[{l,a,can}];*)
(*If[Mod[l,10]==0,Print[can//Length]];*)
l++];
eqbyiH=Table[Table[{x[[1]],x[[2]],Mod[x[[1]]+x[[2]]+x[[3]],2]},{x,c}],{c,can}];
numofeqclassbyiH=Length[Select[can-eqbyiH,Norm[#]>0&]];
(*Print[MatrixForm/@can];*)
AppendTo[tmp,numberFactorsystem[#,n]&/@can//Total];
Print[{n,can//Length,numberFactorsystem[#,n]&/@can//Total}]
,{n,p+3}];
Print["独立な非エルミート対称性クラスの数: ",Total[tmp]+1(*n=0の1を足す*)]

(*さらに H -> iH による同一視を取る*)