Triple-Free Set

Author

Eric W. Weisstein
March 4, 2009

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/Triple-FreeSet.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Triple-FreeSet.html.

©2009 Wolfram Research, Inc. except for portions noted otherwise

Initialization

<<Combinatorica`

Code

WeaklyTripleFreeQ[l_List]:=Switch[Length[l],
3,l/(GCD@@l)=!=Range[3],
_?(#<3)&,True,
_,(#/(GCD@@#)=!=Range[3])&/@(And@@Subsets[l,{3}])
]

StronglyTripleFreeQ[l_List]:=(Intersection[Union[2l,3l],l]=={})

Weakly Triple-Free

3

Sort[Select[Subsets[3],WeaklyTripleFreeQ]]

Complement[Subsets[3],%]

4

Sort[Select[Subsets[4],WeaklyTripleFreeQ]]

Complement[Subsets[4],%]

5

Sort[Select[Subsets[5],WeaklyTripleFreeQ]]

Complement[Subsets[5],%]

6

Sort[Select[Subsets[6],WeaklyTripleFreeQ]]

Complement[Subsets[6],%]

Counts

(c=Table[Count[Subsets[n],_?WeaklyTripleFreeQ],{n,0,15}])//Timing

FindSequenceFunction[c={1,2,4,7,14,28,50,100,200,360,720,1440,2560}]//Timing

FindGeneratingFunction[c,x]//Timing

FindLinearRecurrence[c]//Timing

Maximum Caridnality

(m=Table[Max[Length/@Select[Subsets[n],WeaklyTripleFreeQ]],{n,16}])//Timing

m={1,2,2,3,4,5,6,7,7,8,9,10,11,12,12,13,14,14,15,16,16,17,18,19,20,21,21,22,23,24,25,26,26,27,28,29,30,31,31,32,33,34,35,36,36,37,38,39,40,41,41,42,43,43,44,45,45,46,47,48,49,50,50,51,52,53,54,55,55,56,57,58,59};

pf=MapIndexed[#1/#2[[1]]&,m]//N

g1=ListLinePlot[pf,Joined->True,AxesLabel->{n,Style[p[n],Red]},PlotStyle->Red]

Strongly Triple-Free

3

Sort[Select[Subsets[3],StronglyTripleFreeQ]]

Complement[Subsets[3],%]

4

Sort[Select[Subsets[4],StronglyTripleFreeQ]]

Complement[Subsets[4],%]

5

Sort[Select[Subsets[5],StronglyTripleFreeQ]]

Complement[Subsets[5],%]

Counts

Table[Count[Subsets[n],_?StronglyTripleFreeQ],{n,0,10}]//Timing

c={1,2,3,5,8,16,24,48,76,132,198,396,588,1176,1764,2940,4680,9360,13680,27360,43776,72960,109440,218880,330240,660480,990720,1693440,2709504,5419008,8128512,16257024,25823232,43038720,64558080,129116160};

FindSequenceFunction[c]//Timing

FindGeneratingFunction[c,x]//Timing

FindLinearRecurrence[c]//Timing

Maximum Caridnality

(m=Table[Max[Length/@Select[Subsets[n],StronglyTripleFreeQ]],{n,16}])//Timing

m={1,1,2,2,3,4,5,5,6,6,7,7,8,8,9,10,11,11,12,12,13,13,14,15,16,16,16,16,17,18,19,20,21,21,22,22,23,23,24,24,25,26,27,27,28,28,29,30,31,31,32,32,33,33,34,34,35,35,36,36,37,37,38,39,40,41,42,42,43,43,44};

qf=MapIndexed[#1/#2[[1]]&,m]//N

g2=ListLinePlot[qf,Joined->True,AxesLabel->{n,Style[q[n],Blue]},PlotStyle->Blue]

Combined Plot

ListLinePlot[{pf,qf},Joined->True,AxesLabel->{n,{Style[p[n]/n,Red],Style[q[n]/n,Blue]}},PlotStyle->{Red,Blue},ImageSize->300,Epilog->{Opacity[.3],Red,Line[{{0,.8},{100,.8}}],Blue,Line[{{0,0.6134752692},{100,0.6134752692}}]}]