--- a/src/problems.lisp Wed Oct 04 00:51:13 2017 -0400
+++ b/src/problems.lisp Sat Oct 07 13:52:05 2017 -0400
@@ -343,7 +343,7 @@
;; 2^15 = 32768 and the sum of its digits is 3 + 2 + 7 + 6 + 8 = 26.
;;
;; What is the sum of the digits of the number 2^1000?
- (sum (digits (expt 2 1000))))
+ (digital-sum (expt 2 1000)))
(defun problem-17 ()
;; If the numbers 1 to 5 are written out in words: one, two, three, four,
@@ -438,7 +438,7 @@
;; and the sum of the digits in the number 10! is 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27.
;;
;; Find the sum of the digits in the number 100!
- (sum (digits (factorial 100))))
+ (digital-sum (factorial 100)))
(defun problem-21 ()
;; Let d(n) be defined as the sum of proper divisors of n (numbers less than
@@ -1316,7 +1316,7 @@
;; maximum digital sum?
(iterate (for-nested ((a :from 1 :below 100)
(b :from 1 :below 100)))
- (maximizing (funcall #'sum (digits (expt a b))))))
+ (maximizing (digital-sum (expt a b)))))
(defun problem-57 ()
;; It is possible to show that the square root of two can be expressed as an
@@ -1826,9 +1826,11 @@
(sum (if (= i j) 1 2)))))))
(defun problem-206 ()
+ (declare (optimize speed))
;; Find the unique positive integer whose square has the form
;; 1_2_3_4_5_6_7_8_9_0, where each “_” is a single digit.
(flet ((targetp (i)
+ (declare (type fixnum i))
(and (= 0 (nth-digit 0 i))
(= 9 (nth-digit 2 i))
(= 8 (nth-digit 4 i))
@@ -1848,6 +1850,60 @@
(for i :from min :to max :by 10)
(finding i :such-that (targetp (square i))))))
+(defun problem-315 ()
+ ;; Full description too long, see https://projecteuler.net/problem=315
+ (labels ((digit-to-bits (n)
+ ;; We'll represent the lit segments of a clock as bits:
+ ;;
+ ;; - 1
+ ;; | | 2 3
+ ;; - 0
+ ;; | | 4 5
+ ;; - 6
+ (case n
+ ;; 6543210
+ (0 #b1111110)
+ (1 #b0101000)
+ (2 #b1011011)
+ (3 #b1101011)
+ (4 #b0101101)
+ (5 #b1100111)
+ (6 #b1110111)
+ (7 #b0101110)
+ (8 #b1111111)
+ (9 #b1101111)
+ (t #b0000000)))
+ (transition-sam (previous current)
+ ;; Sam turns off everything lit in the previous number, and turns
+ ;; on everything lit in the current one.
+ (let ((p (digit-to-bits previous))
+ (c (digit-to-bits current)))
+ (+ (logcount p)
+ (logcount c))))
+ (transition-max (previous current)
+ ;; Max only turns off the things that need to be turned off, and
+ ;; only turns on the things that need to be turned on. This is
+ ;; just xor.
+ (let ((p (digit-to-bits previous))
+ (c (digit-to-bits current)))
+ (logcount (logxor p c))))
+ (transition (transition-function previous-digits current-digits)
+ ;; The new digits will probably be shorter than the old digits.
+ (sum (mapcar-long transition-function nil
+ previous-digits current-digits)))
+ (run-clock (seed)
+ (iterate
+ (for current :in-lists (list (mapcar (rcurry #'digits :from-end t)
+ (digital-roots seed))
+ '(nil))) ; final turn-off
+ (for prev :previous current :initially nil)
+ (summing (transition #'transition-sam prev current) :into sam)
+ (summing (transition #'transition-max prev current) :into max)
+ (finally (return (values sam max))))))
+ (iterate (for n :from (expt 10 7) :to (* 2 (expt 10 7)))
+ (when (primep n)
+ (summing (multiple-value-call #'- (run-clock n)))))))
+
(defun problem-323 ()
;; Let y0, y1, y2,... be a sequence of random unsigned 32 bit integers (i.e.
;; 0 ≤ yi < 2^32, every value equally likely).
@@ -2051,10 +2107,10 @@
;; Find the sum of the strong, right truncatable Harshad primes less than
;; 10^14.
(labels ((harshadp (number)
- (dividesp number (sum (digits number))))
+ (dividesp number (digital-sum number)))
(strong-harshad-p (number)
(multiple-value-bind (result remainder)
- (truncate number (sum (digits number)))
+ (truncate number (digital-sum number))
(and (zerop remainder)
(primep result))))
(right-truncatable-harshad-p (number)
@@ -2176,6 +2232,7 @@
(test p102 (is (= 228 (problem-102))))
(test p145 (is (= 608720 (problem-145))))
(test p206 (is (= 1389019170 (problem-206))))
+(test p315 (is (= 13625242 (problem-315))))
(test p323 (is (= 6.3551758451d0 (problem-323))))
(test p345 (is (= 13938 (problem-345))))
(test p357 (is (= 1739023853137 (problem-357))))
--- a/src/utils.lisp Wed Oct 04 00:51:13 2017 -0400
+++ b/src/utils.lisp Sat Oct 07 13:52:05 2017 -0400
@@ -69,10 +69,40 @@
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 (n &key (radix 10) from-end)
+ "Return a fresh list of the digits of `n` in base `radix`.
+
+ By default, the digits are returned high-order first, as you would read them.
+ Use `from-end` to get them low-order first:
+
+ (digits 123) ; => (1 2 3)
+ (digits 123 :from-end t) ; => (3 2 1)
+
+ "
+ (if from-end
+ (iterate (for d :in-digits-of n :radix radix)
+ (collect d))
+ (iterate (for d :in-digits-of n :radix radix)
+ (collect d :at :beginning))))
+
+
+(defun-inlineable digital-sum (n &optional (radix 10))
+ "Return the sum of the digits of `n` in base `radix`."
+ (iterate (for digit :in-digits-of n :radix radix)
+ (summing digit)))
+
+(defun digital-root (n &optional (radix 10))
+ "Return the digital root of `n` in base `radix`."
+ (declare (inline digital-sum))
+ (iterate (for i :first n :then (digital-sum i radix))
+ (finding i :such-that (< i radix))))
+
+(defun digital-roots (n &optional (radix 10))
+ "Return a list of the digital roots of `n` in base `radix`."
+ (declare (inline digital-sum))
+ (iterate (for i :first n :then (digital-sum i radix))
+ (collect i)
+ (until (< i radix))))
(defun-inline append-digit (digit number &optional (radix 10))
@@ -634,3 +664,15 @@
(u (- 1 v w)))
(values u v w)))
+
+(defun mapcar-long (function fill list &rest more-lists)
+ "Like `mapcar`, but using the longest list, filling with `fill`."
+ (declare (optimize speed))
+ (flet ((head (list)
+ (if (null list) fill (car list))))
+ (iterate (with (the cons lists) = (cons list more-lists))
+ (with function = (ensure-function function))
+ (until (every #'null lists))
+ (collect (apply function (mapcar #'head lists)))
+ (map-into lists #'cdr lists))))
+