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$
  • $\begingroup$ By "over", do you mean "be greater than"? $\endgroup$ – Michael E2 Feb 26 '18 at 12:33
  • $\begingroup$ @MichaelE2 Oh yes, greater than. i.e., $>$ $\endgroup$ – Eric Feb 26 '18 at 12:34
  • $\begingroup$ Is this a question from the Euler Project? $\endgroup$ – halirutan Feb 26 '18 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 '18 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$ – Daniel Lichtblau Feb 26 '18 at 16:41
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$
  • $\begingroup$ The recursion method is pedagogical! $\endgroup$ – Eric Feb 26 '18 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$
  • $\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$ – Henrik Schumacher Feb 26 '18 at 13:35
  • $\begingroup$ @HenrikSchumacher ah, that makes more sense $\endgroup$ – Kuba Feb 26 '18 at 13:37
  • $\begingroup$ @HenrikSchumacher after Michael's comment I undeleted it :) $\endgroup$ – Kuba Feb 26 '18 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 '18 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$
1
$\begingroup$
NestWhile[{#[[1]] + Prime[#[[2]]]^2, ++(#[[2]]), Prime[#[[2]]]} &, {1,
     1, 1}, #[[1]] < 10^10 &]

(*   {10025552443, 824, 6323}   *)
$\endgroup$
  • 1
    $\begingroup$ This Sum[Prime[i]^2, {i, 823}] tells me that you have not found the smallest p. $\endgroup$ – halirutan Feb 26 '18 at 14:03
  • $\begingroup$ 824 summands, but Prime[i] up to i== 823, p==6323, 1+Sum... ==10025552443 $\endgroup$ – Akku14 Feb 26 '18 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 '18 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 '18 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 '18 at 17:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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