Euler Problem 23 asks:

‘is exactly equal to the number. For example, the sum of the proper

‘divisors of 28 would be 1 + 2 + 4 + 7 + 14 = 28, which means that 28

‘is a perfect number.

‘

‘A number whose proper divisors are less than the number is called deficient

‘and a number whose proper divisors exceed the number is called abundant.

‘As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the smallest

‘number that can be written as the sum of two abundant numbers is 24.

‘By mathematical analysis, it can be shown that all integers greater than 28123

‘can be written as the sum of two abundant numbers. However, this upper limit

‘cannot be reduced any further by analysis even though it is known that the

‘greatest number that cannot be expressed as the sum of two abundant numbers

‘is less than this limit.

‘

‘Find the sum of all the positive integers which cannot be written as the sum

‘of two abundant numbers.

The approach seems simple:

- Determine the list of abundant numbers and add to a collection
- Determine the list of all abundant number sums and add it to a different collection
- Run the list of numbers past the second collection to identify those not in the collection, and sum

Usually, I’ll count the number of something, re-dim a variable to that count, and then stuff the variable. But since I have to calculate “abundantness” to determine membership, we’ll just add it to the collection in the same step, and have the collection report the count.

Unfortunately, collections only provide for add, remove, retrieve, and count. There is not a “belongs” or “ismember” function. A smart guy (Mark Nold) over in StackOverflow provided a way, using errors. Here is his code:

Dim var As Variant

Dim errNumber As Long

InCollection = False

Set var = Nothing

Err.Clear

On Error Resume Next

var = col.Item(key)

errNumber = CLng(Err.Number)

On Error GoTo 0

‘5 is not in, 0 and 438 represent incollection

If errNumber = 5 Then ‘ it is 5 if not in collection

InCollection = False

Else

InCollection = True

End If

End Function

I use his method twice to, first, see if an abundant number sum is already in the collection of AbundantSums, and then secondly to see which of the numbers in the range to 28123 is not in the AbundantSums collection.

That’s how I did it. My problem is that, to coin a new unit of measurement, the calculations take a kilo-second, or almost 18 minutes, to arrive at the answer. The first and last steps are very fast. It’s the middle one that takes 1000 seconds. Euler won’t mind, I think, if I say there are 6965 abundant numbers in the range. To compute all possible abundant number sums is 6965*6965 cycles, or very close to 49 million loops. I don’t see the trick to get this down to one-minute Euler time, and I couldn’t pick out the shortcut in the commentary of those who already solved this problem. Here’s my code, with timing comments for each of the steps.

Const Limit As Long = 28123

Dim AbundantNums As New Collection

Dim AbundantSums As New Collection

Dim i As Long, j As Long

Dim n As Long, T As Single

Dim TEMP As Long, Key As String, errNum As Long, Item As Long

Dim Answer As Long

T = Timer

j = 1

For i = 12 To Limit

If IsAbundant(i) Then

AbundantNums.Add (i)

j = j + 1

End If

Next i

n = AbundantNums.Count

Debug.Print n; Timer – T ‘6965 0.2695313

For i = 1 To n

If AbundantNums.Item(i) + AbundantNums.Item(1) > Limit Then

Exit For

End If

For j = i To n

errNum = 0

If AbundantNums.Item(i) + AbundantNums.Item(j) LTE Limit Then

Item = AbundantNums.Item(i) + AbundantNums.Item(j)

Key = CStr(Item)

Err.Clear

On Error Resume Next

TEMP = AbundantSums.Item(Key) ‘if retrieved then no error

errNum = CLng(Err.Number)

On Error GoTo 0

If errNum = 5 Then ‘this means Not Retrieved from Collection

AbundantSums.Add Item:=Item, Key:=Key ‘so add it

End If

Else

Exit For

End If

Next j

Next i

Debug.Print AbundantSums.Count; Timer – T ‘26667 1001.789

For i = 1 To Limit

errNum = 0

Key = CStr(i)

Err.Clear

On Error Resume Next

TEMP = AbundantSums.Item(Key)

errNum = CLng(Err.Number)

On Error GoTo 0

If errNum = 5 Then ‘ i is not in the Sums Collection

Answer = Answer + i

End If

Next i

Debug.Print Answer; ” Time:”; Timer – T

End Sub ‘xxxxxxxxxx Time: 1001.883

Function IsAbundant(num As Long) As Boolean

Dim i As Long

Dim sum As Long

sum = 1

For i = 2 To Sqr(num)

If num Mod i = 0 Then

sum = sum + i

sum = sum + num / i

End If

Next i

If Sqr(num) = Int(Sqr(num)) Then ‘a perfect square

‘i = Sqr(num) = num/i and added twice above

sum = sum – Sqr(num)

End If

If sum > num Then

IsAbundant = True

Else

IsAbundant = False

End If

End Function

The IsAbundant function only has to check to the square root of a number. If num mod i = 0 you have also determined that num/i is a factor at the same time, and both can be added to the sum of factors. The only rub is when num is a perfect square (when i = sqr(num) = num/i) and you have added that factor twice. Rather than put some logic inside the loop, I checked if that was the case, and subtracted one square root when required.

