fast fibonacci transform (based on code in github.com/ekmett/fractions)

fib.hs

{-# language DefaultSignatures #-}

-- @Fib a b :: Fib r@ denotes @aΦ + b@ ∈ r(Φ)
data Fib a = Fib !a !a
  deriving (Show, Functor, Foldable, Traversable, Eq)

instance (Num a, Ord a) => Ord (Fib a) where
  compare (Fib a b) (Fib c d) = case compare a c of
    LT | b <= d    -> LT
       | otherwise -> go compare (a-c) (b-d)
    EQ -> compare b d
    GT | b >= d    -> GT
       | otherwise -> go (flip compare) (a-c) (b-d)
   where
     go k e f = k (sq (e+2*f)) (5*sq e)
     sq x = x*x

instance Num a => Num (Fib a) where
  Fib a b + Fib c d = Fib (a + c) (b + d)
  -- Φ^2 = Φ+1, so (aΦ+b)(cΦ+d) = ac(Φ+1) + (ad+bc)Φ + bd == (ac+ad+bc)Φ + (ac+bd)
  Fib a b * Fib c d = Fib (a*(c + d) + b*c) (a*c + b*d)
  Fib a b - Fib c d = Fib (a - c) (b - d)
  negate (Fib a b) = Fib (negate a) (negate b)
  abs x = x
  signum _ = Fib 0 1
  fromInteger n = Fib 0 (fromInteger n)

instance Fractional a => Fractional (Fib a) where
  recip (Fib a b) = Fib (-a/d) ((a+b)/d) where
    d = b*b + a*b - a*a
  fromRational r = Fib 0 (fromRational r)

instance Applicative Fib where
  pure a = Fib a a
  Fib a b <*> Fib c d = Fib (a c) (b d)

instance Monad Fib where
  return = pure
  Fib a b >>= f = Fib a' b' where
    Fib a' _ = f a
    Fib _ b' = f b

class (Eq a, Num a) => Golden a where
  phi :: a
  default phi :: Floating a => a
  phi = (1 + sqrt 5)*0.5

  sqrt5 :: a
  sqrt5 = 2*phi - 1

  iphi :: a
  iphi = phi - 1

instance (Eq a, Num a) => Golden (Fib a) where
  phi = Fib 1 0

instance Golden Float
instance Golden Double

unfib :: Golden a => Fib a -> a
unfib (Fib a b) = a*phi + b

getPhi :: Fib a -> a
getPhi (Fib a _) = a

-- fast fibonacci transform
fib :: (Eq a, Num a) => Integer -> a
fib n
  | n >= 0 = getPhi (phi ^ n)
  | otherwise = getPhi (iphi ^ negate n)