--- a/src/euler.lisp Mon Feb 27 01:34:12 2017 +0000
+++ b/src/euler.lisp Mon Feb 27 16:13:36 2017 +0000
@@ -1434,6 +1434,42 @@
sum
(mod <> (expt 10 10))))
+(defun problem-49 ()
+ ;; The arithmetic sequence, 1487, 4817, 8147, in which each of the terms
+ ;; increases by 3330, is unusual in two ways: (i) each of the three terms are
+ ;; prime, and, (ii) each of the 4-digit numbers are permutations of one
+ ;; another.
+ ;;
+ ;; There are no arithmetic sequences made up of three 1-, 2-, or 3-digit
+ ;; primes, exhibiting this property, but there is one other 4-digit increasing
+ ;; sequence.
+ ;;
+ ;; What 12-digit number do you form by concatenating the three terms in this
+ ;; sequence?
+ (labels ((permutation= (a b)
+ (orderless-equal (digits a) (digits b)))
+ (length>=3 (list)
+ (>= (length list) 3))
+ (arithmetic-sequence-p (seq)
+ (apply #'= (mapcar (curry #'apply #'-)
+ (n-grams 2 seq))))
+ (has-arithmetic-sequence-p (seq)
+ (map-combinations
+ (lambda (s)
+ (when (arithmetic-sequence-p s)
+ (return-from has-arithmetic-sequence-p s)))
+ (sort seq #'<)
+ :length 3)
+ nil))
+ (-<> (primes-in 1000 9999)
+ (equivalence-classes #'permutation= <>) ; find all permutation groups
+ (remove-if-not #'length>=3 <>) ; make sure they have at leat 3 elements
+ (mapcar #'has-arithmetic-sequence-p <>)
+ (remove nil <>)
+ (remove-if (lambda (s) (= (first s) 1487)) <>) ; remove the example
+ first
+ (mapcan #'digits <>)
+ digits-to-number)))
(defun problem-52 ()
@@ -1550,6 +1586,7 @@
(test p46 (is (= 5777 (problem-46))))
(test p47 (is (= 134043 (problem-47))))
(test p48 (is (= 9110846700 (problem-48))))
+(test p49 (is (= 296962999629 (problem-49))))
(test p52 (is (= 142857 (problem-52))))
(test p56 (is (= 972 (problem-56))))
--- a/src/primes.lisp Mon Feb 27 01:34:12 2017 +0000
+++ b/src/primes.lisp Mon Feb 27 16:13:36 2017 +0000
@@ -147,18 +147,36 @@
(not (primep n))))
+(defun primes% (start end)
+ (assert (<= start end))
+ (if (= start end)
+ nil
+ (let ((odd-primes (iterate (for i :from (if (oddp start)
+ start
+ (1+ start))
+ :by 2 :below end)
+ (when (primep i)
+ (collect i)))))
+ (if (<= start 2)
+ (cons 2 odd-primes)
+ odd-primes))))
+
(defun primes-below (n)
"Return the prime numbers less than `n`."
- (cond
- ((<= n 2) (list))
- ((= n 3) (list 2))
- (t (cons 2 (loop :for i :from 3 :by 2 :below n
- :when (primep i)
- :collect i)))))
+ (primes% 2 n))
(defun primes-upto (n)
"Return the prime numbers less than or equal to `n`."
- (primes-below (1+ n)))
+ (primes% 2 (1+ n)))
+
+(defun primes-in (min max)
+ "Return the prime numbers `p` such that `min` <= `p` <= `max`."
+ (primes% min (1+ max)))
+
+(defun primes-between (min max)
+ "Return the prime numbers `p` such that `min` < `p` < `max`."
+ (primes% (1+ min) max))
+
(defun nth-prime (n)
"Return the `n`th prime number."
--- a/vendor/make-quickutils.lisp Mon Feb 27 01:34:12 2017 +0000
+++ b/vendor/make-quickutils.lisp Mon Feb 27 16:13:36 2017 +0000
@@ -8,6 +8,8 @@
:curry
:define-constant
:ensure-boolean
+ :equivalence-classes
+ :map-combinations
:map-permutations
:maxf
:minf
--- a/vendor/quickutils.lisp Mon Feb 27 01:34:12 2017 +0000
+++ b/vendor/quickutils.lisp Mon Feb 27 16:13:36 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 :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 :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,10 +15,11 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
:COMPOSE :CURRY :DEFINE-CONSTANT
- :ENSURE-BOOLEAN :MAP-COMBINATIONS
- :MAP-PERMUTATIONS :MAXF :MINF :TAKE
- :N-GRAMS :RANGE :RCURRY :ONCE-ONLY
- :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
+ :ENSURE-BOOLEAN :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))))
@@ -137,6 +138,32 @@
(and x t))
+ (defun equivalence-classes (equiv seq)
+ "Partition the sequence `seq` into a list of equivalence classes
+defined by the equivalence relation `equiv`."
+ (let ((classes nil))
+ (labels ((find-equivalence-class (x)
+ (member-if (lambda (class)
+ (funcall equiv x (car class)))
+ classes))
+
+ (add-to-class (x)
+ (let ((class (find-equivalence-class x)))
+ (if class
+ (push x (car class))
+ (push (list x) classes)))))
+ (declare (dynamic-extent (function find-equivalence-class)
+ (function add-to-class))
+ (inline find-equivalence-class
+ add-to-class))
+
+ ;; Partition into equivalence classes.
+ (map nil #'add-to-class seq)
+
+ ;; Return the classes.
+ classes)))
+
+
(defun map-combinations (function sequence &key (start 0) end length (copy t))
"Calls `function` with each combination of `length` constructable from the
elements of the subsequence of `sequence` delimited by `start` and `end`. `start`
@@ -464,8 +491,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 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 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 ;;;;