Project Euler Problem 45 Common Lisp

Project Euler Problem 45

Note: all hexagonal numbers are triangle numbers.  The function typep is used to see if the formula in the function pentagonal? is a natural number (integer).  Function problem45 increments up from 144, because the problem statement for Project Euler 45 already provides a hexagonal number 40755 (that's also a pentagonal and triangle number) using the integer 143.

(defun pentagonal? (num)
  (typep
    (/ (1+ (sqrt (1+ (* 24 num)))) 6)
    'integer))

(defun problem45 ()
  (loop for i upfrom 144
        for hex = (- (* 2 i i) i)
        when (pentagonal? hex) return hex))

Project Euler Problem 23 Common Lisp

Project Euler Problem 23

(defun abundantp (num)
  (< num
     (loop for i from 1 to (floor num 2)
           if (zerop (mod num i))
           sum i)))

(defun abundants ()
  (loop for i from 12 to 28123
        if (abundantp i)
        collect i))

(defun sum-abundants ()
  (let ((abun (abundants)) (tmp 0))
    (reduce #'+
            (remove-duplicates
              (loop for i in abun
                    nconc (loop for j in abun
                                when (>= j i)
                                when (<= (setf tmp (+ i j)) 28123)
                                collect tmp))))))

(defun problem23 ()
  (- (loop for i from 1 to 28123 sum i)
     (sum-abundants)))

Project Euler Problem 21 Common Lisp

Project Euler Problem 21

(defun d (num)
  (+ 1
     (loop for i from 2 to (isqrt num)
           if (zerop (mod num i))
           sum i
           and sum (/ num i))))

(defun problem21 ()
  (loop for i from 1 below 10000
        for j = (d i)
        if (and (/= i j) (= i (d j)))
        sum i))

Project Euler Problem 20 Common Lisp

Project Euler Problem 20

(defun sum-digits (x &optional (sum 0))
  (multiple-value-bind (m n)
    (truncate x 10)
    (if (zerop m)
      (+ n sum)
      (sum-digits m (+ n sum)))))

(defun problem20 ()
  (sum-digits
    (reduce #'* (loop for i from 1 to 100 collect i))))

Project Euler Problem 16 Common Lisp

Project Euler Problem 16

(defun sum-digits (x &optional (sum 0))
  (multiple-value-bind (m n)
    (truncate x 10)
    (if (zerop m)
      (+ n sum)
      (sum-digits m (+ n sum)))))

(defun problem16 ()
  (sum-digits (expt 2 1000)))

Project Euler Problem 15 Common Lisp

Project Euler Problem 15

(defun factorial (num)
  (reduce #'*
          (loop for i from 2 to num collect i)))

(defun problem15 ()
  (/ (factorial (* 2 20))
     (expt (factorial 20) 2)))

Project Euler Problem 14 Common Lisp

Project Euler Problem 14

This solution is brute force but still took less that 4 seconds on my computer to return the answer.  Note, because the function position is zero based, I had to cons a zero onto the functions list parameter in order to get the correct answer.

(defun chain-length (n)
  (loop for i = n then (if (oddp i)
                         (1+ (* 3 i))
                         (/ i 2))
        counting i
        while (/= i 1)))

(defun problem14 ()
  (loop for i from 1 to 999999
        collect (chain-length i) into lst
        finally (return (position
                          (reduce #'max lst)
                          (cons 0 lst)))))