Random connection matrix generator

M.P. Mello
e-mail: margarid .at. ime .dot. unicamp .dot. br

Reference:
Conley's spectral sequence via the sweeping algorithm
M.P. Mello, K. A. de Rezende, M. R. da Silveira

Random connection matrix generator

RandomConnectionMatrixGenerator=.
RandomConnectionMatrixGenerator[dimensions_Integer,OptionsPattern[{numberofblocks->3,seed->1234,range->20}]]:=Module[{n=dimensions,b=OptionValue[numberofblocks],Parar,particao,delta,upperleft,lowerright,indicesaaumentar,numunsporbloco,linproibnext,miolo,linhamin,linhamax,colmin,colmax,linproibnow,linhaspossiveis,colunaspossiveis,linsort,matmudabase,semente=OptionValue[seed],faixa=OptionValue[range],i,j,k,colhead,col,indMorse,colMorse},
Clear[miolo];
Parar=False;
SeedRandom[semente];
Print["Seed used = ", semente];If[OddQ[n],Parar=True;Print["Erro. Dimensão fornecida é ímpar."],If[n<4,Parar=True;Print["Erro. Dimensão fornecida é inferior a 4."]]];
If[!Parar,
particao=Table[2,{b+1}];
particao[[1]]=1;
indicesaaumentar=RandomInteger[b,n-3-2b];
particao=particao+BinCounts[indicesaaumentar,{0,b+1,1}];
(* Localizacao dos blocos *)
upperleft[1]={2,particao[[1]]+2};
lowerright[1]={particao[[1]]+1,particao[[1]]+1+particao[[2]]};
Do[upperleft[i]=lowerright[i-1]+{1,1};lowerright[i]= upperleft[i]+{particao[[i]]-1,particao[[i+1]]-1};
,{i,2,b}];
(* Calculando o numero de uns da matriz *)
numunsporbloco=Table[0,{b}];
numunsporbloco[[1]]=Min[particao[[1]],particao[[2]]];
Do[numunsporbloco[[i]] = Min[{particao[[i]]-numunsporbloco[[i-1]],particao[[i+1]]}],{i,2,b}];
linproibnext={};
miolo=Table[0,{n},{n}];
Do[{linhamin,linhamax}={upperleft[k][[1]],lowerright[k][[1]]};
{colmin,colmax}={upperleft[k][[2]],lowerright[k][[2]]};
linproibnow=linproibnext;
linhaspossiveis=Range[linhamin,linhamax];
colunaspossiveis=Range[colmin,colmax];
Do[linhaspossiveis=Cases[linhaspossiveis,Except[linproibnow[[i]]]],{i,1,Dimensions[linproibnow][[1]]}];
linproibnext=RandomSample[Range[colmin,colmax],numunsporbloco[[k]]];
linsort=RandomSample[linhaspossiveis,numunsporbloco[[k]]];
miolo=ReplacePart[miolo,1,Thread[{linsort,linproibnext}]];,{k,1,b}];
matmudabase=IdentityMatrix[n];
Do[Do[matmudabase[[j,j]]=(-1)^RandomInteger[{0,1}]*RandomInteger[{1,Floor[faixa*0.5]}];Do[matmudabase[[i,j]]=RandomInteger[BinomialDistribution[faixa,.5]]-Floor[faixa*0.5];,{i,upperleft[k][[2]],j-1}],{j,upperleft[k][[2]],lowerright[k][[2]]}],{k,1,b}];
delta=Inverse[matmudabase].miolo.matmudabase;
delta=LCM[Delete[ Union[Flatten[Denominator[delta]]],0]]*delta;
];
particao=Prepend[particao,0];
particao=Append[particao,0];
particao=Prepend[particao,1];
particao=Append[particao,1];
k=1;
Do[If[particao[[i]]*particao[[i+1]]≠0,
upperleft[k]={Sum[particao[[j]],{j,1,i-1}]+1,Sum[particao[[j]],{j,1,i}]+1};lowerright[k]=upperleft[k]+{particao[[i]]-1,particao[[i+1]]-1};k+=1],{i,1,Dimensions[particao][[1]]-1}];
(* Creating headers for each column of the initial matrix and building the vector "indMorse", whose i-th entry is the group to which the i-th column belongs. *)
colhead={};indMorse={};k=0;colMorse={1};
Do[If[particao[[i]]≠0,colMorse=Append[colMorse,colMorse[[-1]]+particao[[i]]];indMorse=Flatten[Append[indMorse,Table[i-1,{particao[[i]]}]]];colhead=Flatten[Append[colhead,Array[DisplayForm[SubsuperscriptBox["h",ToString[i-1],ToString[#]]]&,particao[[i]],k+1]]]];k+=particao[[i]],{i,1,Dimensions[particao][[1]]}];
Print[Show[Graphics[{{GrayLevel[.8],Table[Rectangle[{upperleft[i][[2]]-1,n-lowerright[i][[1]]},{lowerright[i][[2]],n+1-upperleft[i][[1]]}],{i,1,b}]},Table[Line[{{0,row},{n,row}}],{row,0,n}],Table[Line[{{col,0},{col,n}}],{col,0,n}],
Black,Table[{Text[colhead[[n+1-col]],{-1,col-.2},{1,1}],Text[colhead[[col]],{col-.5,n+1},{0,0}]},{col,1,n}],Table[Table[Text[Style[delta[[row,col]],Medium,Red,Bold],{col-.5,n+1-row-.5},{0,0}],{row,upperleft[k][[1]],lowerright[k][[1]]},{col,upperleft[k][[2]],lowerright[k][[2]]}],{k,1,b}],Thickness[.01]}],PlotRange->All,ImageSize->{600,500}]];
{delta,particao}
]