Unprotect[C,E];Clear[i,j];
B={{b,c,p},{g,h,p},{i3,f,p},{i2,e,p},{m,n,p},{i2,c,n,i1,g},{i1,h,m,b,i3},{i2,i3,a},{e,c,h,d},{a,e,f},{b,d,g,f}};
C={{a,b,c,m,n},{i1,i2,i3,d,e,f}};
T={{9,1},{10,1},{11,1}};
B=Map[ToString,B,{2}];C=Map[ToString,C,{2}];D0=Join[Subsets[B,{3}],Tuples[{B,C}]];LB=Length[B];LC=Length[C];S3=Binomial[Length[B],3];LD=S3+LB LC;D1=(Tally/@(Flatten/@D0))/.{p_,n_}->If[n>1,Splice[{p}~Join~Table[{p,i},{i,2,n}]],p];c3=Subsets[Range[LB],{3}];
multipntset[i_,j_]=Which[j<=S3,Flatten[{Table[Intersection[B[[c3[[j,Mod[v+1,3,1]]]]],B[[c3[[j,Mod[v-1,3,1]]]]],B[[c3[[i,w]]]]],{v,3},{w,3}],Table[Intersection[B[[c3[[i,Mod[v+1,3,1]]]]],B[[c3[[i,Mod[v-1,3,1]]]]],B[[c3[[j,w]]]]],{v,3},{w,3}]}],i<=S3,Flatten[{Table[If[MemberQ[T,{t,Mod[j-S3,LC,1]}],Splice[Intersection[B[[t]],C[[Mod[j-S3,LC,1]]]]],Nothing],{t,c3[[i]]}],Table[Intersection[B[[c3[[i,Mod[v+1,3,1]]]]],B[[c3[[i,Mod[v-1,3,1]]]]],#]&/@{C[[Mod[i-S3,LC,1]]],B[[Ceiling[(j-S3)/LC]]]},{v,3}]}],True,{If[MemberQ[T,{Ceiling[(i-S3)/LC],Mod[j-S3,LC,1]}],Splice[Intersection[B[[Ceiling[(i-S3)/LC]]],C[[Mod[j-S3,LC,1]]]]],Nothing],If[MemberQ[T,{Ceiling[(j-S3)/LC],Mod[i-S3,LC,1]}],Splice[Intersection[B[[Ceiling[(j-S3)/LC]]],C[[Mod[i-S3,LC,1]]]]],Nothing]}];
For[i=1;E={},i<=LD-2,i++,Di=D1[[i]];Di0=D0[[i]];For[j=i+1,j<=LD-1,j++,Dj=D1[[j]];Dj0=D0[[j]];intersec=Intersection[Di,Dj];mij=multipntset[i,j];If[DisjointQ[Di0,Dj0]&&Length[intersec]+Length[mij]>=9,For[k=j+1,k<=LD,k++,Dk=D1[[k]];Dk0=D0[[k]];If[DisjointQ[Di0,Dk0]&&DisjointQ[Dj0,Dk0]&&Length[Intersection[Dk,intersec]]+Length[Intersection[multipntset[i,j],multipntset[j,k]]]>=9,AppendTo[E,{Di0,Dj0,Dk0}]]]]]]
E
输出
{{{{b,c,p},{i2,c,n,i1,g},{i1,h,m,b,i3}},{{m,n,p},{e,c,h,d},{b,d,g,f}},{{g,h,p},{a,b,c,m,n}}},{{{i3,f,p},{i2,c,n,i1,g},{e,c,h,d}},{{i2,e,p},{i1,h,m,b,i3},{b,d,g,f}},{{g,h,p},{i1,i2,i3,d,e,f}}}} |
