-----------------------------------------------------------------------------
--
-- Module      :  Math.GeometricSeries
-- Copyright   :  (c) 2014-16 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <consult@brianwbush.info>
-- Stability   :  Stable
-- Portability :  Portable
--
-- | Geometric series.
--
-----------------------------------------------------------------------------


{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Safe          #-}


module Math.GeometricSeries (
-- * Types
  GeometricSeries(..)
-- * Functions
, asFunction
) where


import GHC.Generics (Generic)


-- | A geometric series.
data GeometricSeries a =
  GeometricSeries
    {
      independentStart :: a -- ^ The initial value of the independent variable.
    , dependentStart   :: a -- ^ The initial value of the dependent variable.
    , escalationRate   :: a -- ^ The escalation per unit of the independent variable.
    }
    deriving (Generic, Read, Show)


-- | Convert to a function.
asFunction :: Floating a
           => GeometricSeries a -- ^ The geometric series.
          -> a                  -- ^ The independent variable.
          -> a                  -- ^ The dependent variable.
asFunction GeometricSeries{..} x = dependentStart * (1 + escalationRate)**(x - independentStart)