import System.CPUTime
import Text.Printf (printf)
import Data.List (findIndex)

time :: (Show a) => a -> IO a
time result = do
    start <- getCPUTime
    let computed = result
    end <- computed `seq` getCPUTime
    let diff = (fromIntegral (end - start)::Float)/(10^12)
    printf "Result: %s\n Time taken: %.6f seconds\n" (show computed) diff
    return computed
    
matrixMultiply :: Num a => [(a, a)] -> [(a, a)] -> [(a, a)]
matrixMultiply [(a11, a12), (a21, a22)] [(b11, b12), (b21, b22)] =
  [ (a11*b11 + a12*b21, a11*b12 + a12*b22)
  , (a21*b11 + a22*b21, a21*b12 + a22*b22) ]
 
matrixPower :: Num a => [(a, a)] -> Int -> [(a, a)]
matrixPower m 1 = m
matrixPower m n =
  let half = matrixPower m (n `div` 2)
      squared = matrixMultiply half half
  in if odd n then matrixMultiply squared m else squared
 
digitsInNumber :: (Show a, Integral a) => a -> Int
digitsInNumber = length . show
 
fibNth :: Integral a => a -> a
fibNth n 
  | n <= 2    = 1
  | otherwise = fst $ head $ matrixPower [(1, 1), (1, 0)] (fromIntegral (n - 1))
 
fibUpperBound :: Int -> Integer
fibUpperBound digitCount =
  let phi = 1.618033988749895
      logPhi = logBase 10 phi
      log5 = logBase 10 5
  in ceiling $ (fromIntegral digitCount - 1 + (log5 / 2)) / logPhi
 
binarySearchFibIndex :: Int -> Maybe Integer
binarySearchFibIndex digitCount =
  let upperBound = fibUpperBound digitCount
      binarySearch left right 
        | left > right = Nothing
        | otherwise =
            let mid = left + (right - left) `div` 2
                midFib = fibNth mid
                midDigits = digitsInNumber midFib
            in case compare midDigits digitCount of
                 EQ ->
                   let prevDigits = digitsInNumber $ fibNth (mid - 1)
                   in if prevDigits < digitCount then Just mid else binarySearch left (mid - 1)
                 LT -> binarySearch (mid + 1) right
                 GT -> binarySearch left (mid - 1)
  in binarySearch 1 upperBound

λ> time $ binarySearchFibIndex 1000
Result: Just 4782
 Time taken: 0.000852 seconds
Just 4782
λ> 

λ> time $ binarySearchFibIndex 1000
Result: Just 4782
 Time taken: 0.006747 seconds
Just 4782
λ> 

— Me@2024-12-25 07:00:13 AM

.

.

2025.01.01 Wednesday (c) All rights reserved by ACHK