41 = 2 + 3 + 5 + 7 + 11 + 13
This is the longest sum of consecutive primes that adds to a prime below one-hundred.
The longest sum of consecutive primes below one-thousand that adds to a prime, contains 21 terms, and is equal to 953.
Which prime, below one-million, can be written as the sum of the most consecutive primes?
My Solution Using Mathematica
MyPrimesList = Table[Prime[i], {i, PrimePi[1000000]}]
MostLength = 0; CurrentPrimes = 2; TempValue = 0; TempCount = 0;For[i = 1, i < 10000, i++, TempValue = 0; TempCount = 0;
For[j = i, j < 10000, j++, TempCount = TempCount + 1;
TempValue = TempValue + MyPrimesList[[j]];
If[TempValue > 1000000, Break[]];
If[PrimeQ[TempValue], If[TempCount > MostLength, MostLength = TempCount; CurrentPrimes = i]]]
Others' Solution
First Solution
(defun sieve (lst)
(let ((primes '())
(last (car (last lst))))
(loop while (and lst (> last (* (car lst) (car lst))))
do (let ((factor (car lst)))
(setq primes (cons factor primes))
(setq lst (remove-if
#'(lambda (n)
(= (mod n factor) 0))
(cdr lst)))))
(append (reverse primes) lst)))
(defun seq-list (min max)
(loop for i from min to max collect i))
(defun all-primes (limit)
(sieve (seq-list 2 limit)))
(defun generate-all-primes (limit)
(setq all-primes (all-primes limit))
(setq primehash (make-hash-table))
(loop for p in all-primes
do (setf (gethash p primehash) p)))
(defun primep (p)
(gethash p primehash))
(defun generate-prime-sums (limit)
(setq primesumhash (make-hash-table))
(generate-all-primes limit)
(loop for allp on all-primes
do (loop for p in allp
sum p into pp
while (< pp limit)
append (list p) into pl
if (and (primep pp)
(> (length pl)
(length (gethash pp primesumhash '()))))
do (setf (gethash pp primesumhash) (copy-list pl)))))
(defun euler50 ()
(generate-prime-sums 1000000)
(let ((psums (loop for p being each hash-key of primesumhash
append (list (cons p (gethash p primesumhash))))))
(sort psums #'(lambda (a b) (< (length a) (length b))))
(car (last psums))))
Second Solution
p = Prime /@ Range @ 78498;
partialsums = Rest@FoldList[Plus, 0, p];
partialsums = Rest@FoldList[Plus, 0, p];
total[a_, b_] :=
p[[a]] + ( partialsums[[b]] - partialsums[[a]])
inrange[a_, b_] :=
total[a, b] < 1000000
hunt[width_] := Module[{a, b, n},
{a, b} = {1, width};
n = Length@ partialsums ;
While[b < n && inrange[a, b],
If[PrimeQ@total[a, b], Return[{a, b}]];
{a, b} += {1, 1};
];
Return@{}
]
]
total@@Last@Select[hunt/@Range[1, 1000], Length@# > 0&]
Third Solution
Fourth Solution
(defun longest-cons-primesum (prime-list below)
(do* ((data prime-list (rest data))
(zwischen (loop for i in data
summing i into summe
while (< summe below)
counting i into lang
if (member summe data)
collecting (list lang summe))
(loop for i in data
summing i into summe
while (< summe below)
counting i into lang
if (member summe data)
collecting (list lang summe)))
(result zwischen (if (> (caar (last zwischen))
(caar (last result)))
zwischen
result)))
((> (reduce #'+ (subseq data 0 (caar (last result)))) below)
(last result))))
With this function you just have to generate the data and call it.
(defvar primes-below-million
(loop for i from 1 to 1000000 if (primep i) collecting i))
This takes around 12 seconds.
(longest-cons-primesum primes-below-million 1000000)
(do* ((data prime-list (rest data))
(zwischen (loop for i in data
summing i into summe
while (< summe below)
counting i into lang
if (member summe data)
collecting (list lang summe))
(loop for i in data
summing i into summe
while (< summe below)
counting i into lang
if (member summe data)
collecting (list lang summe)))
(result zwischen (if (> (caar (last zwischen))
(caar (last result)))
zwischen
result)))
((> (reduce #'+ (subseq data 0 (caar (last result)))) below)
(last result))))
With this function you just have to generate the data and call it.
(defvar primes-below-million
(loop for i from 1 to 1000000 if (primep i) collecting i))
This takes around 12 seconds.
(longest-cons-primesum primes-below-million 1000000)
Fifth Solution
(defun length-prime-sum-sequence (n0 max)
(let ((sum 0)
(seq-length 0))
(iter (for i from n0 below (length *primes*))
(for p = (aref *primes* i))
(for s first p then (+ s p))
(if (>= s max)
(finish))
(when (primep s)
(setq sum s)
(setq seq-length (- i n0)))
(finally (return (values (1+ seq-length) sum)))))))
(defun longest-sum-sequence (max)
(iter (for i from 0 below max)
(for (values length sum) = (length-prime-sum-sequence i max))
(finding (list length sum) maximizing length)))
No comments:
Post a Comment