Project Euler Problem 67 Common Lisp

Project Euler Problem 67

(defparameter *data*
  (with-open-file (input "p067_triangle.txt")
    (loop for line = (read-line input nil nil)
          while line
          collect (read-from-string
                    (concatenate 'string "(" line ")")))))

The above code for converting lines in a text file into a nested list came from here.

(defun bottom-up-max (a b)
  (mapcar #'max
          (mapcar #'+ a b)
          (mapcar #'+ (rest a) b)))

(defun problem67 (lst)
  (first (reduce #'bottom-up-max (reverse lst))))

To get the solution, evaluate:

(problem67 *data*)

Project Euler Problem 18 Common Lisp

Project Euler Problem 18

The idea for the solution below came from Stackoverflow.  Working from "bottom to top", *data* is reversed in function problem18.

 (defparameter *data*
                   '((75)
                    (95 64)
                    (17 47 82)
                    (18 35 87 10)
                    (20 04 82 47 65)
                    (19 01 23 75 03 34)
                    (88 02 77 73 07 63 67)
                    (99 65 04 28 06 16 70 92)
                    (41 41 26 56 83 40 80 70 33)
                    (41 48 72 33 47 32 37 16 94 29)
                    (53 71 44 65 25 43 91 52 97 51 14)
                    (70 11 33 28 77 73 17 78 39 68 17 57)
                    (91 71 52 38 17 14 91 43 58 50 27 29 48)
                    (63 66 04 68 89 53 67 30 73 16 69 87 40 31)
                    (04 62 98 27 23 09 70 98 73 93 38 53 60 04 23)))

(defun bottom-up-max (a b)
  (mapcar #'max
          (mapcar #'+ a b)
          (mapcar #'+ (rest a) b)))

(defun problem18 (lst)
  (first (reduce #'bottom-up-max (reverse lst))))

To get the solution, evaluate:
 
(problem18 *data*)

Project Euler Problem 11 Common Lisp

Project Euler Problem 11

(defparameter *data*
  '((08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08)
    (49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00)
    (81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65)
    (52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91)
    (22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80)
    (24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50)
    (32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70)
    (67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21)
    (24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72)
    (21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95)
    (78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92)
    (16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57)
    (86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58)
    (19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40)
    (04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66)
    (88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69)
    (04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36)
    (20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16)
    (20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54)
    (01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48)))

(defun multiply-first-4 (lst)
  (if (> 4 (length lst))
      0
      (reduce #'* (subseq lst 0 4))))

(defun all-multiples (lst)
  (maplist #'multiply-first-4 lst))

(defun all-horizontals (lst)
  (mapcan #'all-multiples lst))

(defun all-verticals (lst)
  (all-horizontals (apply #'mapcar #'list lst)))

(defun %all-left-diagonals (lst &optional (n 0))
  (if (< n 4)
      (cons (nthcdr n (car lst))
            (%all-left-diagonals (cdr lst) (1+ n)))
      nil))

(defun all-left-diagonals (lst)
  (mapcon #'(lambda (x) (all-verticals (%all-left-diagonals x)))
          lst))

(defun all-right-diagonals (lst)
  (all-left-diagonals (reverse lst)))

(defun problem11 ()
  (reduce #'max (append (all-horizontals *data*)
                        (all-verticals *data*)
                        (all-left-diagonals *data*)
                        (all-right-diagonals *data*))))


Function multiply-first-4 returns the multiplication of the first 4 elements of a list, or it returns 0 if the list has less than 4 elements--otherwise the function will error out.  Better to just simply return 0 then the code complexity for handling a list with less than 4 elements.

Function all-multiples takes a list of say (1 2 3 4 5 6 7) turning it into ((1 2 3 4 5 6 7) (2 3 4 5 67) (3 4 5 6 7) (4 5 6 7) (5 6 7) (6 7) (7)).  It then takes that and applies multiply-first-4 to each of the lists within, resulting in (24 120 360 840 0 0 0).

Function all-horizontals applies all-multiples to a list of list, like *data* above, returning a flat list of all multiplications of 4 elements from left to right (and right to left simultaneously).

Function all-verticals takes a list of list and transposes it.  For example ((1 2 3) (4 5 6) ( 7 8 9)) becomes ((1 4 7) (2 5 8) (3 6 9)).  all-verticals applies that transposed list to all-horizontals.  The result is a flat list of all multiplications of 4 elements going up and down.  Transposing the list is a trick taken from Stackoverflow.

Function all-left-diagonals uses %all-left-diagonals to turn a list like ((1 2 3) (4 5 6) (7 8 9)) into ((1 2 3) (5 6) (9)) and applies it to all-verticals.  The result is a flat list of all multiplications of 4 elements going diagonal, from upper left to lower right.

Function all-right-diagonals reverses a list of lists, ((1 2 3) (4 5 6) (7 8 9)) becoming ((7 8 9) (4 5 6) (1 2 3)), and applies it to all-left-diagonals.  Thus resulting in a flat list of all multiplications of 4 elements going diagonal, from lower left to upper right.

Function problem11 takes all of these flat lists, appends them, and then finds the maximum.

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