Project Euler Problem 49
(defun digits-to-list (x &optional (lst nil))
(multiple-value-bind (a b)
(truncate x 10)
(if (zerop a)
(cons b lst)
(digits-to-list a (cons b lst)))))
(defun prime? (num)
(cond ((= 2 num) num)
((= 3 num) num)
((< num 1) nil)
((evenp num) nil)
((zerop (mod num 3)) nil)
(t (loop for i from 5 to (isqrt num) by 6
if (or (zerop (mod num i))
(zerop (mod num (+ i 2)))) return nil
finally (return num)))))
(defun primes (num)
(append '(2 3)
(loop for i from 5 to num by 6
if (prime? i) collect it
if (prime? (+ i 2)) collect it)))
(defun perm? (x y z)
(let ((a (sort (digits-to-list x) #'<))
(b (sort (digits-to-list y) #'<))
(c (sort (digits-to-list z) #'<)))
(and (equal a b) (equal b c))))
(defun four-digit-perms ()
(loop with primes2 = (delete 1000 (primes 9999) :test #'>)
for a in primes2
nconc (loop for b in primes2
nconc (loop for c in primes2
while (> a b c)
when (= (- a b) (- b c))
when (perm? a b c)
collect (list c b a)))))
(defun problem49 ()
(format nil "The answer to Project Euler problem 49 is ~{~a~}"
(remove-if-not #'stringp
(mapcar #'write-to-string
(second (four-digit-perms))))))
No comments:
Post a Comment