Ruth-Aaron quadruple challenge

5

This a computational challenge, to find an efficient algorithm to discover a quadruple $(n,n+1,n+2,n+3)$ with the same sum of prime factors as described in the MO question, "Ruth-Aaron triples, etc." E.g., $$417,164 = 2^2 \cdot 11 \cdot 19 \cdot 499 \;;\; 2+2+11+19+499 = 533 \;.$$ The sum can be computed by multiplying the exponent in the prime factorization times the base prime:

SumFact[n_] := Apply[Plus, Map[#[[1]] #[[2]] &, FactorInteger[n]]];

Apparently no such quadruple is known, and I've checked through $n=10^7$, and am now trying to reach $10^8$ in the next day or so. But my computation is naive in terms of efficient computation. Also, I do not have easy access to significant computational resources.

As far as I can make out, there is no known such quadruple.

Joseph O'Rourke

Posted 2014-12-24T01:51:21.087

Reputation: 4 389

1Oh, there is an indication that such a quadruple must lie beyond $10^{10}$, which is well beyond what resources I can muster. – Joseph O'Rourke – 2014-12-24T03:03:20.243

2You need only search first every successive pairs of even numbers n to find adjacent even Ruth-Aaron numbers; if found, only then test the three additional adjacent (odd) numbers. This eliminates roughly half the computations in the naive method. Next, because in this first sieve search you're only searching even numbers, you could instead divide each by 2 (which subtracts the same increment in the R-A sum), and so instead search successive pair of "half" numbers. Finally, this search is highly parallelizable using Parallelize[]. – David G. Stork – 2014-12-24T17:58:27.120

Answers

6

SumFact[n_: Integer] := Apply[Plus, Map[#[[1]] #[[2]] &, FactorInteger[n]]];
A = {};
lastFac = SumFact[10^7 - 1];
Do[
  If[(z = SumFact[n]) == lastFac, AppendTo[A, n]];
  lastFac = z, 
  {n, 10^7 + 1, 10^8, 2}];
A

This took about 15 minutes on my MacPro and gave 417 candidates. There should be no problem parallelizing this code and getting up to n = 10^9 in an evening or so.

Then the full test:

fulltest[n_: Integer] := 
 If[SumFact[n - 2] == SumFact[n - 1] == SumFact[n] == SumFact[n + 1] || 
    SumFact[n - 3] == SumFact[n - 2] == SumFact[n - 1] == SumFact[n], 
  n];

Union@(fulltest[#] & /@ A)

{Null}

So there are no examples up to 10^8. I just completed the search: no examples up to 10^9. I'm running the search up to 10^10 over the holiday break.

Of the 7060 even Ruth-Aaron pairs between 10^ and 10^10, alas there are no Ruth-Aaron quadruplets.

David G. Stork

Posted 2014-12-24T01:51:21.087

Reputation: 31 784

Great, David! If you find a quadruple, it will be the first discovered, as far as I can discern from the literature. – Joseph O'Rourke – 2014-12-25T23:48:09.313

1@JosephO'Rourke: I even checked between 10^9 and 10^10 for Ruth-Aaron TRIPLES (testing odd numbers between my found even pairs) and found no such triples. These must be rare indeed! – David G. Stork – 2015-01-02T16:42:20.600

Would it be feasible to search for the tulples using the GPU with its multitude of cores? e.g. via CUDALink or something like it? – QuantumDot – 2015-01-03T06:48:17.850

I believe so, yes. I've parallelized my code for my multi-core Mac Pro, and this speeds things up. I'm not a CUDA expert and have no immediate access to such a processor, but perhaps some ambitious computational number theorist would like to take up the challenge. – David G. Stork – 2015-01-03T14:17:53.983