(*********************************************************************** This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialization Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) BeginPackage["`HadamardSearch`"] HadamardSearch::usage="HadamardSearch[PR,M2,M3,F1,F2,method] searches for cocyclic Hadamard matrices over a finite group G of group law given by the square matrix PR. The notebook will assume the ordering implicit in PR for the elements in G. Special care must be taken so that the first element in G is the identity element. The search may be both exhaustive and heuristic, depending on whether method=1 or method !=1. The matrices M2 and M3 represent the differentials d2 and d3 on the homological model hG. The matrices F1 and F2 represent the projection maps from B_1(Z[G]) to hG_1 and B_2(Z[G]) to hG_2, respectively. Let denote the number of elements in G by _order_ (=Length[PR]). The _order_ elements in B_1(Z[G]) are ordered following the natural ordering induced by PR. The _order_^2 elements in B_2(Z[G]) are ordered as the elements of G x G, from the first row to the last one, from left to the right, as {1,1},{1,2},...,{1,_order_},{2,1},...,{2,_order_},...,{_order_,1},...{_order_,_order_}. Of course, the same basis for hG at each degree must be used for M2,M3,F1 and F2. There is an explicit example included as a comment at the end of the package." Begin["`Private`"] {$Context,$ContextPath} (* We use the IntegerSmithNormalForm package due to V. Alvarez et al, 2006. *) M[i_,j_,t_,k_]:=ReplacePart[IdentityMatrix[k],t,{i,j}]; T[i_,j_,k_]:= Module[{m,n},m=IdentityMatrix[k];n=m[[i]];m[[i]]=m[[j]];m[[j]]=n;m]; Completar[C_,m_,n_]:= Module[{k,i,j,ii},i=m-Length[C];k={}; Do[k=Append[k,Table[0,{ii,1,n}]],{j,1,i}]; Do[k=Append[k,Join[Table[0,{ii,1,n-Length[C[[1]]]}],C[[j]]]],{j,1, Length[C]}];k]; ExtendedSmithForm[A_]:= Module[{k,C,coli,colj,P,Q,m,n,H,i,it,control},m=Length[A]; n=Length[A[[1]]];P={IdentityMatrix[m]};Q={IdentityMatrix[n]};C=A;i=1; Fin=Max[Abs[Take[C,{i,m},{i,n}]]]>0; While[ Fin,{coli,colj}= Position[Completar[Take[Abs[C],{i,m},{i,n}],m,n], Min[Select[Flatten[Take[Abs[C],{i,m},{i,n}]],#1>0&]]][[1]]; P=Prepend[P,T[i,coli,m]];Q=Append[Q,T[i,colj,n]];it=i+1; C=First[P].C.Last[Q];control=True; While[it\[LessEqual]n, If[IntegerQ[C[[i,it]]/C[[i,i]]],it=it+1, Q=Append[Q,M[i,it,-Quotient[C[[i,it]],C[[i,i]]],n].T[it,i,n]]; C=C.Last[Q];control=False;it=n+1] ]; If[control, Do[Q=Append[Q,M[i,it,-C[[i,it]]/C[[i,i]],n]]; C=C.Last[Q],{it,i+1,n}];it=i+1; While[it\[LessEqual]m, If[IntegerQ[C[[it,i]]/C[[i,i]]],it=it+1, P=Prepend[P,T[it,i,m].M[it,i,-Quotient[C[[it,i]],C[[i,i]]],m]]; C=First[P].C;control=False;it=m+1] ]; If[control, Do[P=Prepend[P,M[it,i,-C[[it,i]]/C[[i,i]],m]]; C=First[P].C,{it,i+1,m}]; Catch[Do[ Do[If[IntegerQ[C[[coli,colj]]/C[[i,i]]],Null, P=Prepend[P,M[i,coli,1,m]];C=First[P].C;control=False; Throw[False]],{colj,i+1,n}],{coli,i+1,m}];Throw[True]]; If[ control,P=Prepend[P,M[i,i,Sign[C[[i,i]]],m]];C=First[P].C; i=i+1;Fin=Max[Abs[Take[C,{i,m},{i,n}]]]>0] ]; ]; ]; P=Fold[Dot,IdentityMatrix[m],P]; Q=Fold[Dot,IdentityMatrix[n],Q];{C,{P,Q}} ]; (* *) (* Auxiliary functions for constructing a basis for representative 2- cocycles coming from inflation. *) matrizdeunos[n_]:=Table[Table[1,{j,n}],{i,n}]; matriznegaciclica[n_]:= Table[Join[Table[1,{j1,n+1-j}],Table[-1,{j2,n+2-j,n}]],{j,n}]; kronunosaizq[a_,n_]:= Flatten[Table[ Table[Apply[Join,Table[Table[a[[i,k]],{k2,n}],{k,Length[a[[1]]]}]],{j, n}],{i,Length[a[[1]]]}],1]; kronunosader[a_,n_]:= Flatten[Table[ Table[Apply[Join,Table[a[[j]],{k,n}]],{j,Length[a[[1]]]}],{i,n}],1]; (* Cocyclic Hadamard Test. *) testhadamard[L_]:= Catch[ Do[If[Apply[Plus,L[[i]]]\[NotEqual]0,Throw[False]],{i,2,Length[L]}]; Throw[True]]; (* Hadamard pointwise product. *) prodhadamard[a_,b_]:= Table[Table[a[[i,j]]*b[[i,j]],{j,Length[a[[1]]]}],{i,Length[a[[1]]]}]; (* Main program *) HadamardSearch[PR_,M2_,M3_,F1_,F2_,method_]:=Module[{}, (* Calculating H1 and H2. *) (* b1 and b2 denote the number of generators in the homological model \ at degrees 1 and 2, respectively. *) fnsa1=ExtendedSmithForm[M2];b1=Length[M2[[1]]];b2=Length[M2]; abelianizado=Select[Table[fnsa1[[1,ji,ji]],{ji,b1}],#1>0&]; b1=b2;b2=Length[M3]; fnsa2=ExtendedSmithForm[M3]; homologia=Select[Table[fnsa2[[1,ji,ji]],{ji,b1}],#1>0&]; (* Constructing a basis _base2cociclos_ for normalized 2-cocycles. *) base2cociclos={}; Print["Calculating a basis for 2-coboundaries..."]; (* Constructing a basis for 2-coboundaries. *) orden=Length[PR]; cobordes= Table[Apply[Join, Table[Table[ Mod[KroneckerDelta[i,k]+KroneckerDelta[i,j]+ KroneckerDelta[i,PR[[k,j]]],2],{j,orden}],{k,orden}]],{i, 2,orden}]; m=cobordes;gen={}; i=0; While[i