0fc16405aff4

Problem 51 and some cleanup
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 28 Feb 2017 22:12:26 +0000
parents c6dd13c10ce4
children 5ece176de174
branches/tags (none)
files src/euler.lisp

Changes

diff -r c6dd13c10ce4 -r 0fc16405aff4 src/euler.lisp
--- a/src/euler.lisp	Mon Feb 27 17:21:42 2017 +0000
+++ b/src/euler.lisp	Tue Feb 28 22:12:26 2017 +0000
@@ -52,15 +52,18 @@
                           n))))
 
 
+(defun sort< (sequence)
+  (sort sequence #'<))
+
+
 (defun divisors (n)
-  (sort (iterate (for i :from 1 :to (sqrt n))
+  (sort< (iterate (for i :from 1 :to (sqrt n))
                  (when (dividesp n i)
                    (collect i)
                    (let ((j (/ n i)))
                      ;; don't collect the square root twice
                      (unless (= i j)
-                       (collect j)))))
-        #'<))
+                       (collect j)))))))
 
 (defun proper-divisors (n)
   (remove n (divisors n)))
@@ -196,8 +199,8 @@
     (pandigitalp 123 0 3) ; => nil
 
   "
-  (equal (range start (1+ end))
-         (sort (digits integer) #'<)))
+  (equal (irange start end)
+         (sort< (digits integer))))
 
 (defun pandigitals (&optional (start 1) (end 9))
   "Return a list of all `start` to `end` (inclusive) pandigital numbers."
@@ -207,10 +210,17 @@
                         ;; to include those with a 0 first.
                         (unless (zerop (first digits))
                           (gather (digits-to-number digits))))
-                      (range start (1+ end))
+                      (irange start end)
                       :copy nil)))
 
 
