haslo-0.1: Haslo/Calculator.hs
---------------------------------------------------------
--
-- Module : Calculator
-- Copyright : Bartosz Wójcik (2010)
-- License : BSD3
--
-- Maintainer : bartek@sudety.it
-- Stability : Unstable
-- Portability : portable
--
-- | Basic loan arithmetics.
---------------------------------------------------------
module Haslo.Calculator (cE2N
,cN2E
,rawCalcInstCl
,rawCalcInstBal
,rawCalcInstBalPlus
,rawCalcBalBal
,rawCalcMaxFstInst
,rateIrr
,calcDurCl
,calcCapBeforeBal
,calcCapAfterN
,calcCapCl
)
where
import Haslo.BasicType
import Haslo.CalcCalendar (Freq,freqPerYear)
import Haslo.ErrorHandling
moduleName = "Calculator"
-- ============================
-- Set of calculation functions
-- ============================
-- | Converse yealry Effective rate to Nominal one.
-- Nominal is in the frequency mode
cE2N :: Freq -> Rate -> Rate
cE2N fr r = (1+r)**(1/n) - 1
where n = freqPerYear fr
-- | Converse Nominal rate to yearly Effective one.
-- Nominal is in the frequency mode
cN2E :: Freq -> Rate -> Rate
cN2E fr r = (1+r)^n - 1
where n = freqPerYear fr
-- Raw installment and capital calculations for some type of loans (raw - not adjusted to Amount).
-- c-capital amount
-- i-installment amount
-- n-number of instalments
-- r-interest rate in same frequency as installment
-- d - 1st installment delay in frequency units
-- | Cacluates principal for given instalment amount, duration, interest rate and 1st instalment deferrment.
rawCalcCapCl :: Double -- ^ Instalment amount deAmounted
-> Duration -- ^ Loan duration
-> Rate -- ^ Interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double
rawCalcCapCl i n 0 _ = i * (fromIntegral n)
rawCalcCapCl i n r d = i * (1-p^n) / (p^n * (1-p)) / p^d
where p = (1+r)**(1/12)
-- | Calculates raw instalment amount -- not yet rounded or truncated.
rawCalcInstCl :: Double -- ^ Principal deAmounted
-> Duration -- ^ Loan duration
-> Rate -- ^ Interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double
rawCalcInstCl _ 0 _ _ = 0
rawCalcInstCl c n 0 _ = c / (fromIntegral n)
rawCalcInstCl c n r d = c * p^d * p^n * r / (p^n - 1)
where p = r+1
-- b - balloon installment amount
rawCalcCapBal b i n 0 d = i * fromIntegral (n-1) + b
rawCalcCapBal b i n r d = b/p^n + rawCalcCapCl i (n-1) r d
where p = r+1
-- | Cacluates instalment amount for given principal, duration, interest rate, 1st instalment deferrment and
-- balloon amount.For @Balloon@ loan constructor.
rawCalcInstBal :: Double -- ^ Principal deAmounted
-> Duration -- ^ Loan duration
-> Rate -- ^ Interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double -- ^ Balloon amount deAmounted
-> Double
rawCalcInstBal _ 0 _ _ _ = 0
rawCalcInstBal c n 0 _ b = (c - b) / (fromIntegral n - 1)
rawCalcInstBal c n r d b = (c * p^d - b/p^n) * p^m * r / (p^m - 1)
where p = r+1
m = n-1
--rawCalcInstBal c n r d b = (c * p^d - b*q^n)*(q-1) / (q^n - q)
-- where p = r+1
-- q = 1/p
-- | Cacluates ballon amount for given principal, duration, interest rate, 1st instalment deferrment and
-- instalment amount.
rawCalcBalBal :: Double -- ^ Principal deAmounted
-> Duration -- ^ Loan duration
-> Rate -- ^ Interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double -- ^ Instalment amount deAmounted
-> Double
rawCalcBalBal c n 0 _ i = c - i * (fromIntegral n - 1)
rawCalcBalBal c n r d i = (c * p^d - i * (q^n - q)/(q - 1)) * p^n
where p = r+1
q = 1/p
-- | Balloon Plus -- balloon amount + usual amount = last instalment amount
rawCalcCapBalPlus b i n 0 d = i * fromIntegral n + b
rawCalcCapBalPlus b i n r d = b/p^n + rawCalcCapCl i n r d
where p = (1+r)**(1/12)
-- | Cacluates instalment amount for given principal, duration, interest rate, 1st instalment deferrment and
-- balloon amount. For @BalloonPlus@ loan constructor.
rawCalcInstBalPlus :: Double -- ^ Principal deAmounted
-> Duration -- ^ Loan duration
-> Rate -- ^ Interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double -- ^ Balloon amount deAmounted
-> Double
rawCalcInstBalPlus _ 0 _ _ _ = 0
rawCalcInstBalPlus c n 0 _ b = (c - b) / fromIntegral n
rawCalcInstBalPlus c n r d b = (c*p^(n+d) - b)*r / (p^n - 1)
where p = r+1
rawCalcBalBalPlus c n 0 _ i = c - i * fromIntegral n
rawCalcBalBalPlus c n r d i = c*p^d - i * (1 - p^n)/(1 - p)
where p = (1+r)**(1/12)
-- | Calculated maximum amount of first instalment: for @Bullet@ loan constructor.
rawCalcMaxFstInst :: Double -- ^ Principal deAmounted
-> Duration -- ^ Instalment duration
-> Rate -- ^ Nominal interest rate
-> Duration -- ^ 1st instalment deferrment
-> Double
rawCalcMaxFstInst _ _ 0 _ = 0
rawCalcMaxFstInst c n r d = c * p^d * (p^n - 1)/(p^(n-1))
where p = 1+r
-- | Instalment amount under when k-th instalment is greater than calculated one
-- by x.
--calcInstWithKth x k c n r d = rawCalcInstCl c r n d - x * (r+1)^(n-k-1) * r / ((r+1)^n - 1)
--calcInstBalWithKth x k c n r d b = rawCalcInstBal c n r d b - x * (r+1)^(n-k-1) * r / ((r+1)^(n-1) - 1)
-- Nominal interest rate calculation. Raphson-Newton algorithm.
-- i1-1st installment amount
-- d1-number of days between financing and 1st installment date
rateCl1stI :: (RealFloat a, Integral b) => a -> a -> a -> a -> a -> a -> a -> b -> a
rateCl1stI i i1 c n d d1 r count | abs (f / ff) < 0.000000001 = r - f / ff
| count > 30 = -1 -- error case
| otherwise = rateCl1stI i i1 c n d d1 (r - f / ff) (count + 1)
where f = i*((r+1)**(n-1)- 1)/(r+1)**n / r + i1/(r+1) - c*(r+1)**(d + d1/30 - 1)
ff = i*((n-1)*(r+1)**(n-1)*r - ((r+1)**(n-1) - 1) * (n*r+r+1))
/ (r+1)**(n+1) / r^2
- i1/(r+1)^2
- c*(d + d1/30 - 1)
-- is-installment list
-- f-sum is(i)/(r+1)^i - c*...
-- ff-sum -i*is(i)/(r+1)^(i+1) - c*...
-- Important! 'r' is here first, as hoc extrapolation of nominal interest rate. Suggested value [0.001 - 0.01].
-- If value is out of this range, result may not be calculated in foreseen 30 steps
rateIrr1stI :: [Amount]
-> Amount
-> Int
-> ValidMonad Rate
rateIrr1stI is c d1 = rateIrr1stI' (map fromIntegral is) (fromIntegral c) (length is) 0 (fromIntegral d1) 0.1 0
rateIrr1stI' is c n d d1 r count | abs (f / ff) < 0.000000001 = return $ r - f / ff
| count > 30 = throwError $ OtherError $
"rateIrr1stI c:" ++
show c ++
" d1:" ++ show d1 ++
" is:" ++ show is
| otherwise = rateIrr1stI' is c n d d1 (r - f / ff) (count + 1)
where f = sum(map (uncurry (/)) (zip is [(1+r)^i|i <- [1..n]]))
- c*(r+1)**(d + d1 / 30 - 1)
ff = sum(map (uncurry (/)) (zip (map (uncurry (*)) (zip is [fromIntegral(-i)|i <- [1..n]])) [(1+r)^(i+1)|i <- [1..n]]))
- c*(d + d1/30 - 1)
-- | General rate calculation.
-- Delay of 1st installment is integrated into instalment list
rateIrr :: [Amount] -- ^ list of instalment amounts
-> Amount -- ^ initial principal
-> ValidMonad Rate
rateIrr is c = case rateIrr' (map fromIntegral is) (fromIntegral c) (length is) 0.01 0 of
Right x -> Right x
Left _ -> rateIrr' (map fromIntegral is) (fromIntegral c) (length is) eps 0
where eps = fromIntegral (sum is - c) / fromIntegral c / fromIntegral (length is) / 1000
rateIrr' is c n r count | epsilon < 1e-13 && result < 0 && eta > (-2) = return 0
| epsilon < 1e-13 && result < 0 = throwError $ OtherError $
"negative rate r=" ++ show result ++
" is:" ++ show is
| epsilon < 1e-13 = return result
| count > 30 = throwError $ OtherError $
"rateIrr c:" ++
show c ++
" is:" ++ show is
| otherwise = rateIrr' is c n (r - f / ff) (count + 1)
where f = sum(map (uncurry (/)) (zip is [(1+r)^i|i <- [1..n]])) - c
ff = sum $ map (uncurry (/))
(zip (map (uncurry (*))
(zip is [fromIntegral(-i)|i <- [1..n]]))
[(1+r)^(i+1)|i <- [1..n]])
epsilon = abs (f / ff)
result = r - f / ff
eta = result * c
rateCl :: Amount -- ^ instalment amount
-> Amount -- ^ principal
-> Duration -- ^ duraiton in freq units
-> Duration -- ^ 1st instalment postponement in freq units
-> ValidMonad Rate
rateCl i c n d = rateCl' (fromIntegral i) (fromIntegral c) (fromIntegral n) (fromIntegral d) 0.01 0
rateCl' i c n d r count | abs (f / ff) < 1e-13 = return $ r - f / ff
| count > 30 = throwError $ OtherError $
"rateCl c:" ++
show i ++
"c:" ++ show c ++
"n:" ++ show n ++
"d:" ++ show d
| otherwise = rateCl' i c n d (r - f / ff) (count + 1)
where f = i*((r+1)**n - 1) / (r+1)**n / r - c * (r+1)**d
ff = i*(n*(r+1)**n * r - ((r+1)**n - 1) * (n*r+r+1)) / (r+1)**(n+1) / r^2 - c * d
-- | Calculates duration of regural loan in the units of interest rate.
calcDurCl :: Double -- ^ Principal deAmounted
-> Double -- ^ Instalment amount deAmounted
-> Rate -- ^ Nominal interest rate
-> Duration -- ^ Instalment duration
-> (Double -> Amount) -- ^ Rounding function (truncate or round) - taken from parameters
-> Amount
calcDurCl _ 0 _ _ _ = 0
calcDurCl c i 0 _ roundingFun = roundingFun $ c / i
calcDurCl c i r d roundingFun = roundingFun $ log (i / (i + c * p^d * (1-p))) / log p
where p = 1+r
-- | Same calcualtions as for @rawCalcCapCl@ above but rounded to @Amount@.
calcCapCl :: Double -- ^ Deintegraled instalment amount.
-> Duration -- ^ Duration
-> Rate -- ^ Nominal interest rate
-> Duration -- ^ First instalment deferrment
-> Amount
calcCapCl i n r = round . rawCalcCapCl i n r
calcCapBal b i n r = round . rawCalcCapBal b i n r
calcCapBalPlus b i n r = round . rawCalcCapBalPlus b i n r
-- | Calculates principal before last installment
calcCapBeforeBal :: Amount -- ^ Balloon amount
-> Rate -- ^ Nominal interest rate
-> Amount
calcCapBeforeBal b r = round $ fromIntegral b / (1+r)
-- | calculates principal after Nth installment
calcCapAfterN :: Amount -- ^ Principal
-> Amount -- ^ Instalment amount
-> Duration -- ^ Loan duration
-> Duration -- ^ First instalment deferrment
-> Rate -- ^ Nominal interest rate
-> Amount
calcCapAfterN c i n _ 0 = c - i * fromIntegral n
calcCapAfterN c i n d r = truncate $ fromIntegral c * (1+r)^(n+d) - fromIntegral i * (rXn - 1) / r
where rXn = (1+r)^n