' The following is an Excel/VBA macro to compute terms from OEIS A201052. ' (It was written using Microsoft Office Excel 2007, but should run on ' some earlier versions as well.) ' ' One of the ways to run it is as follows: ' ' 1. Start Excel. ' ' 2. Press Alt+F11 to bring up a Microsoft Visual Basic window; ' from its menu bar, select View > Code (or hit F7). ' ' 3. Copy and paste the entire contents of this text file ' into the code window. ' ' 4. Click anywhere inside the macro (i.e., anywhere between the ' "Sub OEIS_A201052()" line and the "End Sub" line). ' ' 5. Hit the F5 key to start the macro. ' ' (To interrupt the macro at any time, hit Ctrl+Break.) ' ' ' Misc. notes: ' ' On my home computer (an old Pentium 4 CPU, 3.00 GHz), the macro computes ' all terms of A201052 up through n=44(n) in about 12 seconds, but takes ' about an hour to reach n=84. It looks as though it would probably ' take several months to reach n=161. (After finishing n=160, however -- ' assuming it would have found that a(160)=8 -- it would find a 9-integer ' set for n=161 almost instantly.) ' ' For at least some values of n at which a(n) > a(n-1), there exists more ' than one maximum-cardinality set of integers; e.g., a(4)=3, and both ' {1,2,4} and {2,3,4} are examples. The solution found by the macro at ' n = 1, 2, 4, 7, 13, 24, 44, and 84 (i.e., the values of n at which a(n) ' increases -- these are also the terms of A005318) has been exactly the ' set of integers in the corresponding row of A096858. ' '------------------------------------------------------------------------- ' This file was uploaded to the OEIS for access via a link on the page at ' https://oeis.org/A201052 ' by Jon E. Schoenfield, Dec 01 2013. '------------------------------------------------------------------------- Const nMax = 161 Sub OEIS_A201052() ' OEIS A201052: "a(n) is the maximal number c of integers that can be ' chosen from {1,2,...,n} so that all 2^c subsets have distinct sums." Dim n As Long, k As Long, j As Long, jOfst As Long, ij As Long, jj As Long Dim m As Long, jMaxUpdateScreen As Long, MaxNumDistinctSums As Long Dim sMax As Long, sTest As Long Dim a(nMax) As Long Dim bOK As Boolean a(1) = 1 Cells(1, 1).Value = 1 Cells(1, 2).Value = 1 Cells(1, 4).Value = 1 jMaxUpdateScreen = 3 ' search depth at which the screen is updated For n = 2 To nMax Cells(n, 1).Value = n DoEvents ' For each n>1, a(n)-a(n-1) must be 0 or 1: ' ' a(n)-a(n-1) cannot be less than 0; if a set of k integers ' could be chosen from the first n-1, then that same set of ' k integers could be chosen from the first n, so a(n) >= a(n-1). ' ' a(n)-a(n-1) cannot be greater than 1; if a set of k integers ' can be chosen from the first n, then, even if one of those ' integers is n, the remaining set of k-1 integers could be ' chosen from the first n-1, so a(n-1) >= a(n) - 1. ' ' Thus, if a(n-1)+1 integers can be chosen from the first n, ' then a(n)=a(n-1)+1; otherwise, a(n)=a(n-1). k = a(n - 1) + 1 ' number of integers to attempt to choose; ' if successful, then a(n) = k; ' else a(n) = a(n-1) = k-1. MaxNumDistinctSums = 2 ^ k ReDim s(MaxNumDistinctSums) As Long ' store subset sums in the order in which they're reached; s(0) = 0 ' s(0) is reached at initialization, ' before any integers are added to the set ' s(1) is reached when the 1st integer is placed ' s(2) and s(3) are reached when the 2nd integer is placed ' s(4) ... s(7) " " " " 3rd " " " ' ... ' s(2^(k-1)) ... s(2^k-1) when k-th integer is placed sMax = n * k - ((k - 1) * k) \ 2 ReDim bReached(0 To sMax) As Boolean ' bReached(s) is true iff the subset sum s has been reached bReached(0) = True ' subset sum 0 has been reached ReDim i(k) As Long ' i(j) will be the j-th largest integer ' in the set currently being tested ' If k integers could be chosen without choosing the integer n, then ' that same set of k intgers could have been chosen from the first ' a(n-1), but an exhaustive search found that that was impossible. ' Thus, we can limit the search for a set of k integers to those sets ' that include the integer n. j = 1 ' about to place the 1st integer into the set i(j) = n ' place n into the set s(j) = n bReached(n) = True ' subset sum n has been reached Cells(n, 4 + k - j).Value = i(j) DoEvents j = j + 1 ' try to place another integer into the set jOfst = 2 ^ (j - 1) ' (used in loop below) i(j) = i(j - 1) - 1 ' start with next smaller integer ' than the one just placed Do ' try to place i(j) as the jth largest integer ij = i(j) bOK = True ' init For jj = 0 To jOfst - 1 sTest = s(jj) + ij If bReached(sTest) Then ' this sum was already reached bOK = False Exit For Else s(jj + jOfst) = sTest End If Next jj If bOK Then ' no duplicate subset sums If j = k Then ' Value of a(n) found; ' all k integers have been placed For m = 1 To k Cells(n, 4 + k - m).Value = i(m) Next m DoEvents Exit Do Else ' jth integer placed successfully If j <= jMaxUpdateScreen Then Cells(n, 4 + k - j).Value = i(j) DoEvents End If ' update array bReached() For jj = jOfst To 2 * jOfst - 1 bReached(s(jj)) = True Next jj j = j + 1 ' try to place another integer into the set jOfst = 2 ^ (j - 1) i(j) = i(j - 1) - 1 ' start with next smaller integer ' than the one just placed End If Else ' a duplicate was encountered; ' i(j) won't work as the jth largest integer in the set Do While a(i(j) - 1) < k - (j - 1) ' Can't select k-(j-1) more from the integers 1 thru i(j)-1 If j <= jMaxUpdateScreen Then Cells(n, 4 + k - j).ClearContents DoEvents End If j = j - 1 ' back up If j <= 1 Then ' no k-integer set is possible Cells(n, 4 + k - j).ClearContents DoEvents Exit Do End If jOfst = 2 ^ (j - 1) ' update array bReached() For jj = jOfst To 2 * jOfst - 1 bReached(s(jj)) = False Next jj Loop If j <= 1 Then ' no k-integer set is possible Exit Do End If i(j) = i(j) - 1 ' try next lower integer End If Loop If j = k Then ' a k-integer set was found a(n) = k Else a(n) = k - 1 End If Cells(n, 2).Value = a(n) DoEvents Next n End Sub