d08ee014a398

Problem 92
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Tue, 08 Aug 2017 16:57:14 -0400
parents 48e02ac6faae
children d8750d0cda0f
branches/tags (none)
files src/euler.lisp src/utils.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/src/euler.lisp	Tue Aug 08 15:50:54 2017 -0400
+++ b/src/euler.lisp	Tue Aug 08 16:57:14 2017 -0400
@@ -1665,6 +1665,28 @@
                       (every (rcurry #'subsequencep (digits passcode))
                              attempts)))))
 
+(defun problem-92 ()
+  ;; A number chain is created by continuously adding the square of the digits
+  ;; in a number to form a new number until it has been seen before.
+  ;;
+  ;; For example,
+  ;; 44 → 32 → 13 → 10 → 1 → 1
+  ;; 85 → 89 → 145 → 42 → 20 → 4 → 16 → 37 → 58 → 89
+  ;;
+  ;; Therefore any chain that arrives at 1 or 89 will become stuck in an
+  ;; endless loop. What is most amazing is that EVERY starting number will
+  ;; eventually arrive at 1 or 89.
+  ;;
+  ;; How many starting numbers below ten million will arrive at 89?
+  (labels ((square-chain-end (i)
+             (if (or (= 1 i) (= 89 i))
+               i
+               (square-chain-end
+                 (iterate (for d :in-digits-of i)
+                          (summing (square d)))))))
+    (iterate (for i :from 1 :below 10000000)
+             (counting (= 89 (square-chain-end i))))))
+
 (defun problem-145 ()
   ;; Some positive integers n have the property that the sum [ n + reverse(n) ]
   ;; consists entirely of odd (decimal) digits. For instance, 36 + 63 = 99 and
@@ -1764,6 +1786,7 @@
 
 (test p74 (is (= 402 (problem-74))))
 (test p79 (is (= 73162890 (problem-79))))
+(test p92 (is (= 8581146 (problem-92))))
 (test p145 (is (= 608720 (problem-145))))
 
 
--- a/src/utils.lisp	Tue Aug 08 15:50:54 2017 -0400
+++ b/src/utils.lisp	Tue Aug 08 16:57:14 2017 -0400
@@ -44,22 +44,17 @@
                               (setf ,i ,remaining)
                               ,digit)))))))
 
-(defun digits (n &optional (radix 10))
-  "Return a fresh list of the digits of `n` in base `radix`."
-  (iterate (for d :in-digits-of n :radix radix)
-           (collect d :at :beginning)))
-
-(defun digits-vector (n &optional (radix 10))
-  "Return a fresh vector of the digits of `n` in base `radix`."
-  (iterate (for d :in-digits-of n :radix radix)
-           (collect d :at :beginning :result-type 'vector)))
-
 (defun digits-length (n &optional (radix 10))
   "Return how many digits `n` has in base `radix`."
   (if (zerop n)
     1
     (values (1+ (truncate (log (abs n) radix))))))
 
+(defun digits (n &optional (radix 10))
+  "Return a fresh list of the digits of `n` in base `radix`."
+  (iterate (for d :in-digits-of n :radix radix)
+           (collect d :at :beginning)))
+
 
 (defun digits-to-number (digits)
   (if digits
@@ -87,19 +82,32 @@
     (string= s (reverse s))))
 
 
-(defun sum (sequence &key key)
+(defun-inlineable sum (sequence &key key)
   (iterate (for n :in-whatever sequence)
            (sum (if key
                   (funcall key n)
                   n))))
 
-(defun product (sequence &key key)
+(defun-inlineable product (sequence &key key)
   (iterate (for n :in-whatever sequence)
            (multiplying (if key
                           (funcall key n)
                           n))))
 
 
+(defun-inlineable mutate (function list)
+  "Destructively mutate each element of `list` in-place with `function`.
+
+  Equivalent to (but can be faster than) `(map-into list function list)`.
+
+  "
+  (declare (optimize speed))
+  (loop :with function = (ensure-function function)
+        :for l :on list
+        :do (setf (car l) (funcall function (car l))))
+  list)
+
+
 (defun sort< (sequence)
   (sort sequence #'<))
 
--- a/vendor/make-quickutils.lisp	Tue Aug 08 15:50:54 2017 -0400
+++ b/vendor/make-quickutils.lisp	Tue Aug 08 16:57:14 2017 -0400
@@ -9,6 +9,7 @@
                :define-constant
                :emptyp
                :ensure-boolean
+               :ensure-function
                :ensure-gethash
                :equivalence-classes
                :map-combinations
--- a/vendor/quickutils.lisp	Tue Aug 08 15:50:54 2017 -0400
+++ b/vendor/quickutils.lisp	Tue Aug 08 16:57:14 2017 -0400
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :EMPTYP :ENSURE-BOOLEAN :ENSURE-GETHASH :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :MAP-PERMUTATIONS :MAXF :MINF :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :EMPTYP :ENSURE-BOOLEAN :ENSURE-FUNCTION :ENSURE-GETHASH :EQUIVALENCE-CLASSES :MAP-COMBINATIONS :MAP-PERMUTATIONS :MAXF :MINF :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :REMOVEF :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "EULER.QUICKUTILS")
@@ -526,9 +526,10 @@
     (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 emptyp ensure-boolean ensure-gethash
-            equivalence-classes map-combinations map-permutations maxf minf
-            n-grams range rcurry read-file-into-string removef switch eswitch
-            cswitch with-gensyms with-unique-names)))
+  (export '(compose curry define-constant emptyp ensure-boolean ensure-function
+            ensure-gethash equivalence-classes map-combinations
+            map-permutations maxf minf n-grams range rcurry
+            read-file-into-string removef switch eswitch cswitch with-gensyms
+            with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;