On[Assert];

Nps = {1,1,6,1,1};
dim = 2*Length[Nps]-2;
n = dim/2;
NFP = Plus@@Nps;
Assert[Length[Nps] == dim/2+1];
Assert[Plus @@ Nps == NFP];
Assert[Nps == Reverse[Nps]];
vertexCoordinates = {};
For[i = 1, i ≤ Length[Nps], ++i,
	For[j = 1, j≤Nps[[i]], ++j,

	AppendTo[vertexCoordinates, {j-(Nps[[i]])/2,i}]; 
];
];

If[dim == 8,
If[NFP == 10,
		vertexCoordinates = {{0,0},{1,1},{2,2},{3,3},{4,4},{4,5},{3,6},{2,7},{1,8},{0,9}};]
;];
d = dim/2;
cardI = NFP*dim/4;

liaux=Table[Select[ Flatten[Permutations /@ IntegerPartitions[If[i≤2,d-i,If[i==3||i==4||i==5||i==6,2,d-i+5]], {NFP}, Table[j, {j, 0, If[i≤2,d-i,If[i==3||i==4||i==5||i==6,2,d-i+5]]}]], 1], #[[1]] == 0 && If[i≠0,#[[2]] == 0,#[[2]]==1 ] && #[[3]]≤2&&  #[[4]]≤2 && #[[5]]≤2  && #[[6]]≤2 && #[[7]]≤2&& #[[8]]≤2&& #[[9]]≤3 && #[[10]]≤4 && 
If[i==3, #[[3]]==0,True] && If[i==4, #[[4]]==0 && #[[3]]==0,True] && If[i==5, #[[5]]==0 &&  #[[4]]==0 &&  #[[3]]==0 ,True]&& If[i==6, #[[6]]==0 &&#[[5]]==0 &&  #[[4]]==0 &&  #[[3]]==0 ,True]&& If[i==7, #[[7]]==0 && #[[6]]==0 &&#[[5]]==0 &&  #[[4]]==0 &&  #[[3]]==0 ,True]  && If[i==8, #[[10]]==1  ,True]
&& #[[i + 1]] == 0 &] , {i, 0, 9}];

k=1;

lf={};
dets = {};
Bs={};
Monitor[

While[k≤Length[liaux[[1]]],
liaux2=ReplacePart[liaux,1->{liaux[[1]][[k]]}];

k2=1;
lf={};
Monitor[

While[k2≤Length[liaux[[2]]],
liaux3=ReplacePart[liaux2,2->{liaux2[[2]][[k2]]}];
    li=Tuples[liaux3];

 AppendTo[lf,Select[li, Total[#]==Table[If[i≤2,i,If[i≠9,Floor[(i+7)/5],4]],{i,0,9}]&]];
 lf=Flatten[lf,1]; 

p=1; 
While[p≤ Length[lf], 
 e=Array[0&,{cardI,2}];
 index = 1;
j=1;
While[j≤ NFP, 
r=1;
While[r≤ NFP, 
entry=lf[[p]][[j]][[r]];
s=1;
While[ s≤ entry,
e[[index]][[1]]=j;
e[[index]][[2]]=r;
++index;
++s
];
r=r+1];
j=j+1];

 
deltai=Array[0&,{cardI,cardI}];
deltat=Array[0&,{cardI,cardI}];

(* Matrices A: A[[p]] is the matrix A for the p-th multigraph of "lff" *)

A=Array[0&,{cardI,cardI}];

h=1; 
While[h≤ cardI, 
m=1;
While[m≤ cardI, 
If[ e[[h]][[1]]==e[[m]][[1]] && e[[h]][[1]]≠ e[[m]][[2]] , deltai[[h]][[m]]=1];
If[ e[[h]][[1]]==e[[m]][[2]] && e[[h]][[1]]≠ e[[m]][[1]] , deltai[[h]][[m]]=-1];
If[ e[[h]][[2]]==e[[m]][[1]] && e[[h]][[2]]≠ e[[m]][[2]] , deltat[[h]][[m]]=1];
If[ e[[h]][[2]]==e[[m]][[2]] && e[[h]][[2]]≠ e[[m]][[1]] , deltat[[h]][[m]]=-1];
A[[h]][[m]]= deltai[[h]][[m]]-deltat[[h]][[m]];
      m=m+1];
h=h+1];
L=Array[2&, cardI]; B=A-DiagonalMatrix[L];
			ndet=Simplify[Det[B]];
			If[ndet==0,AppendTo[dets, lf[[p]]]; AppendTo[Bs,B]];
p=p+1];
lf={};
k2=k2+1];, ProgressIndicator[k2, {0, Length[liaux[[2]]]}]];

k=k+1];, ProgressIndicator[k, {0, Length[liaux[[1]]]}]]; 

Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","graphs.txt"}],dets];
Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","matrices.txt"}],Bs];

(* Avoinding repetitions obtained by reversing the flow *)

lff={}; 
matrices2={};
p=1;
Monitor[
While[p≤ Length[dets], 
Baux=dets[[p]]; 
Daux=Transpose[Table[Baux[[NFP-(i-1)]][[NFP-(j-1)]],{i,1,NFP},{j,1,NFP}]];If[Not[MemberQ[lff,Daux]],lff=Append[lff,Baux];matrices2=Append[matrices2,Bs[[p]]]];
p=p+1];, ProgressIndicator[p, {0, Length[dets]}]];
Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","graphs2.txt"}],lff];
Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","matrices2.txt"}],matrices2];

(* Part 3 - Sorting the matrices A according to their rank  *)

Print[];
Print["**************************************************************************"];
Print["Working with NNMs"];
Print["**************************************************************************"];

Matricestoprk={};
Matricessmallrk={}; 
lns={};

(* First we sort the matrices according to whether their rank is (cardI-1) or smaller and store them in the files "Matrices?toprk.txt" and "Matrices?smallrk.txt"; when the rank is cardI-1 we discard those that originate null spaces with no vectors with positive entries;when the rank is smaller than cardI-1 we discard those whose vectors have an entry equal to zero (they do not satisfy "test 2" below)*)

Print[];
Print["Sorting the Matrices according to their rank..."];

test2=Function[x,(Val=False;s=1;
While[s≤cardI,
t=1;
If[Not[Val],
Val=True; 
While[t≤Length[x],
Val=(Val&&(x[[t]][[s]]==0));
t=t+1]];
s=s+1];
Not[Val])];
Matricestoprk={};
Matricessmallrk={};
k=1; 
Monitor[
While[k≤ Length[lff],
            M=matrices2[[k]];
  lnsaux=NullSpace[M];
  If[MatrixRank[M]==cardI-1, 
        s=Flatten[lnsaux[[1]]];
      If[And@@(#1>0&)/@s||And@@(#1<0&)/@s,AppendTo[Matricestoprk,k]],
   If[test2[lnsaux],AppendTo[Matricessmallrk,k]]];AppendTo[lns,lnsaux]; 
k=k+1];, ProgressIndicator[k, {1, Length[lff]}]];
Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","Matrices_toprk.txt"}],Matricestoprk];
Export[FileNameJoin[{NotebookDirectory[],"graphsb2_1b4_6","Matrices_smallrk.txt"}],Matricessmallrk];
If[Length[Matricestoprk]==0&& Length[Matricessmallrk]==0,Print["There are no circle actions."]];