-- | Common functions and constants
module Data.Number.Functions where

import Data.Number.Types
import Data.Number.Instances
import Data.Number.Internal
import Data.Number.Peano
import Data.Ratio

-- Various --

-- | Get the precision of a 'Number' (i.e. length)
precision :: Number -> Nat
precision E       = Z
precision (_:|xs) = S (precision xs)

-- | Alternative show function that pretty prints a 'Number'
-- also doing conversions from Peano numbers
show' :: Number -> String
show' E           = "0"
show' (x:|E)      = show (toInteger x)
show' (x:|xs)     = show (toInteger x) ++ " + 1/(" ++ show' xs ++ ")"
show' (M (x:|xs)) = '-' : show (toInteger x) ++ " - 1/(" ++ show' xs ++ ")"


-- Conversion --

-- | Create a 'Number' from a list of naturals
fromList :: [Nat] -> Number
fromList []     = E
fromList (x:xs) = x :| fromList xs

-- | Convert a 'Number' to a list of naturals (losing the sign)
toList :: Number -> [Nat]
toList E = []
toList (x:|xs) = x : toList xs


-- constants --

-- | The infinite continued fraction whose terms are naturals numbers
--
-- <<https://i.imgur.com/wYz0tig.png>>
σ :: Number
σ = σ' 0 where
  σ' n = n :| σ' (succ n)

-- | The golden ratio
--
-- <<https://i.imgur.com/3Yb5bWc.png>>
φ :: Number
φ = 1 :| φ

-- | Pi: the ratio of a circle's circumference to its diameter
--
--  <<https://i.imgur.com/S1F6UoI.png>>
π :: Number
π = toNumber (80143857 % 25510582)

-- | Euler's number: the base of the natural logarithm
--
-- <<https://i.imgur.com/q1SwKoy.png>>
e :: Number
e = fmap a σ where 
  a n | p == 0    = 2*q
      | otherwise = 1
    where (q, p) = quotRem n 3