' The following is an Excel/VBA macro to compute terms from OEIS A210380. ' (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 main program of the macro (i.e., ' anywhere between the "Sub OEIS_A210380()" line and the "End Sub" ' line that precedes the "Function bFuncSolnFound..." 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), this latest ' version of the macro takes less than a second to compute all the terms ' of A210380 up through a(37)=88; it takes about a minute to get from ' there through a(51)=135, and about an hour to get from there through ' a(69)=189. (It might still take a few weeks to get from there through ' a(100)=281.) ' ' I developed the algorithm on my own, so -- while I'm confident that the ' results it gives are correct -- I think there's a very good chance that ' I've completely overlooked some fairly obvious pruning or reduction ' tests (and/or improvements to the existing tests) that, if implemented, ' could yield major speed improvements relative to this current algorithm. ' '------------------------------------------------------------------------- ' This file was uploaded to the OEIS for access via a link on the page at ' https://oeis.org/A210380 ' by Jon E. Schoenfield, Feb 02 2014. '------------------------------------------------------------------------- Option Explicit Const constNMax = 150 Const constStackMax = 1000 Dim glNActionsInStack As Long ' Stack of undoable actions (for ' backtracking thru the search tree) ... Dim glActionStack(0 To constStackMax, 0 To 2) As Long ' e.g., (5,0), (5,1), and (5,2) define the 5th move in the stack; ' (5,0) = the number (from 1 through lATest) that was available ' and was acted upon ' (5,1) = -1 if the action was to include the number ' (and exclude any/all connected to it), ' 0 if it was to exclude it ' (5,2) = -1 if the action was mandatory, 0 if it was optional Dim gbIsSquare(constNMax * 8) As Boolean Sub OEIS_A210380() ' "Consider all n-tuples of distinct positive integers for which no two ' different elements add up to a square. This sequence gives the ' smallest maximal integer in such tuples." Dim lA(constNMax) As Long Dim lN As Long, lATest As Long Dim lI As Long Dim strAFile As String, strBfile As String, strSoln As String For lI = 0 To Int(Sqr(constNMax * 8)) gbIsSquare(lI * lI) = True Next lI strAFile = "C:\OEIS_A210380\a210380.txt" strBfile = "C:\OEIS_A210380\b210380.txt" lN = 1 lA(1) = 1 Range("A:B").ClearContents Cells(1, 1).Value = 1 Cells(1, 2).Value = 1 DoEvents Open strBfile For Output As #1 Print #1, lN & " " & lA(lN) Close #1 Open strAFile For Output As #2 Print #2, "Sets (not necessarily lexicographically-first)" Print #2, " of n distinct positive integers," Print #2, " the largest of which is A210380(n)," Print #2, " and no two of which sum to a square: " Print #2, "A210380(1)=1: 1" Close #2 For lN = 2 To constNMax ' If there's an lN-integer solution whose maximal value is ' lATest=lA(lN-1)+1, then it must include not only lATest but also ' lATest-1 (i.e., lA(lN-1)); otherwise, omitting the integer lATest ' from the set of lN integers would give an (lN-1)-integer solution ' whose maximal value is less than lA(lN-1). If gbIsSquare(2 * lA(lN - 1) + 1) Then ' can't include both lA(lN-1)+1 and lA(lN-1) (sum is a square) lATest = lA(lN - 1) + 2 ' skip lA(lN-1)+1; no sol'n possible there Else lATest = lA(lN - 1) + 1 End If Cells(lN, 1).Value = lN Cells(lN, 2).Value = ">= " & lATest DoEvents ReDim lIncluded(lN) As Long Do While Not bFuncSolnFound(lN, lATest, lA(), lIncluded()) ' No lN-tuple as described in the definition of OEIS A210380 ' and having lATest as its maximal integer exists lATest = lATest + 1 ' increment lATest Cells(lN, 2).Value = ">= " & lATest DoEvents Loop lA(lN) = lATest Cells(lN, 2).Value = lATest DoEvents Open strBfile For Append As #1 Print #1, lN & " " & lA(lN) Close #1 strSoln = strFuncShowSoln(lN, lATest, lIncluded()) ' (lN-element subset returned may not be lexicographically-first) Open strAFile For Append As #2 Print #2, strSoln Close #2 Next lN End Sub Function bFuncSolnFound(lN As Long, lATest As Long, lA() As Long, _ lIncluded() As Long) As Boolean ' Return True iff there exists an lN-element subset of the first lATest ' positive integers that includes lATest itself and does not include ' any two integers whose sum is a square. Dim lNAvailable As Long, lNIncluded As Long Dim lNLeftToBeIncluded As Long, lNLeftToBeExcluded As Long Dim lI As Long, lJ As Long, lJ1 As Long, lJ2 As Long, lK As Long Dim lMinConnexns As Long, lMaxConnexns As Long Dim lI1st1Connexn As Long, lNumHalfArcs As Long, lNumArcs As Long Dim lNumConnexnsFromI As Long Dim lItoInclude As Long, lItoExclude As Long Dim lSumConnexns As Long Dim lSumConnexnsMin As Long, lSumConnexnsMax As Long Dim lI1toInclude As Long, lI2toInclude As Long Dim bReduction As Boolean, bBacktrack As Boolean, bRecordable As Boolean Dim lIsMandatory As Long ReDim lNumConnexnsFrom(lATest) As Long ReDim lNextConnexnFromAfter(lATest, 0 To lATest) As Long ReDim lPrevConnexnFromBefore(lATest, 0 To lATest) As Long ReDim bIsAvailable(1 To lATest) As Boolean ReDim lNextAvailable(0 To lATest) As Long ReDim lPrevAvailable(0 To lATest) As Long ' Initialize arrays for tracking the connections between pairs of ' integers whose sum is a square and the availability of each integer subInitArrays lATest, lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable() lNAvailable = lATest lNIncluded = 0 glNActionsInStack = 0 lI = lATest ' Include the lATest bRecordable = True ' record this in the action stack lIsMandatory = -1 ' (mandatory) subInclude lI, bRecordable, lIsMandatory, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() If lATest = lA(lN - 1) + 1 Then ' If there's an lN-integer solution whose maximal value is ' lATest=lA(lN-1)+1, then it must include not only lATest but also ' lATest-1 (i.e., lA(lN-1)); otherwise, omitting the integer lATest ' from the set of lN integers would give an (lN-1)-integer solution ' whose maximal value is less than lA(lN-1). lI = lA(lN - 1) ' Include lA(lN-1) as well bRecordable = True ' record this in the action stack lIsMandatory = -1 ' (mandatory) subInclude lI, bRecordable, lIsMandatory, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() If lNAvailable = 0 Then bFuncSolnFound = (lNIncluded = lN) Exit Function End If End If ' Perform an exhaustive search for a way to select lN integers from ' [1..lATest], including the one(s) selected above Do If lNIncluded <= 20 Then DoEvents End If bBacktrack = False ' init bReduction = False ' init lNLeftToBeIncluded = lN - lNIncluded lNLeftToBeExcluded = lNAvailable - lNLeftToBeIncluded If lNLeftToBeExcluded < 0 Then bBacktrack = True ' no solution on current branch Else lMinConnexns = lATest ' init lMaxConnexns = 0 ' init lI1st1Connexn = 0 ' (will store 1st available integer having exactly 1 connection) ReDim lNumNodesByConCt(lNAvailable - 1) As Long ' number of nodes by their connection-counts lNumHalfArcs = 0 ' init lI = lNextAvailable(0) ' first available integer Do While lI lNumConnexnsFromI = lNumConnexnsFrom(lI) lNumHalfArcs = lNumHalfArcs + lNumConnexnsFromI If lI1st1Connexn = 0 Then ' no available integers yet found with exactly 1 connection If lNumConnexnsFromI = 1 Then lI1st1Connexn = lI End If End If If lNumConnexnsFromI < lMinConnexns Then lMinConnexns = lNumConnexnsFromI End If If lNumConnexnsFromI > lMaxConnexns Then lMaxConnexns = lNumConnexnsFromI End If lNumNodesByConCt(lNumConnexnsFromI) = _ lNumNodesByConCt(lNumConnexnsFromI) + 1 lI = lNextAvailable(lI) Loop lNumArcs = lNumHalfArcs \ 2 If bFuncTest1(lN, lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lNextAvailable(), lNAvailable, lNIncluded, _ lMinConnexns, lMaxConnexns, lNumArcs, _ lNumNodesByConCt()) Then bBacktrack = True ' no sol'n can exist on this branch ElseIf lMaxConnexns > lNLeftToBeExcluded Then ' at least one integer has too many connexns to be includable ' Exclude an integer that has too many connections lI = lNextAvailable(0) ' first available integer Do While lI If lNumConnexnsFrom(lI) > lNLeftToBeExcluded Then ' this integer has too many connections; exclude it bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory) subExclude lI, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable Exit Do ' (this reduction may yield results more ' efficiently handled elsewhere in the code, ' rather than continuing this loop) End If lI = lNextAvailable(lI) Loop bReduction = True ElseIf lMinConnexns = 0 Then ' Include all available integers that have zero connections lI = lNextAvailable(0) ' first available integer Do While lI If lNumConnexnsFrom(lI) = 0 Then ' this is an available integer w/no connexs; include it bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory) subInclude lI, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() End If lI = lNextAvailable(lI) Loop bReduction = True ElseIf lMinConnexns = 1 Then ' Arbitrarily, include first item that has exactly 1 connection ' (note that doing so may cause the number of connections for ' one or more other items to decrease to 1 or 0; ' note also that doing this may yield a solution that is not ' the lexicographically-first one) lI = lI1st1Connexn ' include this integer ' (the 1st available w/exactly 1 connection) bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory) subInclude lI, bRecordable, lIsMandatory, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), _ lPrevAvailable(), lNAvailable, lNIncluded, _ lIncluded() bReduction = True ElseIf lMinConnexns = 2 Then ' If any available integer with exactly two connections is ' connected to two integers that are connected to each other, ' a reduction applies. (Note that using this reduction may ' cause the number of connections for one or more other ' integers to decrease to 1 or 0; note also that doing this ' may yield a solution that is not the lexicographically-first ' one.) lI = lNextAvailable(0) ' first available integer Do While lI If lNumConnexnsFrom(lI) = 2 Then lJ1 = lNextConnexnFromAfter(lI, 0) ' 1st of the 2 available ints to which lI is connected lJ2 = lNextConnexnFromAfter(lI, lJ1) ' 2nd of the 2 available ints to which lI is connected If gbIsSquare(lJ1 + lJ2) Then ' the pairwise sums of lI, lJ1, and lJ2 form a ' Pythagorean triple; the problem can be reduced ' by Including lI bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory; this is a reduction) subInclude lI, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), _ lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() bReduction = True Exit Do ' (this reduction may yield results more ' efficiently handled elsewhere in the code, ' rather than continuing this loop) End If End If lI = lNextAvailable(lI) Loop End If End If If bBacktrack Then ' a test proved that no solution could exist on this branch ' Carry out the backtracking; ' return True iff no place left to which to backtrack If bFuncBacktrackCompletesTree(lATest, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), _ lPrevAvailable(), lNAvailable, _ lNIncluded, lIncluded()) Then bFuncSolnFound = False Exit Function End If ElseIf bReduction Then ' the problem was reduced ' (via either a forced Inclusion or a forced Exclusion) If lNIncluded = lN Then ' solution found bFuncSolnFound = True Exit Function End If Else ' the above tests neither pruned the current branch ' nor yielded a reduction If lMinConnexns = 2 Then ' Select an integer lItoExclude that has exactly 2 connections ' and, among such integers, maximizes the total number of ' connections from the two integers to which lItoExclude is ' connected; exclude lItoExclude and include _both_ of the ' integers to which it is connected. ' (The resulting branch will probably be pruned quickly, and ' then, on backtracking, the alternative that dominates all ' others will be to include lItoExclude.) ' Note: this assumes that those two integers to which the ' 2-connected integer is connected are not connected to each ' other; if so, the code above that tests for pairwise sums ' that form a Pythagorean triple would have detected this ' situation. lItoExclude = 0 ' init lSumConnexnsMax = 0 lI = lNextAvailable(0) ' first available integer Do While lI If lNumConnexnsFrom(lI) = 2 Then lJ1 = lNextConnexnFromAfter(lI, 0) ' 1st of two available integers to which lI is connected lJ2 = lNextConnexnFromAfter(lI, lJ1) ' 2nd of two available integers to which lI is connected lSumConnexns = lNumConnexnsFrom(lJ1) + _ lNumConnexnsFrom(lJ2) If lSumConnexns > lSumConnexnsMax Then lItoExclude = lI lSumConnexnsMax = lSumConnexns End If End If lI = lNextAvailable(lI) Loop lI1toInclude = lNextConnexnFromAfter(lItoExclude, 0) lI2toInclude = lNextConnexnFromAfter(lItoExclude, lI1toInclude) bRecordable = True ' record all three actions in the stack lIsMandatory = 0 ' (optional -- so that, on backtracking, ' lItoExclude will be included instead) subExclude lItoExclude, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), lNAvailable ' Make these two Inclusions mandatory, so that they and the ' above Exclusion will be undone together when backtracking lIsMandatory = -1 ' (mandatory) subInclude lI1toInclude, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() subInclude lI2toInclude, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() Else ' (i.e., lMinConnexns > 2) ' Find an integer lItoInclude that has the the maximum number ' of connections and, among such integers, minimizes the sum ' of the numbers of connections of the integers to which ' lItoInclude is connected; include lItoInclude. ' (The resulting branch will probably be pruned relatively ' quickly, and then the alternative will be to exclude ' lItoInclude.) lItoInclude = 0 ' init lSumConnexnsMin = 2147483647 ' init (big number) lI = lNextAvailable(0) ' first available integer Do While lI If lNumConnexnsFrom(lI) = lMaxConnexns Then lSumConnexns = 0 ' init lJ = lNextConnexnFromAfter(lI, 0) ' first available integer to which lI is connected Do While lJ lSumConnexns = lSumConnexns + lNumConnexnsFrom(lJ) lJ = lNextConnexnFromAfter(lI, lJ) Loop If lSumConnexns < lSumConnexnsMin Then lItoInclude = lI lSumConnexnsMin = lSumConnexns End If End If lI = lNextAvailable(lI) Loop bRecordable = True ' an action to record in the stack lIsMandatory = 0 ' (optional -- so that, on backtracking, ' lItoInclude will be excluded instead) subInclude lItoInclude, bRecordable, lIsMandatory, _ lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() End If If lNIncluded <= 6 Then ' update current status in the Immediate window subPrint1stIncludeds lN, lNIncluded, lIncluded() End If End If Loop End Function Sub subInitArrays(lATest As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, lPrevAvailable() As Long) ' Initialize the double-linked lists of connected numbers & other arrays Dim lI As Long, lJ As Long, lIConnexn As Long, lConnexnsCount As Long For lI = 1 To lATest ' Find all other numbers in [1..lATest] such that adding lI ' gives a square ReDim lConnexnsTemp(lATest) As Long ' won't need to store nearly this many lConnexnsCount = 0 For lJ = 1 To lATest If lJ <> lI Then If gbIsSquare(lI + lJ) Then ' sum is a square lConnexnsCount = lConnexnsCount + 1 lConnexnsTemp(lConnexnsCount) = lJ End If End If Next lJ lNextConnexnFromAfter(lI, 0) = lConnexnsTemp(1) For lIConnexn = 1 To lConnexnsCount - 1 lNextConnexnFromAfter(lI, lConnexnsTemp(lIConnexn)) = _ lConnexnsTemp(lIConnexn + 1) Next lIConnexn lNextConnexnFromAfter(lI, lConnexnsTemp(lConnexnsCount)) = 0 lPrevConnexnFromBefore(lI, lConnexnsTemp(1)) = 0 For lIConnexn = 2 To lConnexnsCount lPrevConnexnFromBefore(lI, lConnexnsTemp(lIConnexn)) = _ lConnexnsTemp(lIConnexn - 1) Next lIConnexn lPrevConnexnFromBefore(lI, 0) = lConnexnsTemp(lConnexnsCount) lNumConnexnsFrom(lI) = lConnexnsCount Next lI For lI = 1 To lATest bIsAvailable(lI) = True Next lI For lI = 0 To lATest - 1 lNextAvailable(lI) = lI + 1 Next lI lNextAvailable(lATest) = 0 For lI = 1 To lATest lPrevAvailable(lI) = lI - 1 Next lI lPrevAvailable(0) = lATest End Sub Sub subInclude(lNumber As Long, bRecordable As Boolean, _ lIsMandatory As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, lPrevAvailable() As Long, _ lNAvailable As Long, _ lNIncluded As Long, lIncluded() As Long) Dim lI As Long, lIsMandatoryNew As Long Dim bRecordableNew As Boolean If Not bIsAvailable(lNumber) Then Stop ' ??? This shouldn't happen! End If ' Include the integer lNumber among those currently in the set of lN ' integers we're attempting to build lNIncluded = lNIncluded + 1 lIncluded(lNIncluded) = lNumber ' Update dbl linked list of available integers (remove integer lNumber) lNextAvailable(lPrevAvailable(lNumber)) = lNextAvailable(lNumber) lPrevAvailable(lNextAvailable(lNumber)) = lPrevAvailable(lNumber) bIsAvailable(lNumber) = False lNAvailable = lNAvailable - 1 If bRecordable Then ' Update the action stack glNActionsInStack = glNActionsInStack + 1 ' add an action to the stack glActionStack(glNActionsInStack, 0) = lNumber ' the integer being acted upon glActionStack(glNActionsInStack, 1) = -1 ' the action is to Include the number glActionStack(glNActionsInStack, 2) = lIsMandatory End If ' Traverse the list of integers to which lNumber had been connected; ' Exclude each of them bRecordableNew = False ' don't record these in the stack; ' they'll be undone automatically ' when the Include action is undone lIsMandatoryNew = 0 ' (this doesn't really matter, since the action ' won't be recorded in the stack) lI = lNextConnexnFromAfter(lNumber, 0) ' smallest integer to which lNumber was connected Do While lI subExclude lI, bRecordableNew, lIsMandatoryNew, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), lPrevAvailable(), _ lNAvailable lI = lNextConnexnFromAfter(lNumber, lI) ' next-larger integer to which lNumber was connected Loop End Sub Sub subExclude(lNumber As Long, bRecordable As Boolean, _ lIsMandatory As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, lPrevAvailable() As Long, _ lNAvailable As Long) Dim lI As Long ' Exclude the integer lNumber from those currently in the set of lN ' integers we're attempting to build If Not bIsAvailable(lNumber) Then Stop ' ??? This shouldn't happen! End If ' Update dbl linked list of available integers (remove integer lNumber) lNextAvailable(lPrevAvailable(lNumber)) = lNextAvailable(lNumber) lPrevAvailable(lNextAvailable(lNumber)) = lPrevAvailable(lNumber) bIsAvailable(lNumber) = False lNAvailable = lNAvailable - 1 If bRecordable Then ' Update the stack glNActionsInStack = glNActionsInStack + 1 ' add an action to the stack glActionStack(glNActionsInStack, 0) = lNumber ' the integer being acted upon glActionStack(glNActionsInStack, 1) = 0 ' the action is to exclude the number glActionStack(glNActionsInStack, 2) = lIsMandatory End If ' Traverse the list of available integers connected to lNumber; ' update the connection information for each of them lI = lNextConnexnFromAfter(lNumber, 0) ' smallest integer to which lNumber was connected Do While lI If bIsAvailable(lI) Then ' (apply this test to avoid disconnecting ' an integer that had been connected ' to a just-Included one) lNumConnexnsFrom(lI) = lNumConnexnsFrom(lI) - 1 lNextConnexnFromAfter(lI, lPrevConnexnFromBefore(lI, lNumber)) = _ lNextConnexnFromAfter(lI, lNumber) lPrevConnexnFromBefore(lI, lNextConnexnFromAfter(lI, lNumber)) = _ lPrevConnexnFromBefore(lI, lNumber) End If lI = lNextConnexnFromAfter(lNumber, lI) ' next-larger integer to which lNumber was connected Loop End Sub Sub subUndoInclude(lNumber As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, _ lPrevAvailable() As Long, lNAvailable As Long, _ lNIncluded As Long, lIncluded() As Long) ' Undo the Inclusion of the integer lNumber among those currently in ' the set of lN integers we're attempting to build Dim lI As Long ' Traverse the list of integers to which lNumber had been connected; ' undo the Exclusion of each lI = lPrevConnexnFromBefore(lNumber, 0) ' largest integer to which ' lNumber was connected Do While lI subUndoExclude lI, lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), lNAvailable lI = lPrevConnexnFromBefore(lNumber, lI) ' next-smaller integer to which lNumber was connected Loop lNIncluded = lNIncluded - 1 ' Update dbl linked list of available integers (restore integer lNumber) lNextAvailable(lPrevAvailable(lNumber)) = lNumber lPrevAvailable(lNextAvailable(lNumber)) = lNumber bIsAvailable(lNumber) = True lNAvailable = lNAvailable + 1 End Sub Sub subUndoExclude(lNumber As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, lPrevAvailable() As Long, _ lNAvailable As Long) Dim lI As Long ' Undo the earlier action of Excluding the integer lNumber from those ' currently in the set of lN integers we're attempting to build ' Update dbl linked list of available integers (restore integer lNumber) lNextAvailable(lPrevAvailable(lNumber)) = lNumber lPrevAvailable(lNextAvailable(lNumber)) = lNumber bIsAvailable(lNumber) = True lNAvailable = lNAvailable + 1 ' Traverse the list of available integers that had been connected to ' lNumber; restore the connection information for each of them lI = lPrevConnexnFromBefore(lNumber, 0) ' largest integer to which lNumber is to be reconnected Do While lI If bIsAvailable(lI) Then lNumConnexnsFrom(lI) = lNumConnexnsFrom(lI) + 1 lNextConnexnFromAfter(lI, lPrevConnexnFromBefore(lI, lNumber)) = _ lNumber lPrevConnexnFromBefore(lI, lNextConnexnFromAfter(lI, lNumber)) = _ lNumber End If lI = lPrevConnexnFromBefore(lNumber, lI) ' next-smaller integer to which lNumber is to be reconnected Loop End Sub Function bFuncBacktrackCompletesTree(lATest As Long, _ lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lPrevConnexnFromBefore() As Long, _ bIsAvailable() As Boolean, _ lNextAvailable() As Long, _ lPrevAvailable() As Long, _ lNAvailable As Long, _ lNIncluded As Long, _ lIncluded() As Long) As Boolean ' Backtrack; return True iff backtracking completes the search tree for ' the current value of lATest Dim lI As Long, lJ As Long, lIsMandatory As Long Dim bWasIncludeAction As Boolean, bWasMandatory As Boolean Dim bRecordable As Boolean Do If glNActionsInStack = 0 Then ' no moves left on which to backtrack bFuncBacktrackCompletesTree = True ' try next value of lATest Exit Function End If ' undo most recent action lI = glActionStack(glNActionsInStack, 0) bWasIncludeAction = (glActionStack(glNActionsInStack, 1) = -1) bWasMandatory = glActionStack(glNActionsInStack, 2) If bWasIncludeAction Then subUndoInclude lI, lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), lNAvailable, _ lNIncluded, lIncluded() Else subUndoExclude lI, lNumConnexnsFrom(), lNextConnexnFromAfter(), _ lPrevConnexnFromBefore(), bIsAvailable(), _ lNextAvailable(), lPrevAvailable(), lNAvailable End If glNActionsInStack = glNActionsInStack - 1 Loop While bWasMandatory ' continue undoing ' until an action that was optional is reached ' The last action undone was an optional action If bWasIncludeAction Then ' optional action was to Include integer lI ' No solution existed on that branch, ' so Exclude the number, and store the exclusion as mandatory bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory) subExclude lI, bRecordable, lIsMandatory, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), lPrevAvailable(), _ lNAvailable Else ' i.e., the optional action was to Exclude integer lI ' No solution existed on that branch, ' so Include the number, and store the inclusion as mandatory bRecordable = True ' an action to record in the stack lIsMandatory = -1 ' (mandatory) subInclude lI, bRecordable, lIsMandatory, lNumConnexnsFrom(), _ lNextConnexnFromAfter(), lPrevConnexnFromBefore(), _ bIsAvailable(), lNextAvailable(), lPrevAvailable(), _ lNAvailable, lNIncluded, lIncluded() End If bFuncBacktrackCompletesTree = False ' continue searching for a solution ' at current value of lATest End Function Sub subPrint1stIncludeds(lN As Long, lNToPrint As Long, _ lIncluded() As Long) Dim lI As Long ' In the line of text to be displayed in the Immediate window, show ' (1) the value of lN, followed by a colon; ' (2) the value of lATest (which was the 1st integer selected for ' inclusion at this combination of lN and lATest); ' (3) a dot for each integer that's been tested and found impossible ' to include at this combination of lN and lATest); ' (4) the 2nd through lNToPrint-th integers included at the current ' branch of the search tree. Debug.Print lN & ": "; Debug.Print Right(" " & LTrim(Str(lIncluded(1))), 4); " "; For lI = 2 To glNActionsInStack If glActionStack(lI, 1) = 0 Then Debug.Print "."; Else Exit For End If Next lI For lI = 2 To lNToPrint Debug.Print Right(" " & LTrim(Str(lIncluded(lI))), 4); Next lI Debug.Print DoEvents End Sub Function strFuncShowSoln(lN As Long, lATest As Long, _ lIncluded() As Long) As String Dim lI As Long, lJ As Long, lJatMin As Long, lTemp As Long Dim strTemp As String strTemp = "A210380(" & lN & ")=" & lATest & ": " ' sort For lI = 1 To lN - 1 lJatMin = lI For lJ = lI + 1 To lN If lIncluded(lJ) < lIncluded(lJatMin) Then lJatMin = lJ End If Next lJ If lJatMin <> lI Then lTemp = lIncluded(lI) lIncluded(lI) = lIncluded(lJatMin) lIncluded(lJatMin) = lTemp End If Next lI For lI = 1 To lN strTemp = strTemp & " " & lIncluded(lI) Next lI strFuncShowSoln = strTemp End Function Function bFuncTest1(lN As Long, lNumConnexnsFrom() As Long, _ lNextConnexnFromAfter() As Long, _ lNextAvailable() As Long, lNAvailable As Long, _ lNIncluded As Long, lMinConnexns As Long, _ lMaxConnexns As Long, lNumArcs As Long, _ lNumNodesByConCt() As Long) As Boolean ' Return True iff test shows that, given the input values, ' no solution is possible Dim lI As Long, lJ As Long, lC As Long Dim lNumConnexnsI As Long, lMaxArcsRemovable As Long Dim lMinIntsRjctd As Long Dim lNArcsUpToCOnMaxEnd As Long Dim lMinAdditionalToRjct As Long, lMinAddlToRjctAtJ As Long ' lNAvailable integers remain available; success would require finding ' some set of lN - lNIncluded integers among them, no two of which sum ' to a square; ' thus, success would require rejecting some set of ' lNAvailable - (lN - lNIncluded) integers ' so that accepting all the rest would not leave any two ' whose sum is a square. bFuncTest1 = False ' init: test fails to prune the branch ReDim lMaxLeftRjctableByConCt(lNAvailable) As Long ' lMaxLeftRjctableByConCt(I) will store the max number of integers ' left that have exactly I connections and may be rejectable For lC = lMinConnexns To lMaxConnexns lMaxLeftRjctableByConCt(lC) = lNumNodesByConCt(lC) ' copy ' (lNumNodesByConCt(I) is the number of integers having ' exactly I connections) Next lC ReDim lCountConnexnsByType(lMinConnexns To lMaxConnexns, _ lMinConnexns To lMaxConnexns) As Long ' For each arc (i.e., connection), ' let A and B be the two integers connected by the arc ' (so A+B is square), ' and let n_A and n_B be ' the number of integers connected to A ' and the number of integers connected to B, respectively. ' Letting x and y be the smaller and the greater of n_A and n_B, ' respectively (or, if n_A = n_B, then x = y), ' count the number of arcs that connect an x-connections integer ' to a y-connections integer. lI = lNextAvailable(0) ' first available integer Do While lI lNumConnexnsI = lNumConnexnsFrom(lI) lJ = lNextConnexnFromAfter(lI, 0) ' first integer to which lI is connected Do While lJ ' To count each arc only once, rather than twice, ' while going through all available integers lI and lJ, ' count only those arcs where ' ' lNumConnexnsFrom(lJ) > lNumConnexnsFrom(lI) ' ' or ' ' (lNumConnexnsFrom(lJ) = lNumConnexnsFrom(lI)) AND (lJ > lI): If lNumConnexnsFrom(lJ) > lNumConnexnsI Then lCountConnexnsByType(lNumConnexnsI, lNumConnexnsFrom(lJ)) = _ lCountConnexnsByType(lNumConnexnsI, lNumConnexnsFrom(lJ)) _ + 1 ElseIf lNumConnexnsFrom(lJ) = lNumConnexnsI Then If lJ > lI Then lCountConnexnsByType(lNumConnexnsI, lNumConnexnsI) = _ lCountConnexnsByType(lNumConnexnsI, lNumConnexnsI) + 1 End If End If lJ = lNextConnexnFromAfter(lI, lJ) ' next integer to which lI is connected after lJ Loop lI = lNextAvailable(lI) ' next available integer after lI Loop ' Compute an upper bound on the number of arcs that can be removed by ' rejecting at least the minimum required number of integers having ' lMinConnexns connections, and at least the minimum required number ' of integers having either lMinConnexns or lMinConnexns+1 connections, ' etc. lMaxArcsRemovable = 0 ' init (will cumulate values to yield ' a loose upper bound) lNArcsUpToCOnMaxEnd = 0 ' init: number of arcs that connect 2 integers ' of which neither has more than lC connections lMinIntsRjctd = 0 ' init For lC = lMinConnexns To lMaxConnexns For lJ = lMinConnexns To lC lNArcsUpToCOnMaxEnd = lNArcsUpToCOnMaxEnd _ + lCountConnexnsByType(lJ, lC) Next lJ If lNArcsUpToCOnMaxEnd > lMaxArcsRemovable Then lMinAdditionalToRjct = _ (lNArcsUpToCOnMaxEnd - lMaxArcsRemovable - 1) \ lC + 1 If lMinAdditionalToRjct + lMinIntsRjctd > _ lNAvailable - (lN - lNIncluded) Then bFuncTest1 = True ' the branch can be pruned Exit For End If For lJ = lC To lMinConnexns Step -1 If lMinAdditionalToRjct <= lMaxLeftRjctableByConCt(lJ) Then lMinAddlToRjctAtJ = lMinAdditionalToRjct Else lMinAddlToRjctAtJ = lMaxLeftRjctableByConCt(lJ) End If lMaxArcsRemovable = lMaxArcsRemovable + lMinAddlToRjctAtJ * lJ lMaxLeftRjctableByConCt(lJ) = _ lMaxLeftRjctableByConCt(lJ) - lMinAddlToRjctAtJ lMinAdditionalToRjct = lMinAdditionalToRjct - lMinAddlToRjctAtJ lMinIntsRjctd = lMinIntsRjctd + lMinAddlToRjctAtJ If lMinAdditionalToRjct = 0 Then Exit For End If Next lJ End If Next lC End Function