# HG changeset patch # User Steve Losh # Date 1488146492 0 # Node ID 68bdc54223a6c6e01dfb6dc9aec5ad49aa67b58a # Parent 51bb5533cd821c68880d3c086674a96dc97cd094 Problem 44 diff -r 51bb5533cd82 -r 68bdc54223a6 src/euler.lisp --- a/src/euler.lisp Sat Feb 25 17:42:31 2017 +0000 +++ b/src/euler.lisp Sun Feb 26 22:01:32 2017 +0000 @@ -301,7 +301,7 @@ (defun pentagonp (n) ;; We can ignore the - branch of the quadratic equation because negative ;; numbers aren't indexes. - (dividesp (+ 1 (sqrt (1+ (* 24 n)))) 6)) + (dividesp (+ 1 (sqrt (1+ (* 24.0d0 n)))) 6)) (defun parse-strings-file (filename) @@ -1305,6 +1305,44 @@ (dividesp (extract3 digits 7) 17))))) (sum (remove-if-not #'interestingp (pandigitals 0 9))))) +(defun problem-44 () + ;; Pentagonal numbers are generated by the formula, Pn=n(3nāˆ’1)/2. The first + ;; ten pentagonal numbers are: + ;; + ;; 1, 5, 12, 22, 35, 51, 70, 92, 117, 145, ... + ;; + ;; It can be seen that P4 + P7 = 22 + 70 = 92 = P8. However, their difference, + ;; 70 āˆ’ 22 = 48, is not pentagonal. + ;; + ;; Find the pair of pentagonal numbers, Pj and Pk, for which their sum and + ;; difference are pentagonal and D = |Pk āˆ’ Pj| is minimised; what is the value + ;; of D? + (flet ((interestingp (px py) + (and (pentagonp (+ py px)) + (pentagonp (- py px))))) + (iterate + (with result = most-positive-fixnum) ; my kingdom for `CL:INFINITY` + (for y :from 2) + (for z :from 3) + (for py = (pentagon y)) + (for pz = (pentagon z)) + (when (>= (- pz py) result) + (return result)) + (iterate + (for x :from (1- y) :downto 1) + (for px = (pentagon x)) + (when (interestingp px py) + (let ((distance (- py px))) + (when (< distance result) + ;; TODO: This isn't quite right, because this is just the FIRST + ;; number we find -- we haven't guaranteed that it's the SMALLEST + ;; one we'll ever see. But it happens to accidentally be the + ;; correct one, and until I get around to rewriting this with + ;; priority queues it'll have to do. + (return-from problem-44 distance) + (setf result distance))) + (return)))))) + ;;;; Tests -------------------------------------------------------------------- (def-suite :euler) @@ -1353,6 +1391,7 @@ (test p41 (is (= 7652413 (problem-41)))) (test p42 (is (= 210 (problem-42)))) (test p43 (is (= 16695334890 (problem-43)))) +(test p44 (is (= 5482660 (problem-44)))) ;; (run! :euler) diff -r 51bb5533cd82 -r 68bdc54223a6 vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Sat Feb 25 17:42:31 2017 +0000 +++ b/vendor/make-quickutils.lisp Sun Feb 26 22:01:32 2017 +0000 @@ -9,6 +9,8 @@ :define-constant :ensure-boolean :map-permutations + :maxf + :minf :n-grams :range :rcurry diff -r 51bb5533cd82 -r 68bdc54223a6 vendor/quickutils.lisp --- a/vendor/quickutils.lisp Sat Feb 25 17:42:31 2017 +0000 +++ b/vendor/quickutils.lisp Sun Feb 26 22:01:32 2017 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :MAP-PERMUTATIONS :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :MAP-PERMUTATIONS :MAXF :MINF :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "EULER.QUICKUTILS") @@ -16,8 +16,8 @@ (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :MAP-COMBINATIONS - :MAP-PERMUTATIONS :TAKE :N-GRAMS - :RANGE :RCURRY :ONCE-ONLY + :MAP-PERMUTATIONS :MAXF :MINF :TAKE + :N-GRAMS :RANGE :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :STRING-DESIGNATOR :WITH-GENSYMS @@ -230,6 +230,16 @@ :copy nil))))))) + (define-modify-macro maxf (&rest numbers) max + "Modify-macro for `max`. Sets place designated by the first argument to the +maximum of its original value and `numbers`.") + + + (define-modify-macro minf (&rest numbers) min + "Modify-macro for `min`. Sets place designated by the first argument to the +minimum of its original value and `numbers`.") + + (defun take (n sequence) "Take the first `n` elements from `sequence`." (subseq sequence 0 n)) @@ -454,8 +464,8 @@ (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH."))) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(compose curry define-constant ensure-boolean map-permutations - n-grams range rcurry read-file-into-string switch eswitch cswitch - with-gensyms with-unique-names))) + (export '(compose curry define-constant ensure-boolean map-permutations maxf + minf n-grams range rcurry read-file-into-string switch eswitch + cswitch with-gensyms with-unique-names))) ;;;; END OF quickutils.lisp ;;;;