a66997c0fad3

Modernize repo
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 10 Feb 2017 20:26:42 +0000
parents ef04c7b3d0b8
children 829e38d1f825
branches/tags (none)
files Makefile euler.asd euler.lisp make-utilities.lisp package.lisp primes.lisp quickutils.lisp run-tests.lisp src/euler.lisp src/primes.lisp utils.lisp vendor/make-quickutils.lisp vendor/quickutils-package.lisp vendor/quickutils.lisp

Changes

diff -r ef04c7b3d0b8 -r a66997c0fad3 Makefile
--- a/Makefile	Mon Apr 11 14:40:47 2016 +0000
+++ b/Makefile	Fri Feb 10 20:26:42 2017 +0000
@@ -1,7 +1,8 @@
-.PHONY: test
+.PHONY: vendor
+
 
-quickutils.lisp: make-utilities.lisp
-	sbcl-rlwrap --noinform --load make-utilities.lisp  --eval '(quit)'
+# Vendor ----------------------------------------------------------------------
+vendor/quickutils.lisp: vendor/make-quickutils.lisp
+	cd vendor && sbcl --noinform --load make-quickutils.lisp  --eval '(quit)'
 
-test:
-	sbcl-rlwrap --noinform --load run-tests.lisp  --eval '(quit)'
+vendor: vendor/quickutils.lisp
diff -r ef04c7b3d0b8 -r a66997c0fad3 euler.asd
--- a/euler.asd	Mon Apr 11 14:40:47 2016 +0000
+++ b/euler.asd	Fri Feb 10 20:26:42 2017 +0000
@@ -8,18 +8,25 @@
   :license "MIT/X11"
   :version "0.0.1"
 
-  :depends-on (#:defstar
-               #:fiveam
-               #:optima
-               #:trivial-types
-               #:cl-arrows
-               #:fare-quasiquote-optima
-               #:fare-quasiquote-readtable)
+  :depends-on (
+
+               :fare-quasiquote-optima
+               :fare-quasiquote-readtable
+               :fiveam
+               :iterate
+               :losh
+               :optima
+               :trivial-types
+
+               )
 
   :serial t
-  :components ((:file "quickutils") ; quickutils package ordering crap
+  :components (
+               (:module "vendor" :serial t
+                :components ((:file "quickutils-package")
+                             (:file "quickutils")))
                (:file "package")
-               (:file "utils")
-               (:file "primes")
-               (:file "euler")))
+               (:module "src" :serial t
+                :components ((:file "primes")
+                             (:file "euler")))))
 
