Question

I am solving Problem 23 of Project Euler using Mathematica:

Find the sum of all positive integers that cannot be written as the sum of two abundant numbers.

Recall that an abundant number # is one such that Total[Divisors[#]] - # > #. Here is my code:

list1 = Table[i, {i, 1, 28123}];
list2 = Select[list1, Total[Divisors[#]] - # > # && 2 * # < 28123 &];
list3 = {};
l = Length[list2];
For[i = 1, i <= l, i++, 
 For[j = i, j <= l, j++, 
  list3 = Append[list3, list2[[i]] + list2[[j]]]]];
Total[Complement[list1, list3]]

It is extremely slow; the nested For loops take an insane amount of time to evaluate.

Am I approaching this problem correctly? Is there a way to make it faster?

Edit: the reason behind the 28123 is that any number greater than it can be written as the sum of two abundant numbers.

Answer 1

Replace your loops that make list3 by this.

list3 = (list2[[#]] + list2[[# ;; -1]]) & /@ Range[Length[list2]] // Flatten;

Timing gives 0.49 seconds on my old PC

update

To answer a complain that list3 as constructed in my answer gives wrong solution.

Well. It gives the same content as list3 build using the original code. This method is just faster. If the construction in the original method is wrong, then nothing I can do about that really, since the question was about how to make it faster, not correct any errors in the algorithm itself, which I am not familiar with. The assumption was the algorithm posted was correct but slow.

(*28123  replaced with smaller value to check, else will take forevever*)
(*for original algorithm to finish *)

n = 200;
list1 = Table[i, {i, 1, n}];
list2 = Select[list1, Total[Divisors[#]] - # > # && 2*# < n &];
list3 = {};
l = Length[list2];
For[i = 1, i <= l, i++, 
  For[j = i, j <= l, j++, 
   list3 = Append[list3, list2[[i]] + list2[[j]]]]];


mylist3 = (list2[[#]] + list2[[# ;; -1]]) & /@ Range[Length[list2]] //Flatten;

compare

list3 - mylist3