{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} module Asset ( Asset(..), buildAssumptionPpyDefRecRate,buildAssumptionPpyDelinqDefRecRate ,calcRecoveriesFromDefault,getCurBalance ,priceAsset,applyHaircut,buildPrepayRates,buildDefaultRates,getObligorFields ,getObligorTags,getObligorId,getRecoveryLagAndRate,getDefaultDelinqAssump,getOriginInfo ) where import qualified Data.Time as T import qualified Data.Text as Text import Text.Read (readMaybe) import Lib (Period(..) ,Ts(..),periodRateFromAnnualRate,toDate ,getIntervalDays,zipWith9,mkTs,periodsBetween ,mkRateTs,daysBetween, getIntervalFactors) import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals) import qualified Assumptions as A import qualified AssetClass.AssetBase as ACM import AssetClass.AssetCashflow import qualified Data.Map as Map import Analytics import Data.List import Data.Maybe import Data.Ratio import Data.Aeson hiding (json) import Language.Haskell.TH import GHC.Generics import Data.Aeson.TH import Data.Aeson.Types import Types hiding (Current) import Text.Printf import Data.Fixed import qualified InterestRate as IR import qualified Data.Set as Set import Util import AssetClass.AssetBase ( OriginalInfo(..), calcPmt, AssetUnion, Obligor(..) ) import Debug.Trace import Assumptions (ExtraStress(ExtraStress)) import Control.Lens hiding (element) import Control.Lens.TH import Data.Generics.Product.Fields import Data.Generics.Product.Any import DateUtil (yearCountFraction) debug = flip trace class (Show a,IR.UseRate a) => Asset a where -- | project contractual cashflow of an asset with interest assumptions calcCashflow :: a -> Date -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame -- | Get current balance of an asset getCurrentBal :: a -> Balance -- | Get original balance of an asset getOriginBal :: a -> Balance -- | Get original rate of an asset getOriginRate :: a -> IRate -- | Get current rate of an asset getCurrentRate :: a -> IRate -- | Get origination date of an asset getOriginDate :: a -> Date -- | Get origin info of an asset getOriginInfo :: a -> OriginalInfo -- | if the asset is defaulted isDefaulted :: a -> Bool -- | project projected dates of an asset getPaymentDates :: a -> Int -> [Date] -- | get number of remaining payments getRemainTerms :: a -> Int -- | get remain payment dates getRemainDates :: a -> [Date] getRemainDates a = lastN (getRemainTerms a) (getPaymentDates a 0) -- | project asset cashflow under credit stress and interest assumptions getTotalTerms :: a -> Int getTotalTerms a = ACM.originTerm (getOriginInfo a) getPastTerms :: a -> Int getPastTerms a = getTotalTerms a - getRemainTerms a projCashflow :: a -> Date -> A.AssetPerf -> Maybe [RateAssumption] -> Either String (CF.CashFlowFrame, Map.Map CutoffFields Balance) -- | Get possible number of borrower getBorrowerNum :: a -> Int -- | Split asset per rates passed in splitWith :: a -> [Rate] -> [a] -- | ! Change the origination date of an asset updateOriginDate :: a -> Date -> a -- | ! Change the current asset state to the date of origination resetToOrig :: a -> a -- | Get Last Interest Payment date getLastInterestPaymentDate :: a -> Maybe Date -- | Calculate Accrued Interest calcAccruedInterest :: a -> Date -> Balance -- | ! Internal use calcAlignDate :: a -> Date -> Date calcAlignDate ast d = let payDates = Asset.getOriginDate ast:getPaymentDates ast 0 remainTerms = getRemainTerms ast benchDate = reverse payDates!! remainTerms offset = daysBetween benchDate d in T.addDays offset $ Asset.getOriginDate ast getObligor :: a -> Maybe Obligor getObligor a = case getOriginInfo a of FixedAssetInfo {} -> Nothing MortgageOriginalInfo{obligor = x } -> x LoanOriginalInfo{obligor = x } -> x LeaseInfo{obligor = x } -> x ReceivableInfo{obligor = x } -> x getObligorTags :: a -> Set.Set String getObligorTags a = case getOriginInfo a of MortgageOriginalInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) LoanOriginalInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) LeaseInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) ReceivableInfo{obligor = Just obr } -> Set.fromList (obligorTag obr) _ -> mempty getObligorId :: a -> Maybe String getObligorId a = case getOriginInfo a of MortgageOriginalInfo{obligor = Just obr } -> Just (obligorId obr) LoanOriginalInfo{obligor = Just obr } -> Just (obligorId obr) LeaseInfo{obligor = Just obr } -> Just (obligorId obr) ReceivableInfo{obligor = Just obr } -> Just (obligorId obr) _ -> Nothing getObligorFields :: a -> Maybe (Map.Map String (Either String Double)) getObligorFields a = let obInfo = getObligor a in case obInfo of Nothing -> Nothing Just ob -> Just (obligorFields ob) {-# MINIMAL calcCashflow,getCurrentBal,getOriginBal,getOriginRate #-} -- | apply ExtraStress on prepayment/default rates applyExtraStress :: Maybe A.ExtraStress -> [Date] -> [Rate] -> [Rate] -> ([Rate],[Rate]) applyExtraStress Nothing _ ppy def = (ppy,def) applyExtraStress (Just ExtraStress{A.defaultFactors= mDefFactor ,A.prepaymentFactors = mPrepayFactor}) ds ppy def = case (mPrepayFactor,mDefFactor) of (Nothing,Nothing) -> (ppy,def) (Nothing,Just defFactor) -> (ppy ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor) (Just ppyFactor,Nothing) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor, def) (Just ppyFactor,Just defFactor) -> (getTsVals $ multiplyTs Exc (zipTs ds ppy) ppyFactor ,getTsVals $ multiplyTs Exc (zipTs ds def) defFactor) cpr2smm :: Rate -> Rate cpr2smm r = toRational $ 1 - (1 - fromRational r :: Double) ** (1/12) normalPerfVector :: [Rate] -> [Rate] normalPerfVector = floorWith 0.0 . capWith 1.0 buildPrepayRates :: Asset b => b -> [Date] -> Maybe A.AssetPrepayAssumption -> Either String [Rate] buildPrepayRates _ ds Nothing = Right $ replicate (pred (length ds)) 0.0 buildPrepayRates a ds mPa = normalPerfVector <$> case mPa of Just (A.PrepaymentConstant r) -> Right $ replicate size r Just (A.PrepaymentCPR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds Just (A.PrepaymentVec vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault 0.0 vs (pred size)) (getIntervalDays ds) Just (A.PrepaymentVecPadding vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault (last vs) vs (pred size)) (getIntervalDays ds) Just (A.PrepayStressByTs ts x) -> do rs <- buildPrepayRates a ds (Just x) return $ getTsVals $ multiplyTs Exc (zipTs (tail ds) rs) ts Just (A.PrepaymentPSA r) -> let agedTerm = getPastTerms a remainingTerm = getRemainTerms a ppyVectorInCPR = (* r) <$> [0.002,0.004..0.06] ++ repeat 0.06 vectorUsed = take remainingTerm $ drop agedTerm ppyVectorInCPR in case period (getOriginInfo a) of Monthly -> Right $ cpr2smm <$> vectorUsed _ -> Left $ "PSA is only supported for monthly payment but got "++ show (period (getOriginInfo a)) Just (A.PrepaymentByTerm rs) -> let agedTerm = getPastTerms a oTerm = originTerm (getOriginInfo a) in case find (\x -> oTerm == length x) rs of Just v -> Right $ drop agedTerm v Nothing -> Left "Prepayment by term doesn't match the origin term" _ -> Left ("failed to find prepayment type"++ show mPa) where size = length ds buildDefaultRates :: Asset b => b -> [Date] -> Maybe A.AssetDefaultAssumption -> Either String [Rate] buildDefaultRates _ ds Nothing = Right $ replicate (pred (length ds)) 0.0 buildDefaultRates a [] mDa = Left "buildDefaultRates: empty date list" buildDefaultRates a ds mDa = normalPerfVector <$> case mDa of Just (A.DefaultConstant r) -> Right $ replicate size r Just (A.DefaultCDR r) -> Right $ Util.toPeriodRateByInterval r <$> getIntervalDays ds Just (A.DefaultVec vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault 0.0 vs (pred size)) (getIntervalDays ds) Just (A.DefaultVecPadding vs) -> Right $ zipWith Util.toPeriodRateByInterval (paddingDefault (last vs) vs (pred size)) (getIntervalDays ds) Just (A.DefaultAtEndByRate r rAtEnd) -> Right $ case size of 0 -> [] 1 -> [] _ -> (Util.toPeriodRateByInterval r <$> getIntervalDays (init ds)) ++ (Util.toPeriodRateByInterval rAtEnd <$> getIntervalDays [head ds,last ds]) Just (A.DefaultStressByTs ts x) -> do rs <- buildDefaultRates a ds (Just x) let r = getTsVals $ multiplyTs Inc (zipTs (tail ds) rs) ts return r Just (A.DefaultByTerm rs) -> let agedTerm = getPastTerms a oTerm = originTerm (getOriginInfo a) in case find (\x -> oTerm == length x) rs of Just v -> Right $ drop agedTerm v Nothing -> Left "Default by term doesn't match the origin term" _ -> Left ("failed to find default rate type"++ show mDa) where size = length ds getRecoveryLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) getRecoveryLagAndRate Nothing = (0,0) getRecoveryLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) -- | build pool assumption rate (prepayment, defaults, recovery rate , recovery lag) buildAssumptionPpyDefRecRate :: Asset a => a -> [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],Rate,Int) buildAssumptionPpyDefRecRate a ds (A.LoanAssump mDa mPa mRa mESa) = buildAssumptionPpyDefRecRate a ds (A.MortgageAssump mDa mPa mRa mESa) buildAssumptionPpyDefRecRate a ds (A.MortgageAssump mDa mPa mRa mESa) = let size = length ds zeros = replicate size 0.0 (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa in do prepayRates <- buildPrepayRates a ds mPa defaultRates <- buildDefaultRates a ds mDa let (prepayRates2,defaultRates2) = applyExtraStress mESa ds prepayRates defaultRates return (prepayRates2,defaultRates2,recoveryRate,recoveryLag) getDefaultDelinqAssump :: Maybe A.AssetDelinquencyAssumption -> [Date] -> ([Rate],Int,Rate) getDefaultDelinqAssump Nothing ds = (replicate (length ds) 0.0, 0, 0.0) getDefaultDelinqAssump (Just (A.DelinqCDR r (lag,pct))) ds = (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) ,lag ,pct) getDefaultLagAndRate :: Maybe A.RecoveryAssumption -> (Rate,Int) getDefaultLagAndRate Nothing = (0,0) getDefaultLagAndRate (Just (A.Recovery (r,lag))) = (r,lag) -- | build prepayment rates/ delinq rates and (%,lag) convert to default, recovery rate, recovery lag buildAssumptionPpyDelinqDefRecRate :: Asset a => a -> [Date] -> A.AssetPerfAssumption -> Either String ([Rate],[Rate],(Rate,Lag),Rate,Int) buildAssumptionPpyDelinqDefRecRate _ ds (A.MortgageDeqAssump mDeqDefault mPa mRa (Just _)) = Left "Delinq assumption doesn't support extra stress" buildAssumptionPpyDelinqDefRecRate a ds (A.MortgageDeqAssump mDeqDefault mPa mRa Nothing) = let (recoveryRate,recoveryLag) = getRecoveryLagAndRate mRa zeros = replicate (length ds) 0.0 (delinqRates,defaultLag,defaultPct) = case mDeqDefault of Nothing -> (zeros,0,0.0) Just (A.DelinqCDR r (lag,pct)) -> (map (Util.toPeriodRateByInterval r) (getIntervalDays ds) ,lag ,pct) in do prepayRates <- buildPrepayRates a ds mPa return (prepayRates,delinqRates,(defaultPct,defaultLag),recoveryRate, recoveryLag) calcRecoveriesFromDefault :: Balance -> Rate -> [Rate] -> [Amount] calcRecoveriesFromDefault bal recoveryRate recoveryTiming = mulBR recoveryAmt <$> recoveryTiming where recoveryAmt = mulBR bal recoveryRate priceAsset :: Asset a => a -> Date -> PricingMethod -> A.AssetPerf -> Maybe [RateAssumption] -> CutoffType -> Either String PriceResult priceAsset m d (PVCurve curve) assumps mRates cType = let cr = getCurrentRate m pDays = Asset.getOriginDate m:(getPaymentDates m 0) cb = getCurrentBal m in case projCashflow m d assumps mRates of Right (CF.CashFlowFrame _ txns,_) -> let ds = getDate <$> txns accruedInt = case ds of [] -> 0 (fstTxnDate:_) -> let accStartDate = last $ takeWhile (< fstTxnDate) pDays in mulBR (mulBIR cb cr) (yearCountFraction DC_ACT_365F accStartDate d) amts = CF.tsTotalCash <$> (case cType of Exc -> CF.clawbackInt accruedInt txns Inc -> txns) pv = pv3 curve d ds amts -- `debug` ("pricing"++ show d++ show ds++ show amts) wal = calcWAL ByYear cb d (zip amts ds) duration = fromRational $ calcDuration DC_ACT_365F d (zip ds amts) curve convexity = fromRational $ calcConvexity DC_ACT_365F d (zip ds amts) curve in Right $ AssetPrice pv wal duration convexity accruedInt Left x -> Left x priceAsset m d (BalanceFactor currentFactor defaultedFactor) assumps mRates cType = let cb = getCurrentBal m val = if isDefaulted m then mulBR cb defaultedFactor -- `debug` ("Defulat CB"++ show cb) else mulBR cb currentFactor -- `debug` ("CB"++ show cb) in case projCashflow m d assumps mRates of Right (CF.CashFlowFrame _ txns,_) -> let ds = getDate <$> txns amts = CF.tsTotalCash <$> txns wal = calcWAL ByYear cb d (zip amts ds) -- `debug` ("pricing"++ show d++ show ds++ show amts) in Right $ AssetPrice val wal (-1) (-1) (-1) Left x -> Left x priceAsset m d (PvRate r) assumps mRates cType = let cb = getCurrentBal m pDays = Asset.getOriginDate m:getPaymentDates m 0 cr = getCurrentRate m in case projCashflow m d assumps mRates of Right (CF.CashFlowFrame _ txns,_) -> let ds = getDate <$> txns accruedInt = case ds of [] -> 0 (fstTxnDate:_) -> let accStartDate = last $ takeWhile (< fstTxnDate) pDays in mulBR (mulBIR cb cr) (yearCountFraction DC_ACT_365F accStartDate d) amts = CF.tsTotalCash <$> (case cType of Exc -> CF.clawbackInt accruedInt txns Inc -> txns) wal = calcWAL ByYear cb d (zip amts ds) pv = sum $ zipWith (pv2 r d) ds amts curve = mkTs $ zip ds (repeat (toRational r)) duration = fromRational $ calcDuration DC_ACT_365F d (zip ds amts) curve convexity = fromRational $ calcConvexity DC_ACT_365F d (zip ds amts) curve in Right $ AssetPrice pv wal duration convexity accruedInt Left x -> Left x