# HG changeset patch # User Steve Losh # Date 1486758402 0 # Node ID a66997c0fad34674f1a21bb02e33746ed18be780 # Parent ef04c7b3d0b82611e81e8beea2d0f29482050606 Modernize repo 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 ;;;;