haslo-0.1: Haslo/InstalmentPlanProps.hs
---------------------------------------------------------
--
-- Module : InstalmentPlanProps
-- Copyright : Bartosz Wójcik (2010)
-- License : BSD3
--
-- Maintainer : bartek@sudety.it
-- Stability : Unstable
-- Portability : portable
--
-- | This module implements properities of 'InstalmentPlan'.
---------------------------------------------------------
module Haslo.InstalmentPlanProps ( instalmentPlanCheck
,instalmentPlanLineCheck
,instalmentPlanCheckM
,instalmentPlanLineCheckM
,initIPL
,rateCheckTruncated
,rateCheckTruncatedM
,rateCheckRounded
,rateCheckRoundedM
)
where
import Haslo.BasicType
import Haslo.CalcCalendar
import Haslo.CalcConstructors
import Haslo.ErrorHandling
import Haslo.Parameters
import Haslo.InstalmentPlan
--import CalcConfigurationType
-- | Condition each installment has to fulfil
instalmentCheck :: Instalment -> Bool
instalmentCheck i = iAmt i == iRepayment i + iIntPaid i
-- | Control function with diagnostic for humans.
instalmentCheckM :: Instalment -> ValidMonad ()
instalmentCheckM i | iAmt i == iRepayment i + iIntPaid i = return ()
| otherwise = throwError $ InstalmentDiscrepancy
(iAmt i)
(iRepayment i)
(iIntPaid i)
-- | For control purposes artificial initial 'InstalmentPlanLine' has to be constructed
initIPL :: Amount -> Interest -> InstalmentPlanLine
initIPL cap iL = (IPL (I 0 0 0 0) cap iL 0)
-- | Condition, each InstalmentPlanLine fulfills before financing.
instalmentPlanLineCheck :: Amount
-> Interest
-> InstalmentPlanLine
-> Bool
instalmentPlanLineCheck capBefore lateIntBefore ipl =
abs ((fromIntegral capBefore + lateIntBefore) * iplRate ipl - (iInterest . iplInst) ipl) < 1e-4 &&
abs (lateIntBefore - (fromIntegral . iIntPaid . iplInst) ipl
+ (iInterest . iplInst) ipl
- iplIntLate ipl) < 1e-2 &&
capBefore - (iRepayment . iplInst) ipl == iplPrincipal ipl &&
(instalmentCheck . iplInst) ipl
-- | Control function with diagnostic for humans.
instalmentPlanLineCheckM :: InstalmentPlanLine
-> InstalmentPlanLine
-> ValidMonad InstalmentPlanLine
instalmentPlanLineCheckM ipl1 ipl2 =
(instalmentCheckM . iplInst) ipl2 >> checkInterestM >> checkLateInterestM >> checkCapitalAfterM
where checkInterestM | abs (intReCalcul - intStored) < 1e-2 = return ipl2
| otherwise = throwError $ IPLInterest capBefore
lateIntBefore
intStored
(iplRate ipl2)
checkLateInterestM | checkLateInterest = return ipl2
| otherwise = throwError $ FollowUpInterestError errorLateInt
lateIntBefore
(iInterest $ iplInst ipl2)
(iIntPaid $ iplInst ipl2)
(iplIntLate ipl2)
checkCapitalAfterM | checkCapitalAfter = return ipl2
| otherwise = throwError $ FollowUpError errorPrincipal
capBefore
(iRepayment $ iplInst ipl2)
(iplPrincipal ipl2)
intReCalcul = ((fromIntegral capBefore + lateIntBefore) * iplRate ipl2)
intStored = (iInterest . iplInst) ipl2
checkLateInterest = abs (lateIntBefore - (fromIntegral . iIntPaid . iplInst) ipl2
+ (iInterest . iplInst) ipl2
- iplIntLate ipl2) < 1e-2
checkCapitalAfter = capBefore - (iRepayment . iplInst) ipl2 == iplPrincipal ipl2
capBefore = iplPrincipal ipl1
lateIntBefore = iplIntLate ipl1
errorLateInt = "IPL discrepancy: late interest before + interest calculated -\
\ interest paid /= late interest after"
errorPrincipal = "IPL discrepancy: principal before - principal matured /= principal after"
-- | Checks if all lines of installment plan fulfill their
-- validation rules.
instalmentPlanCheck :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> Bool
instalmentPlanCheck cap iL ip = (\(x,cf,iLf,i,r) -> x && -- All rows of instlment plan are OK
(cf == 0 || -- Amortizes properly to 0
cf < fromIntegral (length ip) && r == 0) &&
abs iLf < 1e-2) $ -- There is no late interest left
foldl check (True, cap, iL, I 0 0 0 0, 0) ip
where check :: (Bool,Amount,Interest,Instalment,Rate)
-> InstalmentPlanLine
-> (Bool,Amount,Interest,Instalment,Rate)
check (bool,cap,iL,_,_) ipl = (bool && instalmentPlanLineCheck cap iL ipl
,iplPrincipal ipl
,iplIntLate ipl
,iplInst ipl
,iplRate ipl)
-- | Control function with diagnostic for humans.
instalmentPlanCheckM :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> ValidMonad ()
instalmentPlanCheckM cap iL ip = foldM instalmentPlanLineCheckM (IPL (I 0 0 0 0) cap iL 0) ip
>>= lastCheck
where lastCheck (IPL i c iL r) | abs iL > 1e-2 = throwError $ NotPaidDefferedInterest iL ip
| r > 0 && c /= 0 = throwError $ NotAmortized c ip
| r == 0 && c > fromIntegral (length ip) = throwError $ NotAmortized c ip
| otherwise = return ()
-- | Checks whether instalment plan is complete, i.e. if there is no
-- remaining principal.
isInstalmentPlanComplete :: InstalmentPlan -> Bool
isInstalmentPlanComplete ip = (iplPrincipal. last) ip <= 0
-- All loans with fixed interest rate have to fulfil following:
-- If Truncated: interest rate is <= that given one.
-- Add 1 to each instalment amount, recalculate interest rate and check that
-- it's greater than given one.
-- If Rounded: if interest rate > given one: subtract 1 from each instalment amount, recalculate
-- interest rate and check that it's < given one.
-- if interest rate < given one: add 1 to each instalment amount, recalculate
-- interest rate and check that it's > given one.
-- | Checks recalculated interest rate against original one.
-- Works only for parameters where @Truncated@ is selected.
rateCheckTruncated :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> Rate -- ^ Initial interest rate in nominal format.
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> ValidMonad Bool
rateCheckTruncated p iL r ip = liftM (iplRate . head) (newLoanRILPlus p iL 1 ip) >>= \r'' ->
(return $ r' - r <= e1 && r'' > r)
where r' = iplRate $ head ip
e1 = 1e-9
-- | Checks recalculated interest rate against original one.
-- Works only for parameters where @Rounded@ is selected.
rateCheckRounded :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> Rate -- ^ Initial interest rate in nominal format.
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> ValidMonad Bool
rateCheckRounded p iL r ip | r == 0 = return True
| r' > r = liftM (iplRate . head) (newLoanRILPlus p iL (-1) ip) >>= \r'' ->
(return $ r'' < r)
| r' < r = liftM (iplRate . head) (newLoanRILPlus p iL 1 ip) >>= \r'' ->
(return $ r'' > r)
| otherwise = return True
where r' = iplRate $ head ip
-- | Like @rateCheckTruncated@ with diagnostics for humans
rateCheckTruncatedM :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> Rate -- ^ Initial interest rate in nominal format.
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> ValidMonad InstalmentPlan
rateCheckTruncatedM p iL r ip = liftM (iplRate . head) (newLoanRILPlus p iL 1 ip) >>= \r'' ->
case r' - r <= e1 && r'' > r of
True -> return ip
False -> throwError $ OtherError $ "Interest rate not fits." ++
" Original: " ++ show r ++
" Recalculated: " ++ show r' ++
" Of next higher loan: " ++ show r''
where r' = iplRate $ head ip
-- | Like @rateCheckRounded@ with diagnostics for humans
rateCheckRoundedM :: Amount -- ^ Initial principal
-> Interest -- ^ Initial late interest (usually 0)
-> Rate -- ^ Initial interest rate in nominal format.
-> InstalmentPlan -- ^ Instalment Plan to be checked
-> ValidMonad InstalmentPlan
rateCheckRoundedM p iL r ip | r == 0 = return ip
| r' > r = liftM (iplRate . head) (newLoanRILPlus p iL (-1) ip) >>= \r'' ->
case r'' < r of
True -> return ip
False -> throwError $ OtherError $ "Interest rate not fits." ++
" Original: " ++ show r ++
" Recalculated: " ++ show r' ++
" Of next higher loan: " ++ show r''
| r' < r = liftM (iplRate . head) (newLoanRILPlus p iL 1 ip) >>= \r'' ->
case r'' > r of
True -> return ip
False -> throwError $ OtherError $ "Interest rate not fits." ++
" Original: " ++ show r ++
" Recalculated: " ++ show r' ++
" Of next higher loan: " ++ show r''
| otherwise = return ip
where r' = iplRate $ head ip
-- | Adds given amount to each istalment and recalculates the InstalmentPlan.
newLoanRILPlus :: Amount
-> Interest
-> Amount
-> InstalmentPlan
-> ValidMonad InstalmentPlan
newLoanRILPlus p iL delta = newLoanRIL iL p . map (+| delta) . instList
where a +| b | a + b < 0 = 0
| otherwise = a + b