--- a/src/euler.lisp Tue Feb 21 21:08:17 2017 +0000
+++ b/src/euler.lisp Wed Feb 22 12:41:39 2017 +0000
@@ -643,6 +643,23 @@
(return t)))))
(sum (remove-if #'abundant-sum-p (range 1 (1+ limit)))))))
+(defun problem-24 ()
+ ;; A permutation is an ordered arrangement of objects. For example, 3124 is
+ ;; one possible permutation of the digits 1, 2, 3 and 4. If all of the
+ ;; permutations are listed numerically or alphabetically, we call it
+ ;; lexicographic order. The lexicographic permutations of 0, 1 and 2 are:
+ ;;
+ ;; 012 021 102 120 201 210
+ ;;
+ ;; What is the millionth lexicographic permutation of the digits 0, 1, 2, 3,
+ ;; 4, 5, 6, 7, 8 and 9?
+ (-<> "0123456789"
+ (gathering-vector (:size (factorial (length <>)))
+ (map-permutations #'gather <>))
+ (map-into <> #'parse-integer <>)
+ (sort <> #'<)
+ (elt <> (1- 1000000))))
+
;;;; Tests --------------------------------------------------------------------
(def-suite :euler)
@@ -671,6 +688,7 @@
(test p21 (is (= 31626 (problem-21))))
(test p22 (is (= 871198282 (problem-22))))
(test p23 (is (= 4179871 (problem-23))))
+(test p24 (is (= 2783915460 (problem-24))))
;; (run! :euler)
--- a/vendor/make-quickutils.lisp Tue Feb 21 21:08:17 2017 +0000
+++ b/vendor/make-quickutils.lisp Wed Feb 22 12:41:39 2017 +0000
@@ -4,13 +4,15 @@
"quickutils.lisp"
:utilities '(
+ :compose
:curry
:define-constant
:ensure-boolean
- :read-file-into-string
+ :map-permutations
:n-grams
:range
:rcurry
+ :read-file-into-string
:switch
:with-gensyms
--- a/vendor/quickutils.lisp Tue Feb 21 21:08:17 2017 +0000
+++ b/vendor/quickutils.lisp Wed Feb 22 12:41:39 2017 +0000
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :READ-FILE-INTO-STRING :N-GRAMS :RANGE :RCURRY :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :DEFINE-CONSTANT :ENSURE-BOOLEAN :MAP-PERMUTATIONS :N-GRAMS :RANGE :RCURRY :READ-FILE-INTO-STRING :SWITCH :WITH-GENSYMS) :ensure-package T :package "EULER.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "EULER.QUICKUTILS")
@@ -14,13 +14,14 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :CURRY :DEFINE-CONSTANT
- :ENSURE-BOOLEAN :ONCE-ONLY
+ :COMPOSE :CURRY :DEFINE-CONSTANT
+ :ENSURE-BOOLEAN :MAP-COMBINATIONS
+ :MAP-PERMUTATIONS :TAKE :N-GRAMS
+ :RANGE :RCURRY :ONCE-ONLY
:WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE
- :READ-FILE-INTO-STRING :TAKE :N-GRAMS
- :RANGE :RCURRY :STRING-DESIGNATOR
- :WITH-GENSYMS :EXTRACT-FUNCTION-NAME
- :SWITCH))))
+ :READ-FILE-INTO-STRING
+ :STRING-DESIGNATOR :WITH-GENSYMS
+ :EXTRACT-FUNCTION-NAME :SWITCH))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
"Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -45,6 +46,35 @@
(fdefinition function-designator)))
) ; eval-when
+ (defun compose (function &rest more-functions)
+ "Returns a function composed of `function` and `more-functions` that applies its ;
+arguments to to each in turn, starting from the rightmost of `more-functions`,
+and then calling the next one with the primary value of the last."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (reduce (lambda (f g)
+ (let ((f (ensure-function f))
+ (g (ensure-function g)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ (funcall f (apply g arguments)))))
+ more-functions
+ :initial-value function))
+
+ (define-compiler-macro compose (function &rest more-functions)
+ (labels ((compose-1 (funs)
+ (if (cdr funs)
+ `(funcall ,(car funs) ,(compose-1 (cdr funs)))
+ `(apply ,(car funs) arguments))))
+ (let* ((args (cons function more-functions))
+ (funs (make-gensym-list (length args) "COMPOSE")))
+ `(let ,(loop for f in funs for arg in args
+ collect `(,f (ensure-function ,arg)))
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (lambda (&rest arguments)
+ (declare (dynamic-extent arguments))
+ ,(compose-1 funs))))))
+
+
(defun curry (function &rest arguments)
"Returns a function that applies `arguments` and the arguments
it is called with to `function`."
@@ -107,6 +137,138 @@
(and x t))
+ (defun map-combinations (function sequence &key (start 0) end length (copy t))
+ "Calls `function` with each combination of `length` constructable from the
+elements of the subsequence of `sequence` delimited by `start` and `end`. `start`
+defaults to `0`, `end` to length of `sequence`, and `length` to the length of the
+delimited subsequence. (So unless `length` is specified there is only a single
+combination, which has the same elements as the delimited subsequence.) If
+`copy` is true (the default) each combination is freshly allocated. If `copy` is
+false all combinations are `eq` to each other, in which case consequences are
+specified if a combination is modified by `function`."
+ (let* ((end (or end (length sequence)))
+ (size (- end start))
+ (length (or length size))
+ (combination (subseq sequence 0 length))
+ (function (ensure-function function)))
+ (if (= length size)
+ (funcall function combination)
+ (flet ((call ()
+ (funcall function (if copy
+ (copy-seq combination)
+ combination))))
+ (etypecase sequence
+ ;; When dealing with lists we prefer walking back and
+ ;; forth instead of using indexes.
+ (list
+ (labels ((combine-list (c-tail o-tail)
+ (if (not c-tail)
+ (call)
+ (do ((tail o-tail (cdr tail)))
+ ((not tail))
+ (setf (car c-tail) (car tail))
+ (combine-list (cdr c-tail) (cdr tail))))))
+ (combine-list combination (nthcdr start sequence))))
+ (vector
+ (labels ((combine (count start)
+ (if (zerop count)
+ (call)
+ (loop for i from start below end
+ do (let ((j (- count 1)))
+ (setf (aref combination j) (aref sequence i))
+ (combine j (+ i 1)))))))
+ (combine length start)))
+ (sequence
+ (labels ((combine (count start)
+ (if (zerop count)
+ (call)
+ (loop for i from start below end
+ do (let ((j (- count 1)))
+ (setf (elt combination j) (elt sequence i))
+ (combine j (+ i 1)))))))
+ (combine length start)))))))
+ sequence)
+
+
+ (defun map-permutations (function sequence &key (start 0) end length (copy t))
+ "Calls function with each permutation of `length` constructable
+from the subsequence of `sequence` delimited by `start` and `end`. `start`
+defaults to `0`, `end` to length of the sequence, and `length` to the
+length of the delimited subsequence."
+ (let* ((end (or end (length sequence)))
+ (size (- end start))
+ (length (or length size)))
+ (labels ((permute (seq n)
+ (let ((n-1 (- n 1)))
+ (if (zerop n-1)
+ (funcall function (if copy
+ (copy-seq seq)
+ seq))
+ (loop for i from 0 upto n-1
+ do (permute seq n-1)
+ (if (evenp n-1)
+ (rotatef (elt seq 0) (elt seq n-1))
+ (rotatef (elt seq i) (elt seq n-1)))))))
+ (permute-sequence (seq)
+ (permute seq length)))
+ (if (= length size)
+ ;; Things are simple if we need to just permute the
+ ;; full START-END range.
+ (permute-sequence (subseq sequence start end))
+ ;; Otherwise we need to generate all the combinations
+ ;; of LENGTH in the START-END range, and then permute
+ ;; a copy of the result: can't permute the combination
+ ;; directly, as they share structure with each other.
+ (let ((permutation (subseq sequence 0 length)))
+ (flet ((permute-combination (combination)
+ (permute-sequence (replace permutation combination))))
+ (declare (dynamic-extent #'permute-combination))
+ (map-combinations #'permute-combination sequence
+ :start start
+ :end end
+ :length length
+ :copy nil)))))))
+
+
+ (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))))))
+
+
+ (defun range (start end &key (step 1) (key 'identity))
+ "Return the list of numbers `n` such that `start <= n < end` and
+`n = start + k*step` for suitable integers `k`. If a function `key` is
+provided, then apply it to each number."
+ (assert (<= start end))
+ (loop :for i :from start :below end :by step :collecting (funcall key i)))
+
+
+ (defun rcurry (function &rest arguments)
+ "Returns a function that applies the arguments it is called
+with and `arguments` to `function`."
+ (declare (optimize (speed 3) (safety 1) (debug 1)))
+ (let ((fn (ensure-function function)))
+ (lambda (&rest more)
+ (declare (dynamic-extent more))
+ (multiple-value-call fn (values-list more) (values-list arguments)))))
+
+
(defmacro once-only (specs &body forms)
"Evaluates `forms` with symbols specified in `specs` rebound to temporary
variables, ensuring that each initform is evaluated only once.
@@ -198,45 +360,6 @@
:while (= bytes-read buffer-size)))))))
- (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))))))
-
-
- (defun range (start end &key (step 1) (key 'identity))
- "Return the list of numbers `n` such that `start <= n < end` and
-`n = start + k*step` for suitable integers `k`. If a function `key` is
-provided, then apply it to each number."
- (assert (<= start end))
- (loop :for i :from start :below end :by step :collecting (funcall key i)))
-
-
- (defun rcurry (function &rest arguments)
- "Returns a function that applies the arguments it is called
-with and `arguments` to `function`."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (let ((fn (ensure-function function)))
- (lambda (&rest more)
- (declare (dynamic-extent more))
- (multiple-value-call fn (values-list more) (values-list arguments)))))
-
-
(deftype string-designator ()
"A string designator type. A string designator is either a string, a symbol,
or a character."
@@ -331,7 +454,8 @@
(generate-switch-body whole object clauses test key '(cerror "Return NIL from CSWITCH.")))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(curry define-constant ensure-boolean read-file-into-string n-grams
- range rcurry switch eswitch cswitch with-gensyms with-unique-names)))
+ (export '(compose curry define-constant ensure-boolean map-permutations
+ n-grams range rcurry read-file-into-string switch eswitch cswitch
+ with-gensyms with-unique-names)))
;;;; END OF quickutils.lisp ;;;;