diff -r ef04c7b3d0b8 -r a66997c0fad3 euler.lisp
--- a/euler.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,169 +0,0 @@
-(in-package #:euler)
-
-;;;;
-(defun digits (n)
-  "Return how many digits `n` has in base 10."
-  (values (truncate (1+ (log n 10)))))
-
-(defun definitely-palindrome-p (n)
-  "Return whether `n` is a palindrome (in base 10), the slow-but-sure way."
-  (let ((s (format nil "~D" n)))
-    (string= s (reverse s))))
-
-(defun palindrome-p (n)
-  "Return whether `n` is a palindrome (in base 10)."
-  (assert (>= n 0) (n) "~A must be a non-negative integer" n)
-  ;; All even-length base-10 palindromes are divisible by 11, so we can shortcut
-  ;; the awful string comparison. E.g.:
-  ;;
-  ;;   abccba =
-  ;;   100001 * a +
-  ;;   010010 * b +
-  ;;   001100 * c
-  (cond
-    ((zerop n) t)
-    ((and (evenp (digits n))
-          (not (dividesp n 11))) nil)
-    (t (definitely-palindrome-p n))))
-
-(defun range (from below)
-  (loop :for i :from from :below below
-        :collect i))
-
-(defun square (n)
-  (* n n))
-
-
-;;;; Problems
-(defun problem-1 ()
-  ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
-  ;; we get 3, 5, 6 and 9. The sum of these multiples is 23.
-  ;;
-  ;; Find the sum of all the multiples of 3 or 5 below 1000.
-  (loop :for i :from 1 :below 1000
-        :when (or (dividesp i 3)
-                  (dividesp i 5))
-        :sum i))
-
-(defun problem-2 ()
-  ;; Each new term in the Fibonacci sequence is generated by adding the previous
-  ;; two terms. By starting with 1 and 2, the first 10 terms will be:
-  ;;
-  ;;     1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
-  ;;
-  ;; By considering the terms in the Fibonacci sequence whose values do not
-  ;; exceed four million, find the sum of the even-valued terms.
-  (loop :with p = 0
-        :with n = 1
-        :while (<= n 4000000)
-        :when (evenp n) :sum n
-        :do (psetf p n
-                   n (+ p n))))
-
-(defun problem-3 ()
-  ;; The prime factors of 13195 are 5, 7, 13 and 29.
-  ;;
-  ;; What is the largest prime factor of the number 600851475143 ?
-  (apply #'max (prime-factorization 600851475143)))
-
-(defun problem-4 ()
-  ;; A palindromic number reads the same both ways. The largest palindrome made
-  ;; from the product of two 2-digit numbers is 9009 = 91 × 99.
-  ;;
-  ;; Find the largest palindrome made from the product of two 3-digit numbers.
-  (let ((result (list)))
-    (loop :for i :from 0 :to 999
-          :do (loop :for j :from 0 :to 999
-                    :for product = (* i j)
-                    :when (palindrome-p product)
-                    :do (push product result)))
-    (apply #'max result)))
-
-(defun problem-5 ()
-  ;; 2520 is the smallest number that can be divided by each of the numbers from
-  ;; 1 to 10 without any remainder.
-  ;;
-  ;; What is the smallest positive number that is evenly divisible by all of the
-  ;; numbers from 1 to 20?
-  (let ((divisors (range 11 21)))
-    ;; all numbers are divisible by 1 and we can skip checking everything <= 10
-    ;; because:
-    ;;
-    ;; anything divisible by 12 is automatically divisible by 2
-    ;; anything divisible by 12 is automatically divisible by 3
-    ;; anything divisible by 12 is automatically divisible by 4
-    ;; anything divisible by 15 is automatically divisible by 5
-    ;; anything divisible by 12 is automatically divisible by 6
-    ;; anything divisible by 14 is automatically divisible by 7
-    ;; anything divisible by 16 is automatically divisible by 8
-    ;; anything divisible by 18 is automatically divisible by 9
-    ;; anything divisible by 20 is automatically divisible by 10
-    (loop :for i
-          :from 20 :by 20 ; it must be divisible by 20
-          :when (every (lambda (n) (dividesp i n))
-                       divisors)
-          :return i)))
-
-(defun problem-6 ()
-  ;; The sum of the squares of the first ten natural numbers is,
-  ;;   1^2 + 2^2 + ... + 10^2 = 385
-  ;;
-  ;; The square of the sum of the first ten natural numbers is,
-  ;;   (1 + 2 + ... + 10)^2 = 55^2 = 3025
-  ;;
-  ;; Hence the difference between the sum of the squares of the first ten
-  ;; natural numbers and the square of the sum is 3025 − 385 = 2640.
-  ;;
-  ;; Find the difference between the sum of the squares of the first one hundred
-  ;; natural numbers and the square of the sum.
-  (flet ((sum-of-squares (to)
-           (loop :for i :from 1 :to to
-                 :sum (square i)))
-         (square-of-sum (to)
-           (square (loop :for i :from 1 :to to
-                         :sum i))))
-    (abs (- (sum-of-squares 100) ; apparently it wants the absolute value
-            (square-of-sum 100)))))
-
-(defun problem-7 ()
-  (nth-prime 10001))
-
-(defun problem-8 ()
- (let ((digits (map 'list #'digit-char-p
-                    "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450")))
-   (loop :for window :in (n-grams 13 digits)
-         :maximize (apply #'* window))))
-
-(defun problem-9 ()
-  (flet ((pythagorean-triplet-p (a b c)
-           (= (+ (square a) (square b))
-              (square c))))
-    (block search
-      (loop :for c :from 998 :downto 1 ; they must add up to 1000, so C can be at most 998
-            :do (loop :for a :from (- 999 c) :downto 1 ; A can be at most 999 - C (to leave 1 for B)
-                      :for b = (- 1000 c a)
-                      :when (pythagorean-triplet-p a b c)
-                      :do (return-from search (* a b c)))))))
-
-(defun problem-10 ()
-  (loop :for p :in (primes-below 2000000)
-        :sum p))
-
-
-;;;; Tests
-(def-suite :euler)
-(in-suite :euler)
-
-(test p1 (is (= 233168 (problem-1))))
-(test p2 (is (= 4613732 (problem-2))))
-(test p3 (is (= 6857 (problem-3))))
-(test p4 (is (= 906609 (problem-4))))
-(test p5 (is (= 232792560 (problem-5))))
-(test p6 (is (= 25164150 (problem-6))))
-(test p7 (is (= 104743 (problem-7))))
-(test p8 (is (= 23514624000 (problem-8))))
-(test p9 (is (= 31875000 (problem-9))))
-(test p10 (is (= 142913828922 (problem-10))))
-
-
-; (run! :euler)
diff -r ef04c7b3d0b8 -r a66997c0fad3 make-utilities.lisp
--- a/make-utilities.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,12 +0,0 @@
-(ql:quickload 'quickutil)
-
-(qtlc:save-utils-as
-  "quickutils.lisp"
-  :utilities '(:define-constant
-               :switch
-               :while
-               :ensure-boolean
-               :with-gensyms
-               :n-grams
-               )
-  :package "EULER.QUICKUTILS")
diff -r ef04c7b3d0b8 -r a66997c0fad3 package.lisp
--- a/package.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ b/package.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -1,10 +1,7 @@
-(defpackage #:euler.utils
-  (:use #:cl #:euler.quickutils)
-  (:export
-    #:random-exclusive
-    #:repeat
-    #:dividesp))
-
-(defpackage #:euler
-  (:use #:cl #:5am
-        #:euler.quickutils #:euler.utils))
+(defpackage :euler
+  (:use :cl
+        :iterate
+        :losh
+        :5am
+        :euler.quickutils)
+  (:shadowing-import-from :5am :test))
diff -r ef04c7b3d0b8 -r a66997c0fad3 primes.lisp
--- a/primes.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,164 +0,0 @@
-(in-package #:euler)
-
-(define-constant carmichael-numbers ; from oeis
-  '(561 1105 1729 2465 2821 6601 8911 10585 15841 29341 41041 46657 52633
-    62745 63973 75361 101101 115921 126217 162401 172081 188461 252601 278545
-    294409 314821 334153 340561 399001 410041 449065 488881 512461)
-  :test #'equal)
-
-(defun prime-factorization (n)
-  "Return the prime factors of `n`."
-  ;; from http://www.geeksforgeeks.org/print-all-prime-factors-of-a-given-number/
-  (let ((result (list)))
-    (while (evenp n) ; handle 2, the only even prime factor
-      (push 2 result)
-      (setf n (/ n 2)))
-    (loop :for i :from 3 :to (sqrt n) :by 2 ; handle odd (prime) divisors
-          :do (while (dividesp n i)
-                (push i result)
-                (setf n (/ n i))))
-    (when (> n 2) ; final check in case we ended up with a prime
-      (push n result))
-    (nreverse result)))
-
-
-(defun expmod (base exp m)
-  "Return base^exp % m quickly."
-  ;; From SICP and
-  ;; https://rosettacode.org/wiki/Miller%E2%80%93Rabin_primality_test#Common_Lisp
-  ;;
-  ;; We want to avoid bignums as much as possible.  This computes (base^exp % m)
-  ;; without having to deal with huge numbers by taking advantage of the fact
-  ;; that:
-  ;;
-  ;;     (x * y) % m
-  ;;
-  ;; is equivalent to:
-  ;;
-  ;;     ((x % m) * (y % m)) % m
-  ;;
-  ;; So for the cases where `exp` is even, we can split base^exp into an x and
-  ;; y both equal to base^(exp/2) and use the above trick to handle them
-  ;; separately.  Even better, we can just compute it once and square it.
-  ;;
-  ;; We also make it tail recursive by keeping a running accumulator:
-  ;;
-  ;;    base^exp * acc
-  (labels
-      ((recur (base exp acc)
-         (cond
-           ((zerop exp) acc)
-           ((evenp exp)
-            (recur (rem (square base) m)
-                   (/ exp 2)
-                   acc))
-           (t
-            (recur base
-                   (1- exp)
-                   (rem (* base acc) m))))))
-    (recur base exp 1)))
-
-
-(defun fermat-prime-p (n &optional (tests 10))
-  "Return whether `n` might be prime.
-
-  Checks `tests` times.
-
-  If `t` is returned, `n` might be prime.  If `nil` is returned it is definitely
-  composite.
-
-  "
-  (flet ((fermat-check (a)
-           (= (expmod a n n) a)))
-    (loop :repeat tests
-          :when (not (fermat-check (random-exclusive 0 n)))
-          :do (return nil)
-          :finally (return t))))
-
-(defun factor-out (n factor)
-  "Factor the all the `factor`s out of `n`.
-
-  Turns `n` into:
-
-    factor^e * d
-
-  where `d` is no longer divisible by `n`, and returns `e` and `d`.
-
-  "
-  (loop :for d = n :then (/ d factor)
-        :for e = 0 :then (1+ e)
-        :while (dividesp d factor)
-        :finally (return (values e d))))
-
-(defun miller-rabin-prime-p (n &optional (k 10))
-  "Return whether `n` might be prime.
-
-  If `t` is returned, `n` is probably prime.
-  If `nil` is returned, `n` is definitely composite.
-
-  "
-  ;; https://rosettacode.org/wiki/Miller%E2%80%93Rabin_primality_test#Common_Lisp
-  (cond
-    ((< n 2) nil)
-    ((< n 4) t)
-    ((evenp n) nil)
-    (t (multiple-value-bind (r d)
-           (factor-out (1- n) 2)
-         (flet ((strong-liar-p (a)
-                  (let ((x (expmod a d n)))
-                    (or (= x 1)
-                        (loop :repeat r
-                              :for y = x :then (expmod y 2 n)
-                              :when (= y (1- n))
-                              :do (return t))))))
-           (loop :repeat k
-                 :for a = (random-exclusive 1 (1- n))
-                 :always (strong-liar-p a)))))))
-
-(defun brute-force-prime-p (n)
-  "Return (slowly) whether `n` is prime."
-  (cond
-    ((or (= n 0) (= n 1)) nil)
-    ((= n 2) t)
-    ((evenp n) nil)
-    (t (loop :for divisor :from 3 :to (sqrt n)
-          :when (dividesp n divisor)
-          :do (return nil)
-          :finally (return t)))))
-
-(defun primep (n)
-  "Return (less slowly) whether `n` is prime."
-  (cond
-    ;; short-circuit a few edge/common cases
-    ((< n 2) nil)
-    ((= n 2) t)
-    ((evenp n) nil)
-    ((< n 100000) (brute-force-prime-p n))
-    (t (miller-rabin-prime-p n))))
-
-
-(defun primes-below (n)
-  "Return the prime numbers less than `n`."
-  (cond
-    ((<= n 2) (list))
-    ((= n 3) (list 2))
-    (t (cons 2 (loop :for i :from 3 :by 2 :below n
-                     :when (primep i)
-                     :collect i)))))
-
-(defun primes-upto (n)
-  "Return the prime numbers less than or equal to `n`."
-  (primes-below (1+ n)))
-
-
-(defun nth-prime (n)
-  "Return the `n`th prime number."
-  (if (= n 1)
-    2
-    (loop :with seen = 1
-          :for i :from 3 :by 2
-          :when (primep i)
-          :do (progn
-                (incf seen)
-                (when (= seen n)
-                  (return i))))))
diff -r ef04c7b3d0b8 -r a66997c0fad3 quickutils.lisp
--- a/quickutils.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,194 +0,0 @@
-;;;; This file was automatically generated by Quickutil.
-;;;; See http://quickutil.org for details.
-
-;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :WHILE :ENSURE-BOOLEAN :WITH-GENSYMS :N-GRAMS) :ensure-package T :package "EULER.QUICKUTILS")
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (unless (find-package "EULER.QUICKUTILS")
-    (defpackage "EULER.QUICKUTILS"
-      (:documentation "Package that contains Quickutil utility functions.")
-      (:use #:cl))))
-
-(in-package "EULER.QUICKUTILS")
-
-(when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :STRING-DESIGNATOR
-                                         :WITH-GENSYMS :EXTRACT-FUNCTION-NAME
-                                         :SWITCH :UNTIL :WHILE :ENSURE-BOOLEAN
-                                         :TAKE :N-GRAMS))))
-
-  (defun %reevaluate-constant (name value test)
-    (if (not (boundp name))
-        value
-        (let ((old (symbol-value name))
-              (new value))
-          (if (not (constantp name))
-              (prog1 new
-                (cerror "Try to redefine the variable as a constant."
-                        "~@<~S is an already bound non-constant variable ~
-                       whose value is ~S.~:@>" name old))
-              (if (funcall test old new)
-                  old
-                  (restart-case
-                      (error "~@<~S is an already defined constant whose value ~
-                              ~S is not equal to the provided initial value ~S ~
-                              under ~S.~:@>" name old new test)
-                    (ignore ()
-                      :report "Retain the current value."
-                      old)
-                    (continue ()
-                      :report "Try to redefine the constant."
-                      new)))))))
-
-  (defmacro define-constant (name initial-value &key (test ''eql) documentation)
-    "Ensures that the global variable named by `name` is a constant with a value
-that is equal under `test` to the result of evaluating `initial-value`. `test` is a
-function designator that defaults to `eql`. If `documentation` is given, it
-becomes the documentation string of the constant.
-
-Signals an error if `name` is already a bound non-constant variable.
-
-Signals an error if `name` is already a constant variable whose value is not
-equal under `test` to result of evaluating `initial-value`."
-    `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
-       ,@(when documentation `(,documentation))))
-  
-
-  (deftype string-designator ()
-    "A string designator type. A string designator is either a string, a symbol,
-or a character."
-    `(or symbol string character))
-  
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defmacro with-gensyms (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(let ,(mapcar (lambda (name)
-                     (multiple-value-bind (symbol string)
-                         (etypecase name
-                           (symbol
-                            (values name (symbol-name name)))
-                           ((cons symbol (cons string-designator null))
-                            (values (first name) (string (second name)))))
-                       `(,symbol (gensym ,string))))
-            names)
-       ,@forms))
-
-  (defmacro with-unique-names (names &body forms)
-    "Binds each variable named by a symbol in `names` to a unique symbol around
-`forms`. Each of `names` must either be either a symbol, or of the form:
-
-    (symbol string-designator)
-
-Bare symbols appearing in `names` are equivalent to:
-
-    (symbol symbol)
-
-The string-designator is used as the argument to `gensym` when constructing the
-unique symbol the named variable will be bound to."
-    `(with-gensyms ,names ,@forms))
-  )                                        ; eval-when
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun extract-function-name (spec)
-    "Useful for macros that want to mimic the functional interface for functions
-like `#'eq` and `'eq`."
-    (if (and (consp spec)
-             (member (first spec) '(quote function)))
-        (second spec)
-        spec))
-  )                                        ; eval-when
-
-  (eval-when (:compile-toplevel :load-toplevel :execute)
-    (defun generate-switch-body (whole object clauses test key &optional default)
-      (with-gensyms (value)
-        (setf test (extract-function-name test))
-        (setf key (extract-function-name key))
-        (when (and (consp default)
-                   (member (first default) '(error cerror)))
-          (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S."
-                                    ,value ',test)))
-        `(let ((,value (,key ,object)))
-           (cond ,@(mapcar (lambda (clause)
-                             (if (member (first clause) '(t otherwise))
-                                 (progn
-                                   (when default
-                                     (error "Multiple default clauses or illegal use of a default clause in ~S."
-                                            whole))
-                                   (setf default `(progn ,@(rest clause)))
-                                   '(()))
-                                 (destructuring-bind (key-form &body forms) clause
-                                   `((,test ,value ,key-form)
-                                     ,@forms))))
-                           clauses)
-                 (t ,default))))))
-
-  (defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
-                    &body clauses)
-    "Evaluates first matching clause, returning its values, or evaluates and
-returns the values of `default` if no keys match."
-    (generate-switch-body whole object clauses test key))
-
-  (defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                     &body clauses)
-    "Like `switch`, but signals an error if no key matches."
-    (generate-switch-body whole object clauses test key '(error)))
-
-  (defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity))
-                     &body clauses)
-    "Like `switch`, but signals a continuable error if no key matches."
-    (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
-  
-
-  (defmacro until (expression &body body)
-    "Executes `body` until `expression` is true."
-    `(do ()
-         (,expression)
-       ,@body))
-  
-
-  (defmacro while (expression &body body)
-    "Executes `body` while `expression` is true."
-    `(until (not ,expression)
-       ,@body))
-  
-
-  (defun ensure-boolean (x)
-    "Convert `x` into a Boolean value."
-    (and x t))
-  
-
-  (defun take (n sequence)
-    "Take the first `n` elements from `sequence`."
-    (subseq sequence 0 n))
-  
-
-  (defun n-grams (n sequence)
-    "Find all `n`-grams of the sequence `sequence`."
-    (assert (and (plusp n)
-                 (<= n (length sequence))))
-    
-    (etypecase sequence
-      ;; Lists
-      (list (loop :repeat (1+ (- (length sequence) n))
-                  :for seq :on sequence
-                  :collect (take n seq)))
-      
-      ;; General sequences
-      (sequence (loop :for i :to (- (length sequence) n)
-                      :collect (subseq sequence i (+ i n))))))
-  
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(define-constant switch eswitch cswitch while ensure-boolean
-            with-gensyms with-unique-names n-grams)))
-
-;;;; END OF quickutils.lisp ;;;;
diff -r ef04c7b3d0b8 -r a66997c0fad3 run-tests.lisp
--- a/run-tests.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-(let ((*standard-output* (make-broadcast-stream)))
-  (ql:quickload "euler"))
-
-
-(defvar *passed* t)
-
-(defun test (spec)
-  (let ((result (5am:run spec)))
-    (5am:explain! result)
-    (when (not (5am:results-status result))
-      (setf *passed* nil))))
-
-(test :euler)
-
-(sb-ext:exit :code (if *passed* 0 1))
diff -r ef04c7b3d0b8 -r a66997c0fad3 src/euler.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/euler.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -0,0 +1,177 @@
+(in-package :euler)
+
+;;;; Utils --------------------------------------------------------------------
+(defun digits (n)
+  "Return how many digits `n` has in base 10."
+  (values (truncate (1+ (log n 10)))))
+
+(defun definitely-palindrome-p (n)
+  "Return whether `n` is a palindrome (in base 10), the slow-but-sure way."
+  (let ((s (format nil "~D" n)))
+    (string= s (reverse s))))
+
+(defun palindrome-p (n)
+  "Return whether `n` is a palindrome (in base 10)."
+  (assert (>= n 0) (n) "~A must be a non-negative integer" n)
+  ;; All even-length base-10 palindromes are divisible by 11, so we can shortcut
+  ;; the awful string comparison. E.g.:
+  ;;
+  ;;   abccba =
+  ;;   100001 * a +
+  ;;   010010 * b +
+  ;;   001100 * c
+  (cond
+    ((zerop n) t)
+    ((and (evenp (digits n))
+          (not (dividesp n 11))) nil)
+    (t (definitely-palindrome-p n))))
+
+(defun range (from below)
+  (loop :for i :from from :below below
+        :collect i))
+
+(defun square (n)
+  (* n n))
+
+
+(defun random-exclusive (min max)
+  "Return an integer in the range (`min`, `max`)."
+  (+ 1 min (random (- max min 1))))
+(defun dividesp (n divisor)
+  "Return whether `n` is evenly divisible by `divisor`."
+  (zerop (mod n divisor)))
+
+
+;;;; Problems -----------------------------------------------------------------
+(defun problem-1 ()
+  ;; If we list all the natural numbers below 10 that are multiples of 3 or 5,
+  ;; we get 3, 5, 6 and 9. The sum of these multiples is 23.
+  ;;
+  ;; Find the sum of all the multiples of 3 or 5 below 1000.
+  (loop :for i :from 1 :below 1000
+        :when (or (dividesp i 3)
+                  (dividesp i 5))
+        :sum i))
+
+(defun problem-2 ()
+  ;; Each new term in the Fibonacci sequence is generated by adding the previous
+  ;; two terms. By starting with 1 and 2, the first 10 terms will be:
+  ;;
+  ;;     1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...
+  ;;
+  ;; By considering the terms in the Fibonacci sequence whose values do not
+  ;; exceed four million, find the sum of the even-valued terms.
+  (loop :with p = 0
+        :with n = 1
+        :while (<= n 4000000)
+        :when (evenp n) :sum n
+        :do (psetf p n
+                   n (+ p n))))
+
+(defun problem-3 ()
+  ;; The prime factors of 13195 are 5, 7, 13 and 29.
+  ;;
+  ;; What is the largest prime factor of the number 600851475143 ?
+  (apply #'max (prime-factorization 600851475143)))
+
+(defun problem-4 ()
+  ;; A palindromic number reads the same both ways. The largest palindrome made
+  ;; from the product of two 2-digit numbers is 9009 = 91 × 99.
+  ;;
+  ;; Find the largest palindrome made from the product of two 3-digit numbers.
+  (let ((result (list)))
+    (loop :for i :from 0 :to 999
+          :do (loop :for j :from 0 :to 999
+                    :for product = (* i j)
+                    :when (palindrome-p product)
+                    :do (push product result)))
+    (apply #'max result)))
+
+(defun problem-5 ()
+  ;; 2520 is the smallest number that can be divided by each of the numbers from
+  ;; 1 to 10 without any remainder.
+  ;;
+  ;; What is the smallest positive number that is evenly divisible by all of the
+  ;; numbers from 1 to 20?
+  (let ((divisors (range 11 21)))
+    ;; all numbers are divisible by 1 and we can skip checking everything <= 10
+    ;; because:
+    ;;
+    ;; anything divisible by 12 is automatically divisible by 2
+    ;; anything divisible by 12 is automatically divisible by 3
+    ;; anything divisible by 12 is automatically divisible by 4
+    ;; anything divisible by 15 is automatically divisible by 5
+    ;; anything divisible by 12 is automatically divisible by 6
+    ;; anything divisible by 14 is automatically divisible by 7
+    ;; anything divisible by 16 is automatically divisible by 8
+    ;; anything divisible by 18 is automatically divisible by 9
+    ;; anything divisible by 20 is automatically divisible by 10
+    (loop :for i
+          :from 20 :by 20 ; it must be divisible by 20
+          :when (every (lambda (n) (dividesp i n))
+                       divisors)
+          :return i)))
+
+(defun problem-6 ()
+  ;; The sum of the squares of the first ten natural numbers is,
+  ;;   1^2 + 2^2 + ... + 10^2 = 385
+  ;;
+  ;; The square of the sum of the first ten natural numbers is,
+  ;;   (1 + 2 + ... + 10)^2 = 55^2 = 3025
+  ;;
+  ;; Hence the difference between the sum of the squares of the first ten
+  ;; natural numbers and the square of the sum is 3025 − 385 = 2640.
+  ;;
+  ;; Find the difference between the sum of the squares of the first one hundred
+  ;; natural numbers and the square of the sum.
+  (flet ((sum-of-squares (to)
+           (loop :for i :from 1 :to to
+                 :sum (square i)))
+         (square-of-sum (to)
+           (square (loop :for i :from 1 :to to
+                         :sum i))))
+    (abs (- (sum-of-squares 100) ; apparently it wants the absolute value
+            (square-of-sum 100)))))
+
+(defun problem-7 ()
+  (nth-prime 10001))
+
+(defun problem-8 ()
+ (let ((digits (map 'list #'digit-char-p
+                    "7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940507754100225698315520005593572972571636269561882670428252483600823257530420752963450")))
+   (loop :for window :in (n-grams 13 digits)
+         :maximize (apply #'* window))))
+
+(defun problem-9 ()
+  (flet ((pythagorean-triplet-p (a b c)
+           (= (+ (square a) (square b))
+              (square c))))
+    (block search
+      (loop :for c :from 998 :downto 1 ; they must add up to 1000, so C can be at most 998
+            :do (loop :for a :from (- 999 c) :downto 1 ; A can be at most 999 - C (to leave 1 for B)
+                      :for b = (- 1000 c a)
+                      :when (pythagorean-triplet-p a b c)
+                      :do (return-from search (* a b c)))))))
+
+(defun problem-10 ()
+  (loop :for p :in (primes-below 2000000)
+        :sum p))
+
+
+;;;; Tests --------------------------------------------------------------------
+(def-suite :euler)
+(in-suite :euler)
+
+(test p1 (is (= 233168 (problem-1))))
+(test p2 (is (= 4613732 (problem-2))))
+(test p3 (is (= 6857 (problem-3))))
+(test p4 (is (= 906609 (problem-4))))
+(test p5 (is (= 232792560 (problem-5))))
+(test p6 (is (= 25164150 (problem-6))))
+(test p7 (is (= 104743 (problem-7))))
+(test p8 (is (= 23514624000 (problem-8))))
+(test p9 (is (= 31875000 (problem-9))))
+(test p10 (is (= 142913828922 (problem-10))))
+
+
+; (run! :euler)
diff -r ef04c7b3d0b8 -r a66997c0fad3 src/primes.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/primes.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -0,0 +1,164 @@
+(in-package :euler)
+
+(define-constant carmichael-numbers ; from oeis
+  '(561 1105 1729 2465 2821 6601 8911 10585 15841 29341 41041 46657 52633
+    62745 63973 75361 101101 115921 126217 162401 172081 188461 252601 278545
+    294409 314821 334153 340561 399001 410041 449065 488881 512461)
+  :test #'equal)
+
+(defun prime-factorization (n)
+  "Return the prime factors of `n`."
+  ;; from http://www.geeksforgeeks.org/print-all-prime-factors-of-a-given-number/
+  (let ((result (list)))
+    (iterate (while (evenp n)) ; handle 2, the only even prime factor
+             (push 2 result)
+             (setf n (/ n 2)))
+    (loop :for i :from 3 :to (sqrt n) :by 2 ; handle odd (prime) divisors
+          :do (iterate (while (dividesp n i))
+                       (push i result)
+                       (setf n (/ n i))))
+    (when (> n 2) ; final check in case we ended up with a prime
+      (push n result))
+    (nreverse result)))
+
+
+(defun expmod (base exp m)
+  "Return base^exp % m quickly."
+  ;; From SICP and
+  ;; https://rosettacode.org/wiki/Miller%E2%80%93Rabin_primality_test#Common_Lisp
+  ;;
+  ;; We want to avoid bignums as much as possible.  This computes (base^exp % m)
+  ;; without having to deal with huge numbers by taking advantage of the fact
+  ;; that:
+  ;;
+  ;;     (x * y) % m
+  ;;
+  ;; is equivalent to:
+  ;;
+  ;;     ((x % m) * (y % m)) % m
+  ;;
+  ;; So for the cases where `exp` is even, we can split base^exp into an x and
+  ;; y both equal to base^(exp/2) and use the above trick to handle them
+  ;; separately.  Even better, we can just compute it once and square it.
+  ;;
+  ;; We also make it tail recursive by keeping a running accumulator:
+  ;;
+  ;;    base^exp * acc
+  (labels
+      ((recur (base exp acc)
+         (cond
+           ((zerop exp) acc)
+           ((evenp exp)
+            (recur (rem (square base) m)
+                   (/ exp 2)
+                   acc))
+           (t
+            (recur base
+                   (1- exp)
+                   (rem (* base acc) m))))))
+    (recur base exp 1)))
+
+
+(defun fermat-prime-p (n &optional (tests 10))
+  "Return whether `n` might be prime.
+
+  Checks `tests` times.
+
+  If `t` is returned, `n` might be prime.  If `nil` is returned it is definitely
+  composite.
+
+  "
+  (flet ((fermat-check (a)
+           (= (expmod a n n) a)))
+    (loop :repeat tests
+          :when (not (fermat-check (random-exclusive 0 n)))
+          :do (return nil)
+          :finally (return t))))
+
+(defun factor-out (n factor)
+  "Factor the all the `factor`s out of `n`.
+
+  Turns `n` into:
+
+    factor^e * d
+
+  where `d` is no longer divisible by `n`, and returns `e` and `d`.
+
+  "
+  (loop :for d = n :then (/ d factor)
+        :for e = 0 :then (1+ e)
+        :while (dividesp d factor)
+        :finally (return (values e d))))
+
+(defun miller-rabin-prime-p (n &optional (k 10))
+  "Return whether `n` might be prime.
+
+  If `t` is returned, `n` is probably prime.
+  If `nil` is returned, `n` is definitely composite.
+
+  "
+  ;; https://rosettacode.org/wiki/Miller%E2%80%93Rabin_primality_test#Common_Lisp
+  (cond
+    ((< n 2) nil)
+    ((< n 4) t)
+    ((evenp n) nil)
+    (t (multiple-value-bind (r d)
+           (factor-out (1- n) 2)
+         (flet ((strong-liar-p (a)
+                  (let ((x (expmod a d n)))
+                    (or (= x 1)
+                        (loop :repeat r
+                              :for y = x :then (expmod y 2 n)
+                              :when (= y (1- n))
+                              :do (return t))))))
+           (loop :repeat k
+                 :for a = (random-exclusive 1 (1- n))
+                 :always (strong-liar-p a)))))))
+
+(defun brute-force-prime-p (n)
+  "Return (slowly) whether `n` is prime."
+  (cond
+    ((or (= n 0) (= n 1)) nil)
+    ((= n 2) t)
+    ((evenp n) nil)
+    (t (loop :for divisor :from 3 :to (sqrt n)
+          :when (dividesp n divisor)
+          :do (return nil)
+          :finally (return t)))))
+
+(defun primep (n)
+  "Return (less slowly) whether `n` is prime."
+  (cond
+    ;; short-circuit a few edge/common cases
+    ((< n 2) nil)
+    ((= n 2) t)
+    ((evenp n) nil)
+    ((< n 100000) (brute-force-prime-p n))
+    (t (miller-rabin-prime-p n))))
+
+
+(defun primes-below (n)
+  "Return the prime numbers less than `n`."
+  (cond
+    ((<= n 2) (list))
+    ((= n 3) (list 2))
+    (t (cons 2 (loop :for i :from 3 :by 2 :below n
+                     :when (primep i)
+                     :collect i)))))
+
+(defun primes-upto (n)
+  "Return the prime numbers less than or equal to `n`."
+  (primes-below (1+ n)))
+
+
+(defun nth-prime (n)
+  "Return the `n`th prime number."
+  (if (= n 1)
+    2
+    (loop :with seen = 1
+          :for i :from 3 :by 2
+          :when (primep i)
+          :do (progn
+                (incf seen)
+                (when (= seen n)
+                  (return i))))))
diff -r ef04c7b3d0b8 -r a66997c0fad3 utils.lisp
--- a/utils.lisp	Mon Apr 11 14:40:47 2016 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,15 +0,0 @@
-(in-package #:euler.utils)
-
-(defun random-exclusive (min max)
-  "Return an integer in the range (`min`, `max`)."
-  (+ 1 min (random (- max min 1))))
-
-(defun dividesp (n divisor)
-  "Return whether `n` is evenly divisible by `divisor`."
-  (zerop (mod n divisor)))
-
-
-(defmacro repeat (n &body body)
-  "Repeat `body` `n` times."
-  `(dotimes (,(gensym) ,n)
-     ,@body))
diff -r ef04c7b3d0b8 -r a66997c0fad3 vendor/make-quickutils.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/make-quickutils.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -0,0 +1,14 @@
+(ql:quickload 'quickutil)
+
+(qtlc:save-utils-as
+  "quickutils.lisp"
+  :utilities '(
+
+               :define-constant
+               :switch
+               :ensure-boolean
+               :with-gensyms
+               :n-grams
+
+               )
+  :package "EULER.QUICKUTILS")
diff -r ef04c7b3d0b8 -r a66997c0fad3 vendor/quickutils-package.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/quickutils-package.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -0,0 +1,12 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (unless (find-package "EULER.QUICKUTILS")
+    (defpackage "EULER.QUICKUTILS"
+      (:documentation "Package that contains Quickutil utility functions.")
+      (:use #:cl))))
+
+(in-package "EULER.QUICKUTILS")
+
+;; need to define this here so sbcl will shut the hell up about it being
+;; undefined when compiling quickutils.lisp.  computers are trash.
+(defparameter *utilities* nil)
+
diff -r ef04c7b3d0b8 -r a66997c0fad3 vendor/quickutils.lisp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/vendor/quickutils.lisp	Fri Feb 10 20:26:42 2017 +0000
@@ -0,0 +1,180 @@
+;;;; This file was automatically generated by Quickutil.
+;;;; See http://quickutil.org for details.
+
+;;;; To regenerate:
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:DEFINE-CONSTANT :SWITCH :ENSURE-BOOLEAN :WITH-GENSYMS :N-GRAMS) :ensure-package T :package "EULER.QUICKUTILS")
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (unless (find-package "EULER.QUICKUTILS")
+    (defpackage "EULER.QUICKUTILS"
+      (:documentation "Package that contains Quickutil utility functions.")
+      (:use #:cl))))
+
+(in-package "EULER.QUICKUTILS")
+
+(when (boundp '*utilities*)
+  (setf *utilities* (union *utilities* '(:DEFINE-CONSTANT :STRING-DESIGNATOR
+                                         :WITH-GENSYMS :EXTRACT-FUNCTION-NAME
+                                         :SWITCH :ENSURE-BOOLEAN :TAKE :N-GRAMS))))
+
+  (defun %reevaluate-constant (name value test)
+    (if (not (boundp name))
+        value
+        (let ((old (symbol-value name))
+              (new value))
+          (if (not (constantp name))
+              (prog1 new
+                (cerror "Try to redefine the variable as a constant."
+                        "~@<~S is an already bound non-constant variable ~
+                       whose value is ~S.~:@>" name old))
+              (if (funcall test old new)
+                  old
+                  (restart-case
+                      (error "~@<~S is an already defined constant whose value ~
+                              ~S is not equal to the provided initial value ~S ~
+                              under ~S.~:@>" name old new test)
+                    (ignore ()
+                      :report "Retain the current value."
+                      old)
+                    (continue ()
+                      :report "Try to redefine the constant."
+                      new)))))))
+
+  (defmacro define-constant (name initial-value &key (test ''eql) documentation)
+    "Ensures that the global variable named by `name` is a constant with a value
+that is equal under `test` to the result of evaluating `initial-value`. `test` is a
+function designator that defaults to `eql`. If `documentation` is given, it
+becomes the documentation string of the constant.
+
+Signals an error if `name` is already a bound non-constant variable.
+
+Signals an error if `name` is already a constant variable whose value is not
+equal under `test` to result of evaluating `initial-value`."
+    `(defconstant ,name (%reevaluate-constant ',name ,initial-value ,test)
+       ,@(when documentation `(,documentation))))
+  
+
+  (deftype string-designator ()
+    "A string designator type. A string designator is either a string, a symbol,
+or a character."
+    `(or symbol string character))
+  
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defmacro with-gensyms (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(let ,(mapcar (lambda (name)
+                     (multiple-value-bind (symbol string)
+                         (etypecase name
+                           (symbol
+                            (values name (symbol-name name)))
+                           ((cons symbol (cons string-designator null))
+                            (values (first name) (string (second name)))))
+                       `(,symbol (gensym ,string))))
+            names)
+       ,@forms))
+
+  (defmacro with-unique-names (names &body forms)
+    "Binds each variable named by a symbol in `names` to a unique symbol around
+`forms`. Each of `names` must either be either a symbol, or of the form:
+
+    (symbol string-designator)
+
+Bare symbols appearing in `names` are equivalent to:
+
+    (symbol symbol)
+
+The string-designator is used as the argument to `gensym` when constructing the
+unique symbol the named variable will be bound to."
+    `(with-gensyms ,names ,@forms))
+  )                                        ; eval-when
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun extract-function-name (spec)
+    "Useful for macros that want to mimic the functional interface for functions
+like `#'eq` and `'eq`."
+    (if (and (consp spec)
+             (member (first spec) '(quote function)))
+        (second spec)
+        spec))
+  )                                        ; eval-when
+
+  (eval-when (:compile-toplevel :load-toplevel :execute)
+    (defun generate-switch-body (whole object clauses test key &optional default)
+      (with-gensyms (value)
+        (setf test (extract-function-name test))
+        (setf key (extract-function-name key))
+        (when (and (consp default)
+                   (member (first default) '(error cerror)))
+          (setf default `(,@default "No keys match in SWITCH. Testing against ~S with ~S."
+                                    ,value ',test)))
+        `(let ((,value (,key ,object)))
+           (cond ,@(mapcar (lambda (clause)
+                             (if (member (first clause) '(t otherwise))
+                                 (progn
+                                   (when default
+                                     (error "Multiple default clauses or illegal use of a default clause in ~S."
+                                            whole))
+                                   (setf default `(progn ,@(rest clause)))
+                                   '(()))
+                                 (destructuring-bind (key-form &body forms) clause
+                                   `((,test ,value ,key-form)
+                                     ,@forms))))
+                           clauses)
+                 (t ,default))))))
+
+  (defmacro switch (&whole whole (object &key (test 'eql) (key 'identity))
+                    &body clauses)
+    "Evaluates first matching clause, returning its values, or evaluates and
+returns the values of `default` if no keys match."
+    (generate-switch-body whole object clauses test key))
+
+  (defmacro eswitch (&whole whole (object &key (test 'eql) (key 'identity))
+                     &body clauses)
+    "Like `switch`, but signals an error if no key matches."
+    (generate-switch-body whole object clauses test key '(error)))
+
+  (defmacro cswitch (&whole whole (object &key (test 'eql) (key 'identity))
+                     &body clauses)
+    "Like `switch`, but signals a continuable error if no key matches."
+    (generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
+  
+
+  (defun ensure-boolean (x)
+    "Convert `x` into a Boolean value."
+    (and x t))
+  
+
+  (defun take (n sequence)
+    "Take the first `n` elements from `sequence`."
+    (subseq sequence 0 n))
+  
+
+  (defun n-grams (n sequence)
+    "Find all `n`-grams of the sequence `sequence`."
+    (assert (and (plusp n)
+                 (<= n (length sequence))))
+    
+    (etypecase sequence
+      ;; Lists
+      (list (loop :repeat (1+ (- (length sequence) n))
+                  :for seq :on sequence
+                  :collect (take n seq)))
+      
+      ;; General sequences
+      (sequence (loop :for i :to (- (length sequence) n)
+                      :collect (subseq sequence i (+ i n))))))
+  
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (export '(define-constant switch eswitch cswitch ensure-boolean with-gensyms
+            with-unique-names n-grams)))
+
+;;;; END OF quickutils.lisp ;;;;