haslo-0.1.2: Haslo/HasloQCTestL.hs
---------------------------------------------------------
--
-- Module : HasloQCTestL
-- Copyright : Bartosz Wójcik (2011)
-- License : BSD3
--
-- Maintainer : bartek@sudety.it
-- Stability : Unstable
-- Portability : portable
--
-- Part of haslo. Data types used for Quick Check.
-- Properties set up.
---------------------------------------------------------
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Haslo.HasloQCTestL
where
import Haslo
import Data.List
import Data.Time
import Test.QuickCheck
import Text.PrettyShow
caps = choose (1000::Amount,100000000)
caps' b = choose (b::Amount,100000000)
class Show a => ShowShort a where
showShort :: a -> String
data GUIClassic = CL1 Classical
| CL2 Balloon
| CL3 BalloonPlus
| CL4 ReversBalloon
| CL5 Bullet
| CL6 UnfdBalloon
| CL7 UnfdBalloonPlus
deriving (Eq, Ord)
instance Show GUIClassic where
show (CL1 l) = show l
show (CL2 l) = show l
show (CL3 l) = show l
show (CL4 l) = show l
show (CL5 l) = show l
show (CL6 l) = show l
show (CL7 l) = show l
instance PrettyShow GUIClassic where
showWithLen n = showWithLen n . show
instance ShowShort GUIClassic where
showShort = filter (/= '(') . head . drop 1 . words . show
instance Enum GUIClassic where
toEnum 0 = CL1 $ Classical 0 0 0 0
toEnum 1 = CL2 $ Balloon 0 0 0 0 0
toEnum 2 = CL3 $ BalloonPlus 0 0 0 0 0
toEnum 3 = CL4 $ ReversBalloon 0 0 0 0 0
toEnum 4 = CL5 $ Bullet 0 0 0 0
toEnum 5 = CL6 $ UnfdBalloon 0 0 0 0 0 0
toEnum 6 = CL7 $ UnfdBalloonPlus 0 0 0 0 0 0
-- toEnum x = toEnum $ x `mod` 7
fromEnum (CL1 _) = 0
fromEnum (CL2 _) = 1
fromEnum (CL3 _) = 2
fromEnum (CL4 _) = 3
fromEnum (CL5 _) = 4
fromEnum (CL6 _) = 5
fromEnum (CL7 _) = 6
instance ClassicLoan GUIClassic where
newLoanI (CL1 x) = newLoanI x
newLoanI (CL2 x) = newLoanI x
newLoanI (CL3 x) = newLoanI x
newLoanI (CL4 x) = newLoanI x
newLoanI (CL5 x) = newLoanI x
newLoanI (CL6 x) = newLoanI x
newLoanI (CL7 x) = newLoanI x
extract (CL1 x) = extract x
extract (CL2 x) = extract x
extract (CL3 x) = extract x
extract (CL4 x) = extract x
extract (CL5 x) = extract x
extract (CL6 x) = extract x
extract (CL7 x) = extract x
instance Balloons GUIClassic where
balloon (CL2 x) = balloon x
balloon (CL3 x) = balloon x
balloon (CL5 x) = balloon x
balloon (CL6 x) = balloon x
balloon (CL7 x) = balloon x
balloon l = error $ show l ++ " is not a balloon"
instance UnfdBalloons GUIClassic where
eXtendedDuration (CL6 x) = eXtendedDuration x
eXtendedDuration (CL7 x) = eXtendedDuration x
eXtendedDuration l = error $ show l ++ " is not a UnfdBalloon"
{-
data GUIFee = Fee1 FeeFinanced
| Fee2 FeeAsLateInterest
| Fee3 FeeLimitingFstInstalment
deriving (Eq, Ord, Show)
instance Enum GUIFee where
toEnum 0 = Fee1 FeeFinanced
toEnum 1 = Fee2 FeeAsLateInterest
toEnum 2 = Fee3 FeeLimitingFstInstalment
fromEnum (Fee1 _) = 0
fromEnum (Fee2 _) = 1
fromEnum (Fee3 _) = 2
instance FeeClass GUIFee where
addFee (Fee1 _) = addFee FeeFinanced
addFee (Fee2 _) = addFee FeeAsLateInterest
addFee (Fee3 _) = addFee FeeLimitingFstInstalment
instance ShowShort GUIFee where
showShort = head . drop 1 . words . show
feeList = take 3 $ map showShort [Fee1 FeeFinanced ..]
-}
-- | Poperties of instalment loan for given input parameters.
instance Arbitrary GUIClassic where
arbitrary = do
p <- frequency [--(15,return paramDT),
(70,return paramMT),
(30,return paramYT)]
-- Duration limited to 30 years
n <- choose (3::Duration, 30 * (freqPerYear $ freq p))
-- Deferment limited to 12 instalments
d <- choose (0::Duration,12)
-- Interest rate limited to 20%. Selected like for humans: max 4 digits after decimal point.
r <- frequency [(1,return 0)
,(99,liftM ((/10^6) . fromIntegral) $ choose (0::Int,2*10^5))
]
-- Balloon amount and capital limited to 10^8 (in this makes 10^6)
b <- caps
c <- caps
cBal <- caps' b
-- Instalment for reversal balloon limited to 10^6 (in this makes 10^4)
i <- choose (0::Amount,100000)
-- Capital of reversal balloon selected so, that balloon amount will be positive
cRevBal <- choose (calcCapCl (fromIntegral i) n (cE2N (freq p) r) d
,i * fromIntegral n * 2 + 1000000)
-- Max duration of extended period of UnfdBalloons limited so that total duration doesn't extend 30 years
x <- choose (1::Duration, 30 * (freqPerYear $ freq p) - n + 1)
oneof [return $ CL1 $ Classical c n d r
,return $ CL2 $ Balloon cBal n d r b
,return $ CL3 $ BalloonPlus cBal n d r b
,return $ CL4 $ ReversBalloon cRevBal n d r i
,return $ CL5 $ Bullet c n 0 r
,return $ CL6 $ UnfdBalloon cBal n d r b x
,return $ CL7 $ UnfdBalloonPlus cBal n d r b x
]
data TestL = TestL (GUIClassic,InstalmentPlanParam)
instance Show TestL where
show (TestL (loan, IPP fr rd)) = show loan ++ " " ++ showWithLen 8 fr ++ showWithLen 9 rd
instance Arbitrary TestL where
arbitrary = do
l <- arbitrary
p <- if duration (extract l) <= 30
then frequency [--(15,return paramDT),
(10,return paramMR),
(40,return paramYR),
(10,return paramMT),
(40,return paramYT)]
else oneof [return paramMT
,return paramMR
]
return $ TestL (l, p)
instance Testable (ValidMonad Bool) where
property (Right b) = property b
property (Left err) = property False
instance Testable (ValidMonad ()) where
property (Right _) = property True
property (Left err) = error $ show err
testLoan :: TestL -> ValidMonad InstalmentPlan
testLoan (TestL (loan, ipp)) = runWithIPP ipp $ newLoanI loan
propInstPlan :: TestL -> ValidMonad Bool
propInstPlan p@(TestL (loan, ipp)) = testLoan p >>= \ip ->
return (instalmentPlanCheck (principal $ extract loan) (fstInst p) ip)
--propInstPlan :: TestL -> ValidMonad Bool
--propInstPlan p@(TestL (_,_,amt,_,_,_)) = testLoan p >>= \ip ->
-- return (instalmentPlanCheck amt (fstInst p) ip)
--propInstPlanM :: TestL -> ValidMonad ()
--propInstPlanM p@(TestL (_,_,amt,_,_,_)) = testLoan p >>=
-- instalmentPlanCheckM amt (fstInst p)
fstInst :: TestL -> Double
fstInst (TestL (CL5 (Bullet amt dur def rat), ipp)) =
fromIntegral $ myRound (rounding ipp) $ rawCalcMaxFstInst (fromIntegral amt) dur (cE2N (freq ipp) rat) def
fstInst _ = 0
instance Arbitrary Freq where
arbitrary = oneof [return Daily, return Monthly, return Yearly]
-- | Properity of interest rate conversion.
-- Interest rate has to be positive.
-- Daily interest rate not greater than 100%.
prop_cEN :: (Freq,Double) -> Property
prop_cEN (f,x) = x >= 0 && (x <= 1 || f /= Daily) ==> abs (cE2N f (cN2E f x) - x) <= x * 1e-12
-- | Interest rate property doesn't work for Bullet and UnfdBalloon loans
propRate :: TestL -> ValidMonad Bool
propRate p@(TestL (loan, ipp@(IPP _ Truncated))) | fromEnum loan `elem` [0,1,2,3] =
testLoan p >>= rateCheckTruncated (principal $ extract loan) (fstInst p) r
| otherwise = return True
where r = cE2N (freq ipp) (rate $ extract loan)
propRate p@(TestL (loan, ipp@(IPP _ Rounded))) | fromEnum loan `elem` [0,1,2,3] =
testLoan p >>= rateCheckRounded (principal $ extract loan) (fstInst p) r
| otherwise = return True
where r = cE2N (freq ipp) (rate $ extract loan)