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))))))
Sunday, April 10, 2016
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))))
(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))
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))
Monday, February 22, 2016
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*)
(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*)
Sunday, February 21, 2016
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*)
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*)
Friday, February 19, 2016
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.
(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.
Wednesday, December 31, 2014
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))
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))
Subscribe to:
Comments (Atom)