55e8aef75bee

Problem 12
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 12 Feb 2017 11:25:38 +0000
parents 32aa6dc56935
children 973b7cd23b1a
branches/tags (none)
files src/euler.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

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