# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1488212016 0
# Node ID cb5c5132c0b879dd03e28761500ac3fc8f9446cd
# Parent  42598a2717ebaf0682c19a6c0f14a2fa456103bf
Problem 49

diff -r 42598a2717eb -r cb5c5132c0b8 src/euler.lisp
--- 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))))
diff -r 42598a2717eb -r cb5c5132c0b8 src/primes.lisp
--- 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."
diff -r 42598a2717eb -r cb5c5132c0b8 vendor/make-quickutils.lisp
--- 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
diff -r 42598a2717eb -r cb5c5132c0b8 vendor/quickutils.lisp
--- 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 ;;;;