6
$\begingroup$

How to solve the problem:

When will $1^2+2^2+3^2+5^2+7^2+11^2+13^2+\cdots\cdots + p^2$ (where every base and $p$ are prime, except the base of the first term $1$) be greater than $10^{10}$? (Namely, solve for such smallest $p$)

I can come up with several ugly solutions which are not quite satisfying for me. And also this can be easily written by an explicit loop, but I think it should be the last strategy to use. Hmm... I think if there's a Fold-family function that similar to TakeWhile, called FoldWhile, which can iteratively Fold until some condition is satisfied/unsatisfied at the moment, then it may probably be the most ideal solution. However, there's no such function.

$\endgroup$
9
  • $\begingroup$ By "over", do you mean "be greater than"? $\endgroup$
    – Michael E2
    Feb 26, 2018 at 12:33
  • $\begingroup$ @MichaelE2 Oh yes, greater than. i.e., $>$ $\endgroup$
    – Eric
    Feb 26, 2018 at 12:34
  • $\begingroup$ Is this a question from the Euler Project? $\endgroup$
    – halirutan
    Feb 26, 2018 at 12:38
  • $\begingroup$ @halirutan I don't remember... It is a question from my self notes of MMA 2 years ago.. But I did solve some Project Euler problems in the past, so I guess the problem is less or more motivated by PE problems but suggested by me. $\endgroup$
    – Eric
    Feb 26, 2018 at 12:40
  • 1
    $\begingroup$ A bit off topic, but one can get a decent approximation from int[k_?NumberQ] := NIntegrate[n^2*(Log[n] + Log[Log[n]] - 1)^2, {n, 1, k}] FindRoot[int[k] == 10^10, {k, 100}]. $\endgroup$ Feb 26, 2018 at 16:41

5 Answers 5

5
$\begingroup$

Since you mentioned TakeWhile and FoldWhile, let me first give you a one-line with NestWhile:

NestWhile[With[{c=First[#]+1,s=Last[#]},{c,s+Prime[c]^2}]&,{1,1},#[[2]]<10^10&]
(* {823, 10025552438} *)

What follows is my original answer that shows binary search which is not the most appropriate thing in this situation but still very fast. Consider the vector {a,b,c} and note that the dot-product of it with itself is a^2+b^2+c^2. This naturally leads to a simple function that calculates your sum of prime squares:

f[n_] := #.# &[Prime[Range[n]]]

A quick check shows that an upper bound is n=1000. Now, implement a quick binary search which will converge fast:

search[_, _, lo_, hi_] := {lo + 1, Prime[lo + 1]} /; hi - lo <= 1;
search[f_, goal_, lo_, hi_] := With[{cent = Round[(hi + lo)/2]},
  If[f[cent] > goal,
   search[f, goal, lo, cent],
   search[f, goal, cent, hi]
   ]
  ]

It starts with a lower and upper bound and always divides this range.

search[f, 10^10, 10, 1000] // AbsoluteTiming
(* {0.00287, {823, 6323}} *)

So the answer is $2^2+3^2\ldots+p_{823}^2$. Note, that I violated your definition since I'm only summing real primes and don't include the 1. The answer is still correct though :) Quick check

f[823]
(* 10025552442 *)

and

f[822]
(* 9985572113 *)

seems correct. You should note that it only took exactly 10 steps. You can show this by introducing a step-variable that is incremented.

$\endgroup$
1
  • $\begingroup$ The recursion method is pedagogical! $\endgroup$
    – Eric
    Feb 26, 2018 at 15:15
4
$\begingroup$

Is that it or did I make a silly mistake?

n = 0;
sum = 1; (*for 1^1*)
While[
 sum < 10^10,
 sum += Prime[++n]^2
]

sum          (*10025552443*)
n            (*823*)
Prime[n]     (*6323*) 
$\endgroup$
4
  • $\begingroup$ Kuba, since $1^2$ appears in the sum I think it is only about summing all squares of odd numbers up to the $n$th prime. However, the question is rather ambiguous... $\endgroup$ Feb 26, 2018 at 13:35
  • $\begingroup$ @HenrikSchumacher ah, that makes more sense $\endgroup$
    – Kuba
    Feb 26, 2018 at 13:37
  • $\begingroup$ @HenrikSchumacher after Michael's comment I undeleted it :) $\endgroup$
    – Kuba
    Feb 26, 2018 at 14:03
  • $\begingroup$ @Kuba Thanks. Is using While the almost most proper way in this case? In MMA literature, it seems that to use explicit loop is not so preferred in most cases. $\endgroup$
    – Eric
    Feb 26, 2018 at 14:49
3
$\begingroup$

you can try this:

For[{s = 1, n = 1}, s < 10^10, n++, s = s + Prime[n]^2]; {Prime[n - 1],s}
$\endgroup$
2
$\begingroup$

A Lazy approach,

sqPrimesLazy = Map[{1, Prime[#]^2} &, Lazy[Integers]];
sqPrimesSumLazy = FoldList[Plus, {0, 1}, sqPrimesLazy];
Select[sqPrimesSumLazy, #[[2]] > 10^10 &] // First

{823, 10025552443}

Subsequently, the value of p can be obtained as Prime[823] = 6323

Check this post for more on Lazy evaluation in MMA.

$\endgroup$
0
1
$\begingroup$
NestWhile[{#[[1]] + Prime[#[[2]]]^2, ++(#[[2]]), Prime[#[[2]]]} &, {1,
     1, 1}, #[[1]] < 10^10 &]

(*   {10025552443, 824, 6323}   *)
$\endgroup$
5
  • 1
    $\begingroup$ This Sum[Prime[i]^2, {i, 823}] tells me that you have not found the smallest p. $\endgroup$
    – halirutan
    Feb 26, 2018 at 14:03
  • $\begingroup$ 824 summands, but Prime[i] up to i== 823, p==6323, 1+Sum... ==10025552443 $\endgroup$
    – Akku14
    Feb 26, 2018 at 14:22
  • 1
    $\begingroup$ Why don't you add a line of text then that says so instead of simply posting a line of code? Furthermore and more importantly, you should get rid of the ++#[[2]] because this is semantically wrong. It is the reason why your code throws so many error messages. You cannot do ++4 because the operand of ++ needs to be a variable. $\endgroup$
    – halirutan
    Feb 26, 2018 at 14:33
  • $\begingroup$ Is collecting information within a multiple list (e.g., your {1,1,1}) a commonly seen way used by people? I feel that long times later we would have chance forget the meanings (and order) of what {1,1,1} represents. $\endgroup$
    – Eric
    Feb 26, 2018 at 14:46
  • $\begingroup$ With MMA Version 8.0 ++u[[2]] works fine and does not produce any error messages. ++4of course does not work. $\endgroup$
    – Akku14
    Feb 26, 2018 at 17:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.