# HG changeset patch # User Steve Losh # Date 1486898738 0 # Node ID 55e8aef75bee5a62d79867e577addf326983df3c # Parent 32aa6dc56935f47fd17707c05e93df0d5697b855 Problem 12 diff -r 32aa6dc56935 -r 55e8aef75bee src/euler.lisp --- a/src/euler.lisp Fri Feb 10 21:30:11 2017 +0000 +++ b/src/euler.lisp Sun Feb 12 11:25:38 2017 +0000 @@ -30,6 +30,17 @@ (iterate (for n :in-whatever sequence) (sum n))) +(defun divisors (n) + (sort (iterate (for i :from 1 :to (sqrt n)) + (when (dividesp n i) + (collect i) + (collect (/ n i)))) + #'<)) + +(defun count-divisors (n) + (* 2 (iterate (for i :from 1 :to (sqrt n)) + (counting (dividesp n i))))) + ;;;; Problems ----------------------------------------------------------------- (defun problem-1 () @@ -221,6 +232,31 @@ (aref grid (- row 2) (+ 2 col)) (aref grid (- row 3) (+ 3 col)))))))) +(defun problem-12 () + ;; The sequence of triangle numbers is generated by adding the natural + ;; numbers. So the 7th triangle number would be + ;; 1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. The first ten terms would be: + ;; + ;; 1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ... + ;; + ;; Let us list the factors of the first seven triangle numbers: + ;; + ;; 1: 1 + ;; 3: 1,3 + ;; 6: 1,2,3,6 + ;; 10: 1,2,5,10 + ;; 15: 1,3,5,15 + ;; 21: 1,3,7,21 + ;; 28: 1,2,4,7,14,28 + ;; + ;; We can see that 28 is the first triangle number to have over five divisors. + ;; + ;; What is the value of the first triangle number to have over five hundred + ;; divisors? + (iterate (for n :from 1) + (for tri :first n :then (+ tri n)) + (finding tri :such-that (> (count-divisors tri) 500)))) + ;;;; Tests -------------------------------------------------------------------- (def-suite :euler) @@ -237,6 +273,7 @@ (test p9 (is (= 31875000 (problem-9)))) (test p10 (is (= 142913828922 (problem-10)))) (test p11 (is (= 70600674 (problem-11)))) +(test p12 (is (= 76576500 (problem-12)))) ; (run! :euler) diff -r 32aa6dc56935 -r 55e8aef75bee vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Fri Feb 10 21:30:11 2017 +0000 +++ b/vendor/make-quickutils.lisp Sun Feb 12 11:25:38 2017 +0000 @@ -4,10 +4,12 @@ "quickutils.lisp" :utilities '( + :curry :define-constant :ensure-boolean :n-grams :range + :rcurry :switch :with-gensyms diff -r 32aa6dc56935 -r 55e8aef75bee vendor/quickutils.lisp --- a/vendor/quickutils.lisp Fri Feb 10 21:30:11 2017 +0000 +++ b/vendor/quickutils.lisp Sun Feb 12 11:25:38 2017 +0000 @@ -2,7 +2,7 @@ ;;;; See http://quickutil.org for details. ;;;; To regenerate: -;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :ENSURE-BOOLEAN :N-GRAMS :RANGE :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS") +;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :N-GRAMS :RANGE :RCURRY :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS") (eval-when (:compile-toplevel :load-toplevel :execute) (unless (find-package "EULER.QUICKUTILS") @@ -13,10 +13,55 @@ (in-package "EULER.QUICKUTILS") (when (boundp '*utilities*) - (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :ENSURE-BOOLEAN :TAKE - :N-GRAMS :RANGE :STRING-DESIGNATOR + (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION + :CURRY :DEFINE-CONSTANT + :ENSURE-BOOLEAN :TAKE :N-GRAMS :RANGE + :RCURRY :STRING-DESIGNATOR :WITH-GENSYMS :EXTRACT-FUNCTION-NAME :SWITCH)))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun make-gensym-list (length &optional (x "G")) + "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`, +using the second (optional, defaulting to `\"G\"`) argument." + (let ((g (if (typep x '(integer 0)) x (string x)))) + (loop repeat length + collect (gensym g)))) + ) ; eval-when +(eval-when (:compile-toplevel :load-toplevel :execute) + ;;; To propagate return type and allow the compiler to eliminate the IF when + ;;; it is known if the argument is function or not. + (declaim (inline ensure-function)) + + (declaim (ftype (function (t) (values function &optional)) + ensure-function)) + (defun ensure-function (function-designator) + "Returns the function designated by `function-designator`: +if `function-designator` is a function, it is returned, otherwise +it must be a function name and its `fdefinition` is returned." + (if (functionp function-designator) + function-designator + (fdefinition function-designator))) + ) ; eval-when + + (defun curry (function &rest arguments) + "Returns a function that applies `arguments` and the arguments +it is called with to `function`." + (declare (optimize (speed 3) (safety 1) (debug 1))) + (let ((fn (ensure-function function))) + (lambda (&rest more) + (declare (dynamic-extent more)) + ;; Using M-V-C we don't need to append the arguments. + (multiple-value-call fn (values-list arguments) (values-list more))))) + + (define-compiler-macro curry (function &rest arguments) + (let ((curries (make-gensym-list (length arguments) "CURRY")) + (fun (gensym "FUN"))) + `(let ((,fun (ensure-function ,function)) + ,@(mapcar #'list curries arguments)) + (declare (optimize (speed 3) (safety 1) (debug 1))) + (lambda (&rest more) + (apply ,fun ,@curries more))))) + (defun %reevaluate-constant (name value test) (if (not (boundp name)) @@ -89,6 +134,16 @@ (loop :for i :from start :below end :by step :collecting (funcall key i))) + (defun rcurry (function &rest arguments) + "Returns a function that applies the arguments it is called +with and `arguments` to `function`." + (declare (optimize (speed 3) (safety 1) (debug 1))) + (let ((fn (ensure-function function))) + (lambda (&rest more) + (declare (dynamic-extent more)) + (multiple-value-call fn (values-list more) (values-list arguments))))) + + (deftype string-designator () "A string designator type. A string designator is either a string, a symbol, or a character." @@ -183,7 +238,7 @@ (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH."))) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(define-constant ensure-boolean n-grams range switch eswitch cswitch - with-gensyms with-unique-names))) + (export '(curry define-constant ensure-boolean n-grams range rcurry switch + eswitch cswitch with-gensyms with-unique-names))) ;;;; END OF quickutils.lisp ;;;;