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