# 55e8aef75bee

`Problem 12`
author Steve Losh Sun, 12 Feb 2017 11:25:38 +0000 32aa6dc56935 973b7cd23b1a (none) src/euler.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

## Changes

```--- 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")

(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))))
+  (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
+  ;;; 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.")))