AppendTo[$ContextPath,"FusionAtlas`TensorSolver`Private`"];

g[1]=g1;g[2]=g2;
Y[V[na_,0,1],V[na_,db_,kb_],V[na_,dc_,kc_]]:=If[db==dc∧kb==kc,1,0];
Y[V[na_,da_,ka_],V[nb_,0,1],V[na_,dc_,kc_]]/;(Mod[na+nb+da,2]==0):=If[da==dc∧ka==kc,1,0];
Y[V[na_,da_,ka_],V[nb_,1,1],V[na_,dc_,kc_]]/;(Mod[na+nb+da,2]==0):=
Switch[dc-da,
1,g[na][[da+1,kc,ka]],
-1,g[na][[da,ka,kc]],
_,0
];
Y[V[na_,da_,ka_],V[nb_,db_,kb_],V[nc_,dc_,kc_]]/;na≠nc:=0;
Y[V[na_,da_,ka_],V[nb_,db_,kb_],V[nc_,dc_,kc_]]/;(Mod[na+nb+da,2]≠0):=0;
Y[V[na_,da_,ka_],V[nb_,db_,kb_],V[nc_,dc_,kc_]]/;(Mod[nb+db+nc+dc,2]≠0):=0;
ZZ=Outer[Y,allModules[g1,g2],allModules[g1,g2],allModules[g1,g2]];

A[a_,b_,c_,d_]:=Sum[With[{z=allModules[g1,g2][[i]]},Y[a,z,d]Y[b,c,z]-Y[a,b,z]Y[z,c,d]],{i,1,Length[allModules[g1,g2]]}]

A[a_Integer,b_Integer,c_Integer,d_Integer]:=With[{m=allModules[g1,g2]},A[m[[a]],m[[b]],m[[c]],m[[d]]]]

dual[V[n_,d_,k_]]:=V[Mod[n+d+1,2]+1,d,k]

DD[a_,b_,c_]:=Y[a,b,c]-Y[dual[c],a,dual[b]]
DD[a_Integer,b_Integer,c_Integer]:=With[{m=allModules[g1,g2]},DD[m[[a]],m[[b]],m[[c]]]]

Outer[DD,Range[n],Range[n],Range[n]]

dimensions[g1,g2]

dimensions[g1_GradedBigraph,g2_GradedBigraph][V[n:(1|2),depth_,k_]]:=ReducedDimensionsByDepth[Switch[n,1,g1,2,g2]][[depth+1,k]]

