# HG changeset patch # User Steve Losh # Date 1541115866 14400 # Node ID 5e5dd3fd5ae005c36c39e5d0cb96cf0579e886e2 # Parent 99fa06464617ebc7d2cad78be1ba63fb4907f86c Problems 71 and 73 diff -r 99fa06464617 -r 5e5dd3fd5ae0 src/problems.lisp --- a/src/problems.lisp Tue Jul 31 16:18:33 2018 +0000 +++ b/src/problems.lisp Thu Nov 01 19:44:26 2018 -0400 @@ -1592,6 +1592,60 @@ (while (<= n 1000000)) (finally (return result)))) +(defun problem-71 () + ;; Consider the fraction, n/d, where n and d are positive integers. If n (denominator next) limit) + (return (numerator guess)) + (setf guess next)))) + +(defun problem-73 () + ;; Consider the fraction, n/d, where n and d are positive integers. If n + (0 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1) + + " + (with-gensyms (n% prev) + (let ((kwd (if generate 'generate 'for))) + `(progn + (with ,n% = ,n) + (with ,prev = 0) + (,kwd ,var :do-next + (if-first-time + (setf ,var 0) + (psetf ,var (or (next-farey-term ,prev ,var ,n%) (terminate)) + ,prev ,var))))))) + (defmacro when-first-time (&body body) `(if-first-time @@ -345,6 +369,16 @@ (u (- 1 v w))) (values u v w))) +(defun mediant (x y) + "Return the mediant of `x` and `y`." + ;; The mediant operation is: + ;; + ;; A C A + C + ;; - ⊕ - = ----- + ;; B D B + D + (/ (+ (numerator x) (numerator y)) + (+ (denominator x) (denominator y)))) + ;;;; Digits ------------------------------------------------------------------- (defun digits-length (n &optional (radix 10)) @@ -781,8 +815,6 @@ (define-modify-macro adjoinf (item &rest keyword-args) adjoin%) - - (defun pythagorean-triplet-p (a b c) (math a ^ 2 + b ^ 2 = c ^ 2)) @@ -818,6 +850,40 @@ (recur (mv* d triple)))))) +;;;; Farey Sequences ---------------------------------------------------------- +(defun next-farey-term (x y n) + "Return the next term in the Farey sequence Fₙ after `x` and `y`, or `nil`. + + For convenience, if `y` is zero `x` is not examined. + + If `y` is `1` the sequence is complete and `nil` is returned. + + " + (declare (type (rational 0 1) x y) + (type (integer 1) n)) + (case y + (0 (/ 1 n)) + (1 nil) + (t (let* ((a (numerator x)) + (b (denominator x)) + (c (numerator y)) + (d (denominator y)) + (k (floor (+ n b) d)) + (p (- (* k c) a)) + (q (- (* k d) b))) + (/ p q))))) + +(defun farey (n) + "Return the Farey sequence Fₙ as a fresh list." + (iterate (for x :in-farey-sequence n) + (collect x))) + +(defun approximate-farey-length (n) + "Return an approximation of the length of the Farey sequence Fₙ." + (/ (* 3 (expt n 2)) + (expt pi 2))) + + ;;;; Geometric Numbers -------------------------------------------------------- (defun squarep (n) "Return whether `n` is a perfect square." @@ -974,7 +1040,6 @@ (* precision (round number precision))) - ;;;; A* Search ---------------------------------------------------------------- (defstruct path state