A304118 Number of z-blobs with least common multiple n > 1.
0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 7, 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 1, 3, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 7, 1, 1, 1, 1
Offset: 1
Keywords
Examples
The a(60) = 7 z-blobs together with the corresponding multiset systems (see A112798, A302242) are the following. (60): {{1,1,2,3}} (12,30): {{1,1,2},{1,2,3}} (20,30): {{1,1,3},{1,2,3}} (6,15,20): {{1,2},{2,3},{1,1,3}} (10,12,15): {{1,3},{1,1,2},{2,3}} (12,15,20): {{1,1,2},{2,3},{1,1,3}} (12,20,30): {{1,1,2},{1,1,3},{1,2,3}} The a(120) = 14 z-blobs together with the corresponding multiset systems are the following. (120): {{1,1,1,2,3}} (24,30): {{1,1,1,2},{1,2,3}} (24,60): {{1,1,1,2},{1,1,2,3}} (30,40): {{1,2,3},{1,1,1,3}} (40,60): {{1,1,1,3},{1,1,2,3}} (6,15,40): {{1,2},{2,3},{1,1,1,3}} (10,15,24): {{1,3},{2,3},{1,1,1,2}} (12,15,40): {{1,1,2},{2,3},{1,1,1,3}} (12,30,40): {{1,1,2},{1,2,3},{1,1,1,3}} (15,20,24): {{2,3},{1,1,3},{1,1,1,2}} (15,24,40): {{2,3},{1,1,1,2},{1,1,1,3}} (20,24,30): {{1,1,3},{1,1,1,2},{1,2,3}} (24,30,40): {{1,1,1,2},{1,2,3},{1,1,1,3}} (24,40,60): {{1,1,1,2},{1,1,1,3},{1,1,2,3}}
Links
- Gus Wiseman, Every Clutter Is a Tree of Blobs, The Mathematica Journal, Vol. 19, 2017.
Crossrefs
Programs
-
Mathematica
zsm[s_]:=With[{c=Select[Tuples[Range[Length[s]],2],And[Less@@#,GCD@@s[[#]]]>1&]},If[c=={},s,zsm[Union[Append[Delete[s,List/@c[[1]]],LCM@@s[[c[[1]]]]]]]]]; zensity[s_]:=Total[(PrimeNu[#]-1&)/@s]-PrimeNu[LCM@@s]; zreeQ[s_]:=And[Length[s]>=2,zensity[s]==-1]; zlobQ[s_]:=Apply[And,Composition[Not,zreeQ]/@Apply[LCM,zptns[s],{2}]]; zswell[s_]:=Union[LCM@@@Select[Subsets[s],Length[zsm[#]]==1&]]; zkernels[s_]:=Table[Select[s,Divisible[w,#]&],{w,zswell[s]}]; zptns[s_]:=Select[stableSets[zkernels[s],Length[Intersection[#1,#2]]>0&],Union@@#==s&]; stableSets[u_,Q_]:=If[Length[u]==0,{{}},With[{w=First[u]},Join[stableSets[DeleteCases[u,w],Q],Prepend[#,w]&/@stableSets[DeleteCases[u,r_/;r==w||Q[r,w]||Q[w,r]],Q]]]]; Table[If[n==1,0,Length[Select[Rest[Subsets[Rest[Divisors[n]]]],And[zsm[#]=={n},Select[Tuples[#,2],UnsameQ@@#&&Divisible@@#&]=={},zlobQ[#]]&]]],{n,100}]
Comments