deq=Union[DeleteCases[With[{d=dimensions[g1,g2]/@allModules[g1,g2]},
Thread[Flatten[ZZ.Flatten[d]]≤Flatten[Outer[0.001+dimensions[g1,g2][#1]dimensions[g1,g2][#2]&,allModules[g1,g2],allModules[g1,g2]]]]
],True]]

deq[[1]]

dualeqs=DeleteCases[Flatten[%],0]

eqs=dualeqs~Join~eqs;

n=Length[allModules[g1,g2]]

indices=Flatten[Outer[List,Range[2,17]~Join~Range[19,35],Range[2,17]~Join~Range[19,35],Range[2,17]~Join~Range[19,35],Range[n]],3];

Position[allModules[g1,g2],V[_,0,_]]

k=0;
eqs={};

takeMore[n_]:=(eqs=Union[eqs~Join~(A@@@Take[indices,{k+1,k+=n}])])

randomMore[n_]:=(eqs=Union[eqs~Join~(A@@@RandomSample[indices,n])])

While[Length[takeMore[200]]==1,Print[k]]

Cases[eqs,y_Y+n_Integer:>(y=Max[-n,0])]
Cases[eqs,-y_Y+n_Integer:>(y=Max[n,0])]

Cases[eqs,y_Y:>(y=0)]
Cases[eqs,-y_Y:>(y=0)]

Cases[eqs,y1_Y-y2_Y:>(y1=y2)]
Cases[Take[eqs,200],y1_Y+y2_Y:>(y1=-y2)]

eqs=Union[eqs];
eqs=SortBy[eqs,Length[Union[Cases[#,_Y,∞]]]&];

Length[eqs]

eqs=Simplify[eqs];

Take[eqs,10]//TableForm

Y[V[2,12,1],V[2,8,1],V[2,8,2]]=Y[V[2,12,1],V[2,8,2],V[2,8,1]];

Length[Solve[Take[eqs,2]==0,Cases[eqs,_Y,∞]]]

Solve[Take[eqs,3]==0,Cases[eqs,_Y,∞]]/.(x_->y_):>(x=y)

Length[Union[Cases[ZZ,_Y,∞]]]

remaining=Union[Cases[ZZ,_Y,∞]]

Length[remaining]

Union[Cases[ZZ,_Y,∞]]/.Y[a_,b_,c_]:>Floor[N[dimensions[g1,g2][a]dimensions[g1,g2][b]/dimensions[g1,g2][c]]]

remainingRules=Outer[Thread[remaining->List[##]]&,Range[0,8],Range[0,8],Range[0,2],Range[0,10],Range[0,1],Range[0,1],Range[0,1],Range[0,1],Range[0,1]];

remainingRules=Flatten[remainingRules,7];

remainingRules=Partition[remainingRules,11];

remainingRules[[1]]

Cases[remainingRules,rr_/;(And@@Thread[eqs==0]/.rr)]

rules=%1420

Length[rules]

eqs/.rules[[1]]

And@@deq/.rules

rules=Cases[rules,rr_/;Min[Union[Flatten[ZZ]/.rr]]≥0]

Cases[rules,v:(a_Integer->b_Integer):>(a==b),∞]

rules=(Union/@(DeleteCases[#,_Integer->_Integer]&/@rules))

Length[rules]

remaining/.rules//TableForm

ZZ/.rules[[1]]

Cases[rules,rr_/;And@@With[{zzz=ZZ/.rr},DeleteCases[Union[#==0&/@Flatten[zzz.zzz-Transpose[Transpose[zzz,{1,3,2}].Transpose[zzz,{2,3,1}],{1,4,2,3}]]],True]]]

Length[%]

allModules[g1,g2]

BifusionAlgebra[{g1,g2},ZZ/.#]&/@rules

Length[ZZ]

remaining[[6]]

Y[V[2,12,1],V[2,6,2],V[2,8,3]]=1;

remaining

9 9 3 12 32

Length[Cases[rules,rr_/;(And@@Thread[eqs==0]/.rr)]]

Range

Union[Cases[ZZ,_Y,∞]][[{-4,-1}]]

Y[V[2,12,1],V[2,8,1],V[2,8,3]]=0;
Y[V[2,12,1],V[2,12,1],V[2,6,2]]=0;

reduce[l_List]:=Module[{r},
r=Reduce[l==0];
If[Head[r]===And,
(List@@r)/.(a_==b_):>(a-b),
l
]
]

Clear[replace]

replace[n_]/;n≤Length[eqs]:=(eqs=reduce[Take[eqs,n]]~Join~Drop[eqs,n])

Length[eqs]

While[True,
randomMore[200];
takeMore[200];
Print["sorting...", Length[eqs]];
eqs=SortBy[Union[Simplify[eqs]],Length[Union[Cases[#,_Y,∞]]]&];
Cases[eqs,y_Y:>(y=0)];
Cases[eqs,-y_Y:>(y=0)];
Cases[eqs,y1_Y-y2_Y:>(y1=y2)];
(*Cases[eqs,y1_Y+y2_Y:>(y1=-y2)];*)
Print[Length[eqs]," ",Length[Union[Cases[ZZ,_Y,∞]]]," ",Tally[Length[Union[Cases[#,_Y,∞]]]&/@eqs]];
]

SetDebugMode[True];SetDebugQueueInterval[1.];

deq

FindMoreRules[Y,Thread[eqs==0],deq,{}]

Length[Flatten[ZZ]]

Reduce[Thread[Take[Flatten[ZZ],29200]≥0]]

Directory[]

Save["bifusion.m",Y]

Length[Union[Cases[ZZ,_Y,∞]]]

ind[v:V[1,_?EvenQ,_]]:=Position[Cases[allModules[g1,g2],V[1,_?EvenQ,_]],v][[1,1]]

ind/@Cases[allModules[g1,g2],V[1,_?EvenQ,_]]

Y[v1:V[1,_?EvenQ,_],v2:V[1,_?EvenQ,_],v3:V[1,_?EvenQ,_]]:=fusionRules[[ind[v1],ind[v2],ind[v3]]]

fusionRules={{{1,0,0,0,0,0,0,0,0,0},{0,1,0,0,0,0,0,0,0,0},{0,0,1,0,0,0,0,0,0,0},{0,0,0,1,0,0,0,0,0,0},{0,0,0,0,1,0,0,0,0,0},{0,0,0,0,0,1,0,0,0,0},{0,0,0,0,0,0,1,0,0,0},{0,0,0,0,0,0,0,1,0,0},{0,0,0,0,0,0,0,0,1,0},{0,0,0,0,0,0,0,0,0,1}},{{0,1,0,0,0,0,0,0,0,0},{1,1,1,0,0,0,0,0,0,0},{0,1,1,1,1,0,0,0,0,0},{0,0,1,1,1,1,1,0,0,0},{0,0,1,1,1,1,0,1,0,0},{0,0,0,1,1,1,1,1,0,0},{0,0,0,1,0,1,0,0,0,0},{0,0,0,0,1,1,0,1,1,0},{0,0,0,0,0,0,0,1,1,1},{0,0,0,0,0,0,0,0,1,0}},{{0,0,1,0,0,0,0,0,0,0},{0,1,1,1,1,0,0,0,0,0},{1,1,2,2,2,2,1,1,0,0},{0,1,2,3,3,3,1,2,0,0},{0,1,2,3,3,3,2,2,1,0},{0,0,2,3,3,3,1,2,1,0},{0,0,1,1,2,1,1,1,0,0},{0,0,1,2,2,2,1,2,1,1},{0,0,0,0,1,1,0,1,1,0},{0,0,0,0,0,0,0,1,0,0}},{{0,0,0,1,0,0,0,0,0,0},{0,0,1,1,1,1,1,0,0,0},{0,1,2,3,3,3,1,2,0,0},{1,1,3,4,4,4,2,3,1,0},{0,1,3,4,5,4,2,3,1,0},{0,1,3,4,4,4,2,3,1,1},{0,1,1,2,2,2,1,1,1,0},{0,0,2,3,3,3,1,2,1,0},{0,0,0,1,1,1,1,1,0,0},{0,0,0,0,0,1,0,0,0,0}},{{0,0,0,0,1,0,0,0,0,0},{0,0,1,1,1,1,0,1,0,0},{0,1,2,3,3,3,2,2,1,0},{0,1,3,4,5,4,2,3,1,0},{1,1,3,5,4,5,2,3,1,1},{0,1,3,4,5,4,2,3,1,0},{0,0,2,2,2,2,0,2,0,0},{0,1,2,3,3,3,2,2,1,0},{0,0,1,1,1,1,0,1,0,0},{0,0,0,0,1,0,0,0,0,0}},{{0,0,0,0,0,1,0,0,0,0},{0,0,0,1,1,1,1,1,0,0},{0,0,2,3,3,3,1,2,1,0},{0,1,3,4,4,4,2,3,1,1},{0,1,3,4,5,4,2,3,1,0},{1,1,3,4,4,4,2,3,1,0},{0,1,1,2,2,2,1,1,1,0},{0,1,2,3,3,3,1,2,0,0},{0,0,1,1,1,1,1,0,0,0},{0,0,0,1,0,0,0,0,0,0}},{{0,0,0,0,0,0,1,0,0,0},{0,0,0,1,0,1,0,0,0,0},{0,0,1,1,2,1,1,1,0,0},{0,1,1,2,2,2,1,1,1,0},{0,0,2,2,2,2,0,2,0,0},{0,1,1,2,2,2,1,1,1,0},{1,0,1,1,0,1,1,1,0,1},{0,0,1,1,2,1,1,1,0,0},{0,0,0,1,0,1,0,0,0,0},{0,0,0,0,0,0,1,0,0,0}},{{0,0,0,0,0,0,0,1,0,0},{0,0,0,0,1,1,0,1,1,0},{0,0,1,2,2,2,1,2,1,1},{0,0,2,3,3,3,1,2,1,0},{0,1,2,3,3,3,2,2,1,0},{0,1,2,3,3,3,1,2,0,0},{0,0,1,1,2,1,1,1,0,0},{1,1,2,2,2,2,1,1,0,0},{0,1,1,1,1,0,0,0,0,0},{0,0,1,0,0,0,0,0,0,0}},{{0,0,0,0,0,0,0,0,1,0},{0,0,0,0,0,0,0,1,1,1},{0,0,0,0,1,1,0,1,1,0},{0,0,0,1,1,1,1,1,0,0},{0,0,1,1,1,1,0,1,0,0},{0,0,1,1,1,1,1,0,0,0},{0,0,0,1,0,1,0,0,0,0},{0,1,1,1,1,0,0,0,0,0},{1,1,1,0,0,0,0,0,0,0},{0,1,0,0,0,0,0,0,0,0}},{{0,0,0,0,0,0,0,0,0,1},{0,0,0,0,0,0,0,0,1,0},{0,0,0,0,0,0,0,1,0,0},{0,0,0,0,0,1,0,0,0,0},{0,0,0,0,1,0,0,0,0,0},{0,0,0,1,0,0,0,0,0,0},{0,0,0,0,0,0,1,0,0,0},{0,0,1,0,0,0,0,0,0,0},{0,1,0,0,0,0,0,0,0,0},{1,0,0,0,0,0,0,0,0,0}}};

Cases[Union[Cases[ZZ,_Y,∞]],Y[V[1,_?EvenQ,_],V[1,_?EvenQ,_],_]]

Dynamic[k]

Solve[eqs==0,Union[Cases[eqs,_Y,∞]]]

takeMore[200];

eqs=SortBy[eqs,Count[#,_Y,∞]&];

Tally[Count[#,_Y,∞]&/@eqs]

Take[eqs,5]

FusionAtlas`TensorSolver`Private`V=V;

eq=DeleteCases[Union[#==0&/@Flatten[ZZ.ZZ-Transpose[Transpose[ZZ,{1,3,2}].Transpose[ZZ,{2,3,1}],{1,4,2,3}]]],True];

deq=Union[DeleteCases[With[{d=dimensions[g1,g2]/@allModules[g1,g2]},
Thread[Flatten[ZZ.Flatten[d]]≤Flatten[Outer[dimensions[g1,g2][#1]dimensions[g1,g2][#2]&,allModules[g1,g2],allModules[g1,g2]]]]
],True]];

w[v_V][u_V]:=If[v===u,1,0];
w[v_V][u_Plus]:=w[v]/@u;
w[v_V][α_?NumericQ u_]:=α w[v][u];
w[v_V][t[a_,b_]]:=Y[a,b,v];
tleq=Union[Flatten[TLEquations[g1,g2]/.(eq:(a_==b_):>Cases[eq,v_V:>w[v][a]==w[v][b],∞])]];