Thursday, September 17, 2009

Euler Project 50

The prime 41, can be written as the sum of six consecutive primes:


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];
  

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) 



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