+(defun permutations (sequence &key length)
+  (gathering (map-permutations #'gather sequence :length length)))
+
+(defun combinations (sequence &key length)
+  (gathering (map-combinations #'gather sequence :length length)))
+
+
 (defun-inline digits< (n digits)
   "Return whether `n` has fewer than `digits` digits."
   (< (abs n) (expt 10 (1- digits))))
@@ -252,7 +262,7 @@
       (for a :from 1 :below (min c (- p c)))
       (for b = (- p c a))
       (when (pythagorean-triplet-p a b c)
-        (adjoinf result (sort (list a b c) #'<)
+        (adjoinf result (sort< (list a b c))
                  :test #'equal)))
     (finally (return result))))
 
@@ -334,6 +344,16 @@
          (sort (copy-seq list2) sort-predicate)))
 
 
+(defun irange (start end &key (step 1) (key 'identity))
+  "Inclusive `range`."
+  (range start (1+ end) :step step :key key))
+
+
+(defun length= (n sequence)
+  (= n (length sequence)))
+
+
+
 ;;;; Problems -----------------------------------------------------------------
 (defun problem-1 ()
   ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
@@ -397,7 +417,7 @@
     ;; anything divisible by 16 is automatically divisible by 8
     ;; anything divisible by 18 is automatically divisible by 9
     ;; anything divisible by 20 is automatically divisible by 10
-    (with divisors = (range 11 21))
+    (with divisors = (irange 11 20))
     (for i :from 20 :by 20) ; it must be divisible by 20
     (finding i :such-that (every (lambda (n) (dividesp i n))
                                  divisors))))
@@ -415,9 +435,9 @@
   ;; Find the difference between the sum of the squares of the first one hundred
   ;; natural numbers and the square of the sum.
   (flet ((sum-of-squares (to)
-           (sum (range 1 (1+ to) :key #'square)))
+           (sum (irange 1 to :key #'square)))
          (square-of-sum (to)
-           (square (sum (range 1 (1+ to))))))
+           (square (sum (irange 1 to)))))
     (abs (- (sum-of-squares 100) ; apparently it wants the absolute value
             (square-of-sum 100)))))
 
@@ -706,7 +726,7 @@
            (silly-british-letters (n)
              (+ (letters n)
                 (if (has-british-and n) 0 3))))
-    (sum (range 1 (1+ 1000))
+    (sum (irange 1 1000)
          :key #'silly-british-letters)))
 
 (defun problem-18 ()
@@ -843,12 +863,12 @@
   (let* ((limit 28123)
          (abundant-numbers
            (make-hash-set :initial-contents
-                          (remove-if-not #'abundantp (range 1 (1+ limit))))))
+                          (remove-if-not #'abundantp (irange 1 limit)))))
     (flet ((abundant-sum-p (n)
              (iterate (for a :in-hashset abundant-numbers)
                       (when (hset-contains-p abundant-numbers (- n a))
                         (return t)))))
-      (sum (remove-if #'abundant-sum-p (range 1 (1+ limit)))))))
+      (sum (remove-if #'abundant-sum-p (irange 1 limit))))))
 
 (defun problem-24 ()
   ;; A permutation is an ordered arrangement of objects. For example, 3124 is
@@ -1429,7 +1449,7 @@
   ;; The series, 1^1 + 2^2 + 3^3 + ... + 10^10 = 10405071317.
   ;;
   ;; Find the last ten digits of the series, 1^1 + 2^2 + 3^3 + ... + 1000^1000.
-  (-<> (range 1 (1+ 1000))
+  (-<> (irange 1 1000)
     (mapcar #'expt <> <>)
     sum
     (mod <> (expt 10 10))))
@@ -1502,6 +1522,45 @@
         (for (values score winner) = (score i))
         (finding winner :maximizing score)))))
 
+(defun problem-51 ()
+  ;; By replacing the 1st digit of the 2-digit number *3, it turns out that six
+  ;; of the nine possible values: 13, 23, 43, 53, 73, and 83, are all prime.
+  ;;
+  ;; By replacing the 3rd and 4th digits of 56**3 with the same digit, this
+  ;; 5-digit number is the first example having seven primes among the ten
+  ;; generated numbers, yielding the family: 56003, 56113, 56333, 56443, 56663,
+  ;; 56773, and 56993. Consequently 56003, being the first member of this
+  ;; family, is the smallest prime with this property.
+  ;;
+  ;; Find the smallest prime which, by replacing part of the number (not
+  ;; necessarily adjacent digits) with the same digit, is part of an eight prime
+  ;; value family.
+  (labels
+      ((patterns (prime)
+         (iterate (with size = (digits-length prime))
+                  (with indices = (range 0 size))
+                  (for i :from 1 :below size)
+                  (appending (combinations indices :length i))))
+       (apply-pattern-digit (prime pattern new-digit)
+         (iterate (with result = (digits prime))
+                  (for index :in pattern)
+                  (when (and (zerop index) (zerop new-digit))
+                    (leave))
+                  (setf (nth index result) new-digit)
+                  (finally (return (digits-to-number result)))))
+       (apply-pattern (prime pattern)
+         (iterate (for digit in (irange 0 9))
+                  (for result = (apply-pattern-digit prime pattern digit))
+                  (when (and result (primep result))
+                    (collect result))))
+       (apply-patterns (prime)
+         (mapcar (curry #'apply-pattern prime) (patterns prime)))
+       (winnerp (prime)
+         (find-if (curry #'length= 8) (apply-patterns prime))))
+    (-<> (iterate (for i :from 3 :by 2)
+                  (thereis (and (primep i) (winnerp i))))
+      (sort< <>)
+      first)))
 
 (defun problem-52 ()
   ;; It can be seen that the number, 125874, and its double, 251748, contain
@@ -1516,6 +1575,7 @@
                              (orderless-equal digits (digits (* n i))))
                            '(2 3 4 5 6)))))
 
+
 (defun problem-56 ()
   ;; A googol (10^100) is a massive number: one followed by one-hundred zeros;
   ;; 100^100 is almost unimaginably large: one followed by two-hundred zeros.
@@ -1620,8 +1680,9 @@
 (test p48 (is (= 9110846700 (problem-48))))
 (test p49 (is (= 296962999629 (problem-49))))
 (test p50 (is (= 997651 (problem-50))))
+(test p51 (is (= 121313 (problem-51))))
+(test p52 (is (= 142857 (problem-52))))
 
-(test p52 (is (= 142857 (problem-52))))
 (test p56 (is (= 972 (problem-56))))
 (test p74 (is (= 402 (problem-74))))