Sunday, April 10, 2016

Project Euler Problem 49 Common Lisp

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