964ca82e487d

Problem 60
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 03 Mar 2017 12:43:00 +0000
parents e8225b1bc2b6
children b1656a023096
branches/tags (none)
files .lispwords src/euler.lisp src/primes.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/.lispwords	Thu Mar 02 22:16:13 2017 +0000
+++ b/.lispwords	Fri Mar 03 12:43:00 2017 +0000
@@ -1,1 +1,2 @@
 (1 repeat)
+(1 labels-memoized)
--- a/src/euler.lisp	Thu Mar 02 22:16:13 2017 +0000
+++ b/src/euler.lisp	Fri Mar 03 12:43:00 2017 +0000
@@ -371,6 +371,21 @@
   (digits-to-number (nreverse (digits n))))
 
 
+(defmacro labels-memoized (definitions &body body)
+  (let ((caches (mapcar #'gensym (range 0 (length definitions)))))
+    (flet ((build (cache definition)
+             (destructuring-bind (name lambda-list &body body) definition
+               `(,name ,lambda-list
+                 (values
+                   (ensure-gethash (list ,@lambda-list) ,cache
+                                   (progn ,@body)))))))
+      `(let (,@(iterate (for cache :in caches)
+                        (collect `(,cache (make-hash-table :test #'equal)))))
+         (labels (,@(mapcar #'build caches definitions))
+           ,@body)))))
+
+
+
 ;;;; Problems -----------------------------------------------------------------
 (defun problem-1 ()
   ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
@@ -1806,6 +1821,7 @@
              (remove-if-not (curry #'hset-contains-p words) <>)
              length))
          (answer (keyword)
+           ;; (pr (stringify keyword)) ; keyword is "god", lol
            (sum (apply-cipher keyword))))
       (iterate (for-nested ((a :from (char-code #\a) :to (char-code #\z))
                             (b :from (char-code #\a) :to (char-code #\z))
@@ -1813,6 +1829,39 @@
                (for keyword = (list a b c))
                (finding (answer keyword) :maximizing (score-keyword keyword))))))
 
+(defun problem-60 ()
+  ;; The primes 3, 7, 109, and 673, are quite remarkable. By taking any two
+  ;; primes and concatenating them in any order the result will always be prime.
+  ;; For example, taking 7 and 109, both 7109 and 1097 are prime. The sum of
+  ;; these four primes, 792, represents the lowest sum for a set of four primes
+  ;; with this property.
+  ;;
+  ;; Find the lowest sum for a set of five primes for which any two primes
+  ;; concatenate to produce another prime.
+  (labels-memoized ((concatenates-prime-p (a b)
+                      (and (primep (concatenate-integers a b))
+                           (primep (concatenate-integers b a)))))
+    (flet ((satisfiesp (prime primes)
+             (every (curry #'concatenates-prime-p prime) primes)))
+      (iterate
+        main
+        ;; 2 can never be part of the winning set, because if you concatenate it
+        ;; in the last position you get an even number.
+        (with primes = (subseq (sieve 10000) 1))
+        (for a :in-vector primes :with-index ai)
+        (iterate
+          (for b :in-vector primes :with-index bi :from (1+ ai))
+          (when (satisfiesp b (list a))
+            (iterate
+              (for c :in-vector primes :with-index ci :from (1+ bi))
+              (when (satisfiesp c (list a b))
+                (iterate
+                  (for d :in-vector primes :with-index di :from (1+ ci))
+                  (when (satisfiesp d (list a b c))
+                    (iterate
+                      (for e :in-vector primes :from (1+ di))
+                      (when (satisfiesp e (list a b c d))
+                        (in main (return-from problem-60 (+ a b c d e)))))))))))))))
 
 
 (defun problem-74 ()
@@ -1943,9 +1992,10 @@
 (test p57 (is (= 153 (problem-57))))
 (test p58 (is (= 26241 (problem-58))))
 (test p59 (is (= 107359 (problem-59))))
+(test p60 (is (= 26033 (problem-60))))
 
 (test p74 (is (= 402 (problem-74))))
 (test p145 (is (= 608720 (problem-145))))
 
 
-(run! :euler)
+;; (run! :euler)
--- a/src/primes.lisp	Thu Mar 02 22:16:13 2017 +0000
+++ b/src/primes.lisp	Fri Mar 03 12:43:00 2017 +0000
@@ -90,7 +90,7 @@
         :while (dividesp d factor)
         :finally (return (values e d))))
 
-(defun miller-rabin-prime-p (n &optional (k 10))
+(defun miller-rabin-prime-p (n &optional (k 11))
   "Return whether `n` might be prime.
 
   If `t` is returned, `n` is probably prime.
--- a/vendor/make-quickutils.lisp	Thu Mar 02 22:16:13 2017 +0000
+++ b/vendor/make-quickutils.lisp	Fri Mar 03 12:43:00 2017 +0000
@@ -8,6 +8,7 @@
                :curry
                :define-constant
                :ensure-boolean
+               :ensure-gethash
                :equivalence-classes
                :map-combinations
                :map-permutations
--- a/vendor/quickutils.lisp	Thu Mar 02 22:16:13 2017 +0000
+++ b/vendor/quickutils.lisp	Fri Mar 03 12:43:00 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 :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :MAP-PERMUTATIONS :MAXF :MINF :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 :ENSURE-GETHASH :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :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")
@@ -15,11 +15,11 @@
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
                                          :COMPOSE :CURRY :DEFINE-CONSTANT
-                                         :ENSURE-BOOLEAN :EQUIVALENCE-CLASSES
-                                         :MAP-COMBINATIONS :MAP-PERMUTATIONS
-                                         :MAXF :MINF :TAKE :N-GRAMS :RANGE
-                                         :RCURRY :ONCE-ONLY :WITH-OPEN-FILE*
-                                         :WITH-INPUT-FROM-FILE
+                                         :ENSURE-BOOLEAN :ENSURE-GETHASH
+                                         :EQUIVALENCE-CLASSES :MAP-COMBINATIONS
+                                         :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
                                          :EXTRACT-FUNCTION-NAME :SWITCH))))
@@ -138,6 +138,16 @@
     (and x t))
   
 
+  (defmacro ensure-gethash (key hash-table &optional default)
+    "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
+under key before returning it. Secondary return value is true if key was
+already in the table."
+    `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
+       (if ok
+           (values value ok)
+           (values (setf (gethash ,key ,hash-table) ,default) nil))))
+  
+
   (defun equivalence-classes (equiv seq)
     "Partition the sequence `seq` into a list of equivalence classes
 defined by the equivalence relation `equiv`."
@@ -491,9 +501,9 @@
     (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 equivalence-classes
-            map-combinations map-permutations maxf minf n-grams range rcurry
-            read-file-into-string switch eswitch cswitch with-gensyms
-            with-unique-names)))
+  (export '(compose curry define-constant ensure-boolean ensure-gethash
+            equivalence-classes map-combinations map-permutations maxf minf
+            n-grams range rcurry read-file-into-string switch eswitch cswitch
+            with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;