Project Euler Problem 48 Common Lisp

Project Euler Problem 48

(defun problem48 ()
  (nth-value 1 (truncate (loop for i from 1 to 1000
                               sum (expt i i))
                         (expt 10 10))))

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))))))

Project Euler Problem 50 Common Lisp

Project Euler Problem 50

(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 prime-sums (num)
  (loop for i in (primes num)
     sum i into j
     unless (< num j)
     collect j))

(defun sum-of-consecutive-primes (num)
  (loop with sums = (prime-sums num)
       for i in sums
       collect (member-if #'prime?
              (loop for j in (cons 0 sums)
                   while (> i j)
                   collect (- i j)))))

(defun longest-sum-of-consecutive-primes (num)
  (let ((x (sort (sum-of-consecutive-primes num)
                 #'>
                 :key #'length)))
    (list (caar x) (length (first x)))))

(defun problem50 ()
  (let ((x (longest-sum-of-consecutive-primes 1000000)))
    (format t "The answer to Problem 50 is ~A with ~A terms."
            (first x) (second x))))

Project Euler Problem 46 Common Lisp

Project Euler Problem 46

Note that all square integers from 1 to some number can be found by summing all the odd numbers, e.g. 2 *2 = 4 = 1 + 3, 3 * 3 = 9 = 1 + 3 + 5, 4 * 4 = 16 = 1 + 3 + 5 + 7.  That's what is happening in function conjecture-false?

(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 conjecture-false? (num)
  (loop for i from 1 to num by 2
       sum i into j
       if (prime? (- num (* j 2))) return nil
       finally (return t)))

(defun problem46 ()
  (loop for i upfrom 1 by 2
       unless (prime? i)
       when (conjecture-false? i) return i))