68bdc54223a6

Problem 44
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 26 Feb 2017 22:01:32 +0000
parents 51bb5533cd82
children e7d5fdbc48b4
branches/tags (none)
files src/euler.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

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