Euler problem 25.1.2

(defun matrix-multiply (a b)
  (destructuring-bind ((a11 a12) (a21 a22)) a
    (destructuring-bind ((b11 b12) (b21 b22)) b
      (list (list (+ (* a11 b11) (* a12 b21))
                  (+ (* a11 b12) (* a12 b22)))
            (list (+ (* a21 b11) (* a22 b21))
                  (+ (* a21 b12) (* a22 b22)))))))

(defun matrix-power (m n)
  (declare (type fixnum n))
  (cond ((= n 1) m)
        (t (let* ((half (matrix-power m (floor n 2)))
                  (squared (matrix-multiply half half)))
             (if (oddp n)
                 (matrix-multiply squared m)
                 squared)))))

(defun digits-in-number (n)
  "Count the number of digits in a number."
  (length (write-to-string n)))

(defun fib-nth (n)
  (declare (type fixnum n))
  (if (<= n 2)
      1
      (destructuring-bind ((result b)
                           (c d))
          (matrix-power '((1 1) (1 0)) (- n 1))
        (declare (ignore b c d))
        result)))

(defun fib-upper-bound (digit-count)
  "Calculate an upper bound for the index where Fibonacci has at least digit-count digits."
  (let* ((phi (float 1.618033988749895))
         (log-phi (log phi 10))
         (log-5 (log 5 10)))
    (ceiling (/ (+ digit-count (- 1 (/ log-5 2))) log-phi))))

(defun binary-search-fib-index (digit-count)
  "Find the index of the first Fibonacci number with the specified number of digits using binary search."
  (labels ((binary-search (left right)
             (when (<= left right)
               (let* ((mid (+ left (floor
                                    (/ (- right left) 2))))
                      (mid-fib (fib-nth mid))
                      (mid-digits (digits-in-number mid-fib)))
                 (cond ((= mid-digits digit-count) 
                        (let* ((prev-fib (fib-nth (1- mid)))
                               (prev-digits (digits-in-number
                                             prev-fib)))
                          (if (< prev-digits digit-count)
                              mid
                              (binary-search left (1- mid)))))
                       ((< mid-digits digit-count) 
                        (binary-search (1+ mid) right))
                       (t 
                        (binary-search left (1- mid))))))))
    (let* ((upper-bound (fib-upper-bound digit-count))
           (result (binary-search 1 upper-bound)))
      (or result (cons :upper-bound upper-bound)))))

; SLIME 2.28
CL-USER> (time (binary-search-fib-index 1000))
Evaluation took:
  0.001 seconds of real time
  
4782
CL-USER> 

— Me@2024-12-10 07:23:47 PM

.

.

2024.12.16 Monday (c) All rights reserved by ACHK