Re: How to check whether an infinite set is closed under addition?

*To*: mathgroup at smc.vnet.net*Subject*: [mg124388] Re: How to check whether an infinite set is closed under addition?*From*: David Bevan <david.bevan at pb.com>*Date*: Wed, 18 Jan 2012 05:58:28 -0500 (EST)*Delivered-to*: l-mathgroup@mail-archive0.wolfram.com

closedQ[base_]:=Module[{m=Most[base]},Complement[Select[Join[2 m,Plus@@@Subsets[m,{2}]],#<Last[base]&],m]=={}] closedQ2[base_]:=Module[{m=Most[base]},Complement[Select[DeleteDuplicates@Join[2 m,Plus@@@Subsets[m,{2}]],#<Last[base]&],m]=={}] closedQ@Range[2000] // Timing closedQ2@Range[2000] // Timing {4.375, True} {1.141, True} randomSet[n_,p_]:=Sort@RandomSample[Range[n],Floor[p n]] s=randomSet[4000,.5]; closedQ@s//Timing closedQ2@s//Timing {4.438,False} {1.125,False} ________________________________________ From: David Bevan [david.bevan at pb.com] Sent: 17 January 2012 11:00 To: mathgroup at smc.vnet.net Subject: [mg124388] Re: How to check whether an infinite set is closed under addition? It is only necessary to explicitly test that 2*a_i is in the set. Assuming base is sorted, I think I'd use: closedQ[base_] := Module[{m = Most[base]}, Complement[Select[Join[2 m, Plus @@@ Subsets[m, {2}]], # < Last[base] &], m] == {}] (I've made some other optimisations / simplifications too.) Replacing Join[] with DeleteDuplicates@Join[] may be faster, depending on the data. David %^> > test1Q[base_] := > Module[{b = Flatten[Table[# i, {i, Last[base]/#}] & /@ base]}, > Complement[b, base] == {}] > > The second test is the original one: > > test2Q[base_List] := > Complement[ > Select[Total[Subsets[Most[base], {2}], {2}], # <= Last[base] &], > base] == {} > > Now we define closedQ: > > closedQ[base_List] := test1Q[base] && test2Q[base]