Only partial credit for this one. It takes too dang long. Please comment on what I’ve missed. The Prime Glossary (http://primes.utm.edu/glossary/page.php?sort=AbundantNumber) reports that the real limit is 20161. While several solvers knew that, I don’t think that’s the problemgets me down to about 400 seconds. To make the change, just change the constant at the top.

…mrt

How much faster (if at all) does it go using a Scripting.Dictionary (which handily also has an Exists member function)? Once I’m into the thousands of items, I usually figure there’s going to be something worth having; any concern that the code may one day find itself on a machine without the scripting runtime is negligible in my experience. Also, the key of a Dictionary can be any type, which would save a lot of CStr-ing. Using a Dictionary for AbundantSums reduces the code inside the inner loop to

errNum = 0

Item = AbundantNums.Item(i) + AbundantNums.Item(j) ‘ move above if to save computing twice

If Item <= Limit Then

AbundantSums(Item) = 1 ‘ creates the item if not present, don’t actually care about what’s stored

Else

Exit For

End If

Also, you have AbundantSums.Keys as an array, so ou can do something like this:

keys = AbundantSums.Keys

For i = LBound(keys) To UBound(keys)

Answer = Answer + keys(i)

Next

(No code actually tested yet – I hope haven’t written anything stupid!)

This was a slow one for me too: my Ruby option took almost a minute, of which 10sec was calculating the abundant list. I’m guessing there’s a trick being missed.

I tried creating an array of Abundant numbers and then testing each integer to see if I could find combinations of Abundant numbers that would sum to them. I also found that the process was very slow – I got the right answer, but some approaches were taking over an hour to run (the fastest was about 13 minutes).

I finally did it by creating an array of abundant numbers as before, then iterating through that array twice to find all the possible sums of two Abundant numbers and recorded that as a T/F indicator in another array – call the first array arAB() and the second an array of Booleans from 1 to 28K (the limit given in the problem – all numbers > 28,123 can be written as the sum of two Abundant numbers), called arYES() some pseudocode (apologies if I screw up the code formatting):

for j = i to ubound(arAB)

iTest = arAB(i) + arAB(j)

if iTest <= ubound(arYES) then

arYES(iTest) = TRUE

else

exit for

end if

next j

next i

for i = 1 to ubound(arYES)

if arYes(i) = FALSE THEN

iSum = iSum + i

end if

Next i

the full routine runs in less than two seconds

I think I used the same approach as dcardno, but mine takes just over a minute. Nearly all of my time is spent finding the abundant numbers. I’d be interested in knowing how you get it all to run in 2 seconds in VBA.

Here is my code..

For i = 2 To 28123

If SumDivisors(i) GREATER_THAN i Then ‘custom routine to find and sum divisors

r = r + 1

A(r) = i ‘this array stores a list of the numbers

b(i) = True ‘this array tells us if any number in the range is abundant

End If

Next i

Debug.Print Timer – t

For i = 1 To 28123 ‘for each number in range

For j = 1 To r ‘loop through abundant numbers

‘exit inner j loop and add i to our sum n, if our abundant number exceeds the current number i

‘ie no sum found for this i

If A(j) GREATER_THAN_EQUAL i Then

n = n + i

Exit For

End If

‘exit inner j loop if (i + the abundant number) is abundant

If b(i – A(j)) Then

Exit For

End If

Next j

Next i

I’ve cut & pasted the whole thing – which also includes my prior attempts commented out, and some timing results. I am running on a reasonably-powered laptop (Core 2 duo, T7500 IIRC, with 4Gig RAM), and it runs in just under a second. There was a substantial improvement in determining the factors by only testing to sqr(iIN) and calculating the second factor as required

‘ prior versions test up to iIn/2 to capture both factors

‘ present version tests up to sqr(iIn) and calculates second factor

‘ requires correction for the root (should only count once), but

‘ is ~20x faster (3.5 sec v .18 sec to create Abundant array)

Dim i As Long

iSumDiv = 1

For i = 2 To Sqr(iIN)

If iIN Mod i = 0 Then

iSumDiv = iSumDiv + i + (iIN / i)

If i = Sqr(iIN) Then iSumDiv = iSumDiv – i

End If

Next i

End Function

Sub ListAbundant()

Dim i As Long

Dim j As Long

Dim k As Long

Dim m As Long

Dim iSum As Long

Const iMax As Long = 28123

Dim arAb() As Boolean

Dim blFound As Boolean

Dim arAbVal() As Long

Dim iTest As Long

Dim sStart As Single

‘Dim wf As WorksheetFunction

‘

‘Set wf = Application.WorksheetFunction

‘ create array of T/F indicating abundant numbers

sStart = Timer

ReDim arAb(1 To iMax)

For i = 11 To iMax

If arAb(i) = False Then

If iSumDiv(i) > i Then

arAb(i) = True

j = 2

Do While j * i <= iMax

arAb(i * j) = True

j = j + 1

Loop

End If

End If

Next i

For i = 1 To iMax

If arAb(i) = True Then

k = k + 1

End If

Next i

Debug.Print k; Timer – sStart

‘ transform to array of abundant numbers

ReDim arAbVal(1 To k)

k = 1

For i = 1 To iMax

If arAb(i) Then

arAbVal(k) = i

k = k + 1

arAb(i) = False

End If

Next i

‘Another alternative – calculate all possible combinations of 2 Abundant numbers

‘then add all numbers that aren’t in that list. Execution time of ~4.4 sec – of

‘which 3.7 is to create the array of abundant numbers. The clear winner!

For i = 1 To k – 1

For j = i To k – 1

iTest = arAbVal(i) + arAbVal(j)

If iTest <= iMax Then

arAb(iTest) = True

Else

Exit For

End If

Next j

Next i

‘ alternative – use worksheet lookup functions – still bloody slow.

‘ Stopped manually at ~20 min, not complete

‘For i = 23 To iMax

‘ If arAb(i) = False Then

‘ For j = 1 To UBound(arAb)

‘ iTest = i – arAbVal(j)

‘ If iTest <= 0 Then

‘ Exit For

‘ Else

‘ If wf.Lookup(i, arAbVal) = i Then

‘ For k = 1 To CInt(UBound(arAb) / i – 0.5)

‘ arAb(i * k) = True

‘ Next k

‘ Exit For

‘ End If

‘ End If

‘ Next j

‘ End If

‘Next i

‘ this approach (examine values arAbVal(j) & (k), determine success or failure,

‘ set T/F for each coresponding arAb(i) plus multiples) took approx one hour – 3822 seconds

‘For i = 23 To iMax

‘ If arAb(i) = False Then

‘ For j = 1 To UBound(arAbVal)

‘ If arAb(i) = True Then

‘ Exit For

‘ End If

‘ If arAbVal(j) <i> i Then

‘ Exit For

‘ Else

‘ If arAbVal(j) + arAbVal(k) = i Then

‘ For m = 1 To Int(iMax / i)

‘ arAb(i * m) = True

‘ Next m

‘ Exit For

‘ End If

‘ End If

‘ Next k

‘ Else

‘ Exit For

‘ End If

‘ Next j

‘ End If

‘Next i

For i = 1 To iMax

If arAb(i) = False Then

iSum = iSum + i

End If

Next i

‘ This approach (loop within loop to test all arAbVal(j) + arAbVal(k))

‘ takes approx 12 minutes to run (723 seconds)

‘For i = 1 To iMax

‘ blFound = False

‘ For j = 1 To UBound(arAbVal)

‘ If arAbVal(j) </i><i> 0 Then

‘ Exit For

‘ End If

‘ Next k

‘ If blFound Then

‘ Exit For

‘ End If

‘ Else

‘ Exit For

‘ End If

‘ Next j

‘ If Not blFound Then

‘ iSum = iSum + i

‘ End If

‘Next i

Debug.Print iSum; Timer – sStart

End Sub

Ah yes, checking for divisors up to only the square root cuts the overall time to a couple of seconds. I’d used that approach for checking primes but not here. Silly me.

I don’t think that’s the real speed-up, dbb. When checking divisors up to half the input value it takes ~3.5 seconds to create the array of abundant numbers; checking only up to the square root cuts that to about a quarter of a second – but we only do it once and then refer to the array thereafter. The real improvement comes in not trying to find Abundant(i) and Abundant(j) that sum to a particular number, but instead just calculating the possible sums of Ab(i) and Ab(j) and using the value to index the array of T/F values.

I am trying to think of [i]why[/i] that should be such an improvement – it seems that we still have to run ~7000 * 7000 (approx the number of abundant numbers below 28K) calculations. It’s actually less than that, since the inner loop is smaller: the loops are i from 1 to 7000 and j from i to 7000, and we exit the loop if Ab(i) + Ab(j) > 28K, but it still seems that we should be doing perhaps 3500 * 3500 iterations. It could be that my other attempts [i]didn’t[/i] exit the loops properly, so the difference is between one routine doing 7K*7K loops and the other doing 3.5K*3.5K – but that’s still only a 4x speedup, and what I ended up with went from ~12 minutes (723 seconds) to under 2 seconds, or a 350x improvement.

The answer just struck me as I was reviewing that last bit of code in the module I posted (which got kind of munged-up in the formatting and lost most of a loop). In trying to find Abundant(i) + Abundant(j) that sums to each value in the range 1 to 28K we are actually doing 28K * 3.5K * 3.5K loops = ~3.4×10^11 iterations. In ticking off the sums of Ab(i) + Ab(j) for all values of i and j, we are only doing 3.5K * 3.5K loops, or 1.2×10^7 iterations.

Since we cut off the first approach based on Ab(i) being greater than the target value we save some of the second loop, and also some of the third loop if Ab(i) + Ab(j) is greater than the target, but that saving doesn’t make up for running the routine for every number from 1 to 28K

D – my approach was like your discarded 12 minute one. I just put a counter right under “for j = i to n” (the inner loop). It started down the j loop 12155776 times. It started 6962 times (top check shorts by 3) down the i loop. Nowhere do I loop 28K times. It’s not 49 million, but it’s not 3*10^11 either.

I still don’t understand the differences ;-)

…mrt