--- 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)
--- 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
--- 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 ;;;;