Hastructure-0.45.0: src/AssetClass/Mortgage.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
module AssetClass.Mortgage
(projectMortgageFlow,projectScheduleFlow,updateOriginDate,getOriginInfo
,buildARMrates)
where
import qualified Data.Time as T
import qualified Cashflow as CF
import qualified Assumptions as A
import Asset as Ast
import Types
import Lib
import Util
import DateUtil
import InterestRate as IR
import qualified Data.Map as Map
import Data.List
import Data.Ratio
import Data.Maybe
import GHC.Generics
import Data.Aeson hiding (json)
import Language.Haskell.TH
import Data.Aeson.TH
import Data.Aeson.Types
import AssetClass.AssetBase
import AssetClass.AssetCashflow
import Debug.Trace
import Assumptions (AssetPerfAssumption(MortgageAssump))
import GHC.Float.RealFracMethods (truncateFloatInteger)
import Cashflow (extendTxns)
import Control.Lens hiding (element)
import Control.Lens.TH
import qualified Data.DList as DL
debug = flip trace
projectMortgageFlow :: (Balance, Balance, Date, Maybe BorrowerNum, AmortPlan, DayCount, IRate, Period, Int) -> (Dates, [DefaultRate],[PrepaymentRate],[IRate],[Int]) -> (DL.DList CF.TsRow, Balance, Balance)
projectMortgageFlow (originBal, startBal, lastPayDate, mbn, pt, dc, startRate, p, oTerms) (cfDates, defRates, ppyRates, rateVector, remainTerms) =
let
initRow = CF.MortgageFlow lastPayDate startBal 0.0 0.0 0.0 0.0 0.0 0.0 startRate Nothing Nothing Nothing
in
foldl
(\(acc, begBal, lastOriginBal) (pDate, defRate, ppyRate, intRate, rt)
-> let
-- begBal = view CF.tsRowBalance (last acc)
-- lastPaidDate = getDate (last acc) -- `debug` ("beg bal"++ show begBal)
newDefault = mulBR begBal defRate -- `debug` ("new default"++ show defRate++ ">>"++ show begBal)
newPrepay = mulBR (begBal - newDefault) ppyRate
-- performing balance
_balAfterPpy = begBal - newDefault - newPrepay -- `debug` ("new ppy "++ show newPrepay ++ "beg bal"++ show (begBal - newDefault) ++ "ppy rate"++ show ppyRate)
-- performing original balance
amortBal = mulBR lastOriginBal $ (1-defRate) * (1-ppyRate)
amortTerm = case pt of
Balloon aTerm -> aTerm
_ -> oTerms
(newInt,newPrin) = calcAssetPrinInt pt _balAfterPpy (periodRateFromAnnualRate p intRate) oTerms rt (amortBal, amortTerm) -- `debug` ("using bal for pmt"++ show _balAfterPpy)
endBal = _balAfterPpy - newPrin
newMbn = decreaseBorrowerNum begBal endBal mbn -- `debug` ("rt in mortgage proj"++ show rt)
in
(DL.snoc acc (CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 intRate newMbn Nothing Nothing), endBal ,amortBal)
)
(DL.singleton initRow, startBal, originBal)
(zip5 cfDates defRates ppyRates rateVector remainTerms)
projectDelinqMortgageFlow :: ([CF.TsRow],[CF.TsRow]) -> Balance -> Maybe Int -> Date -> [Date] -> [Rate] -> [PrepaymentRate] -> [IRate] -> (Rate,Lag,Rate,Lag,Period,AmortPlan,Int) -> ([Balance],[Balance],[Balance]) -> [CF.TsRow]
projectDelinqMortgageFlow (trs,[]) _ _ _ [] _ _ _ _ _ = CF.dropTailEmptyTxns trs
projectDelinqMortgageFlow (trs,backToPerfs) _ _ _ [] _ _ _ _ _ =
let
consolTxn = sort backToPerfs -- `debug` ("Hit pay dates = []")
(trsKeep,trsMerge) = splitByDate trs (getDate (head backToPerfs)) EqToRight
mergedTrs = CF.combineTss [] trsMerge consolTxn -- `debug` ("before Merge for delinq Mortgage \n >>> "++ show trs++"Back to Perf"++ show backToPerfs)
in
trsKeep ++ mergedTrs -- `debug` ("\n MergedTrs \n"++ show mergedTrs)
projectDelinqMortgageFlow (trs,backToPerfs) beginBal mbn lastDate (pDate:pDates) (delinqRate:delinqRates) (ppyRate:ppyRates) (rate:rates)
(defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinType,ot)
(dBal:defaultVec,rAmt:recoveryVec,lAmt:lossVec)
= projectDelinqMortgageFlow (trs++[tr],CF.combineTss [] backToPerfs newPerfCfs) endingBal newMbn pDate pDates delinqRates ppyRates rates
(defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinType,ot)
(newDefaultVec,newRecoveryVec,newLossVec) -- `debug` ("\n calc Date"++ show pDate ++"\n from new perf"++ show backToPerfBal ++"\n new cfs >>> \n"++ show newPerfCfs)
where
remainTerms = succ $ max 0 (length pDates - recoveryLag - defaultLag)
delinqBal = mulBR beginBal delinqRate
defaultBal = mulBR delinqBal defaultPct
recBal = mulBR defaultBal recoveryRate
lossBal = mulBR defaultBal (1 - recoveryRate)
newDefaultVec = replace defaultVec (pred defaultLag) defaultBal
newRecoveryVec = replace recoveryVec (pred recoveryLag + defaultLag) recBal
newLossVec = replace lossVec (pred recoveryLag + defaultLag) lossBal
backToPerfBal = mulBR delinqBal (1 - defaultPct)
restPerfVector = replicate (succ (length delinqRates)) 0
restPerfBal = fromRational <$> restPerfVector -- `debug` ("Dates"++show (pDate:pDates))
newPerfCfs = if backToPerfBal > 0.0 then
projectDelinqMortgageFlow ([],[]) backToPerfBal Nothing (pDates!!defaultLag) (drop defaultLag (pDate:pDates))
restPerfVector restPerfVector
(drop defaultLag (rate:rates))
(0,0,0,0,p,prinType,ot)
(restPerfBal,restPerfBal,restPerfBal) -- `debug` ("\nStarting new perf >>> \n"++ show backToPerfBal)
else
[]
balAfterDelinq = beginBal - delinqBal
ppyAmt = mulBR balAfterDelinq ppyRate
balAfterPpy = balAfterDelinq - ppyAmt
periodRate = periodRateFromAnnualRate p rate
amortTerm = case prinType of
Balloon aTerm -> aTerm
_ -> ot
-- scheduleBalance = calcScheduleBalaceToday m
(intAmt, prinAmt) = calcAssetPrinInt prinType balAfterPpy periodRate ot remainTerms (0,amortTerm)
endingBal = beginBal - prinAmt - ppyAmt - delinqBal -- `debug` ("DATE"++show pDate++">>>"++ show beginBal++">>"++show prinAmt ++ ">>" ++ show ppyAmt ++ ">>"++ show delinqBal)
downFactor = divideBB beginBal endingBal
newMbn = decreaseBorrowerNum beginBal endingBal mbn
tr = CF.MortgageDelinqFlow pDate endingBal prinAmt intAmt ppyAmt delinqBal dBal rAmt lAmt rate newMbn Nothing Nothing-- `debug` ("Date"++ show pDate ++ "ENDING BAL AT"++ show endingBal)
projectScheduleFlow :: [CF.TsRow] -> Rate -> Balance -> [CF.TsRow] -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> (Int, Rate) -> [CF.TsRow]
projectScheduleFlow trs _ last_bal [] _ _ [] [] (_,_) = trs
projectScheduleFlow trs bal_factor last_bal (flow:flows) (defRate:defRates) (ppyRate:ppyRates) recV lossV (recoveryLag,recoveryRate)
= projectScheduleFlow (trs++[tr]) surviveRate endBal flows defRates ppyRates (tail recVector) (tail lossVector) (recoveryLag,recoveryRate) -- `debug` ("===>C")
where
startBal = last_bal
defAmt = mulBR startBal defRate
ppyAmt = mulBR (startBal - defAmt) ppyRate
afterBal = startBal - defAmt - ppyAmt
surviveRate = (1 - defRate) * (1 - ppyRate) * bal_factor
schedulePrin = mulBR (CF.mflowPrincipal flow) surviveRate --TODO round trip -- `debug` ("Schedule Principal"++(printf "%.2f" (CF.mflowPrincipal flow))++" Rate"++show(_schedule_rate))
scheduleInt = mulBR (CF.mflowInterest flow) surviveRate
newRec = mulBR defAmt recoveryRate
newLoss = mulBR defAmt (1 - recoveryRate)
recVector = replace recV recoveryLag newRec
lossVector = replace lossV recoveryLag newLoss
endBal = max 0 $ afterBal - schedulePrin
tr = CF.MortgageFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt defAmt (head recVector) (head lossVector) 0.0 Nothing Nothing Nothing--TODO missing ppy-penalty here
projectScheduleFlow trs b_factor lastBal [] _ _ (r:rs) (l:ls) (recovery_lag,recovery_rate)
= projectScheduleFlow (trs++[tr]) b_factor lastBal [] [] [] rs ls (recovery_lag - 1,recovery_rate)
where
remain_length = length rs
lastDate = CF.getDate (last trs)
flowDate = nextDate lastDate Lib.Monthly
tr = CF.MortgageFlow flowDate lastBal 0 0 0 0 r l 0.0 Nothing Nothing Nothing
type DelinqRate = Rate
projectScheduleDelinqFlow :: ([CF.TsRow],[CF.TsRow]) -> Rate -> Balance -> [CF.TsRow] -> [DelinqRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> [Amount] -> (Rate,Int,Rate,Int) -> [CF.TsRow]
projectScheduleDelinqFlow (trs,[]) _ begBal flows [] [] defaults recoveries losses _ =
let
patchedFlows = [ CF.MortgageDelinqFlow d begBal prin int prepay delinq defVal recVal lossVal rate mB mPPN Nothing
| (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN Nothing,defVal,recVal,lossVal) <- zip4 flows defaults recoveries losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses)
r1 = sort $ trs ++ patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows)
in
r1
projectScheduleDelinqFlow (trs,newPerfs) _ begBal flows [] [] defaults recoveries losses _ =
let
patchedFlows = [ CF.MortgageDelinqFlow d begBal prin int prepay delinq defVal recVal lossVal rate mB mPPN Nothing
| (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN Nothing,defVal,recVal,lossVal) <- zip4 flows defaults recoveries losses] -- `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses)
r1 = sort $ trs ++ patchedFlows -- `debug` ("Patched rows\n"++show patchedFlows)
r3 = CF.aggregateTsByDate [] $ sort newPerfs -- `debug` ("New Perfs\n"++ show newPerfs)
(r1keep, r1merge) = splitByDate r1 (getDate (head r3)) EqToRight -- `debug` ("r3 \n"++ show r3)
r4 = CF.combineTss [] r1merge r3 -- `debug` ("r1keep \n"++ show r1keep++"\n r1merge \n"++ show r1merge)
in
r1keep ++ r4 -- `debug` ("r4 \n"++ show r4)
projectScheduleDelinqFlow (trs,backToPerfCfs) surviveRate begBal (flow:flows) (delinqRate:delinqRates) (ppyRate:ppyRates) (defaultBal:defaultBals) (recoveryBal:recoveryBals) (lossBal:lossBals) (defaultPct,defaultLag,recoveryRate,recoveryLag)
= projectScheduleDelinqFlow (trs++[tr],CF.combineTss [] backToPerfCfs currentBackToPerfCfs) newSurviveRate endBal flows delinqRates ppyRates newDefaultBals newRecoveryBals newLossBals (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("new back to perf flow"++ show backToPerfCfs)
where
delinqAmt = mulBR begBal delinqRate -- `debug` ("delinq Rate"++ show delinqRate)
ppyAmt = mulBR (begBal - delinqAmt) ppyRate -- `debug` ("begbal"++ show begBal++">>"++ show delinqAmt)
newSurviveRate = (1-delinqRate) * (1-ppyRate) * surviveRate
scheduleBal = view CF.tsRowBalance flow
schedulePrin = mulBR (CF.mflowPrincipal flow) surviveRate
scheduleInt = mulBR (CF.mflowInterest flow) surviveRate
newDefaultBal = mulBR delinqAmt defaultPct
endBal = max 0 $ (begBal - delinqAmt - ppyAmt - schedulePrin)
currentBackToPerfCfs = let
futureDs = drop (defaultLag+recoveryLag) $ getDates (flow:flows)
splitPct = divideBB (mulBR delinqAmt (1-defaultPct)) begBal
perfFlows = take (length flows - defaultLag - recoveryLag + 1) $ CF.splitTrs splitPct (flow:flows)
in
[ set CF.tsDate d f | (d,f) <- zip futureDs perfFlows ]
newDefaultBals = replace defaultBals (pred defaultLag) newDefaultBal
newRecoveryBals = replace recoveryBals (recoveryLag + pred defaultLag) (mulBR newDefaultBal recoveryRate)
newLossBals = replace lossBals (recoveryLag + pred defaultLag) (mulBR newDefaultBal (1-recoveryRate)) -- `debug` ("new loss def"++ show defaultBal++">>rate"++ show (1-recoveryRate) )
tr = CF.MortgageDelinqFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt delinqAmt defaultBal recoveryBal lossBal (CF.mflowRate flow) Nothing
Nothing Nothing -- `debug` ("|||>>> proj at date"++ show (CF.getDate flow))
-- | implementation on projection via default balance amount
projCashflowByDefaultAmt :: (Balance, Date, AmortPlan, Period,IRate,Maybe BorrowerNum) -> (Dates, ([Balance],[Balance]), [Rate], [IRate], [Int]) -> [CF.TsRow]
projCashflowByDefaultAmt (cb,lastPayDate,pt,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals), ppyRates, rateVector, remainTerms) =
let
initRow = CF.MortgageFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 cr mbn Nothing Nothing
in
foldl
(\acc (pDate, (defaultBal,futureDefualtBal), ppyRate, rate, rt)
-> let
begBal = view CF.tsRowBalance (last acc)
mBorrower = CF.mflowBorrowerNum (last acc)
newDefault = if begBal <= (defaultBal+futureDefualtBal) then
begBal
else
defaultBal
newPrepay = mulBR (max 0 (begBal - newDefault)) ppyRate -- `debug` ("mb from last"++ show mBorrower)
newInt = mulBI (max 0 (begBal - newDefault - newPrepay)) (periodRateFromAnnualRate p rate)
intBal = max 0 $ begBal - newDefault - newPrepay -- `debug` ("using rt"++ show rt)
newPrin = case (rt,pt) of
(0,_) -> intBal
(_,Level) -> let
pmt = calcPmt intBal (periodRateFromAnnualRate p rate) rt -- `debug` ("PMT with rt"++ show rt)
in
pmt - newInt
(_,Even) -> intBal / fromIntegral rt
_ -> error ("Unsupport Prin type for mortgage"++ show pt)
endBal = intBal - newPrin
newMbn = decreaseBorrowerNum begBal endBal mBorrower -- `debug` (">>> pdate"++ show pDate)
in
acc ++ [CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0 rate newMbn Nothing Nothing]
)
[initRow]
(zip5 cfDates (zip expectedDefaultBals unAppliedDefaultBals) ppyRates rateVector remainTerms)
-- TODO to fix here , hard code on Left
calcScheduleBalaceToday :: Mortgage -> Maybe [RateAssumption] -> Date -> Balance
calcScheduleBalaceToday m mRates asOfDay
= let
sd = Ast.getOriginDate m
in
case calcCashflow (resetToOrig m) sd mRates of
Right (CF.CashFlowFrame _ scheduleTxn) ->
case getByDate asOfDay scheduleTxn of
Just f -> view CF.tsRowBalance f
Nothing -> error "Failed to find schedule balance"
Left _ -> 0
-- | implementation on projection via default balance amount
projScheduleCashflowByDefaultAmt :: (Balance, Date,IRate,Maybe BorrowerNum) -> ([CF.TsRow], ([Balance],[Balance]), [Rate] ) -> ([CF.TsRow], Rate)
projScheduleCashflowByDefaultAmt (cb,lastPayDate,cr,mbn) (scheduleFlows,(expectedDefaultBals,unAppliedDefaultBals), ppyRates) =
let
initRow = CF.MortgageFlow lastPayDate cb 0.0 0.0 0.0 0.0 0.0 0.0 cr mbn Nothing Nothing
in
foldl
(\(acc,factor) (cflow, (defaultBal,futureDefualtBal), ppyRate)
-> let
pDate = getDate cflow
begBal = view CF.tsRowBalance (last acc)
mBorrower = CF.mflowBorrowerNum (last acc)
newDefault = if begBal <= (defaultBal+futureDefualtBal) then
begBal
else
defaultBal
newPrepay = mulBR (max 0 (begBal - newDefault)) ppyRate -- `debug` ("mb from last"++ show mBorrower)
intBal = max 0 $ begBal - newDefault - newPrepay
defRate = if (begBal - newPrepay) /= 0 then
divideBB newDefault (begBal - newPrepay)
else
0
newFactor = (1 - ppyRate) * (1 - defRate) * factor
newInt = mulBR (CF.mflowInterest cflow) newFactor
newPrin = mulBR (CF.mflowPrincipal cflow) newFactor
endBal = intBal - newPrin
newMbn = decreaseBorrowerNum begBal endBal mBorrower
in
(acc ++ [CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault 0.0 0.0
cr newMbn Nothing Nothing]
,newFactor)
)
([initRow],1.0)
(zip3 scheduleFlows (zip expectedDefaultBals unAppliedDefaultBals) ppyRates)
buildARMrates :: IR.RateType -> (ARM,Date,Date,Date,IRate) -> Maybe [RateAssumption] -> Ts
buildARMrates (IR.Fix _ _ ) _ _ = error "ARM should have floater rate"
buildARMrates or@(IR.Floater _ idx sprd initRate dp _ _ mRoundBy )
(arm, startDate, firstResetDate, lastCfDate, beginRate) mRates
= let
resetDates = genSerialDatesTill2 IE firstResetDate dp lastCfDate
projectFutureActualCurve = runInterestRate2 arm (startDate,beginRate) or resetDates
in
case A.getRateAssumption (fromMaybe [] mRates) idx of
Just (RateCurve idx curve)
-> projectFutureActualCurve curve
Just (RateFlat idx v)
-> projectFutureActualCurve (mkRateTs [(startDate, v),(lastCfDate,v)]) -- `debug` ("lpd"++show last_pay_date++"lpd"++ show (last cf_dates))
Nothing -> error $ "Failed to find index"++ show idx
instance Ast.Asset Mortgage where
calcCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd ptype _ _) _bal _rate _term _mbn _) d mRates
= fst <$> (projCashflow m d (MortgageAssump Nothing Nothing Nothing Nothing
,A.DummyDelinqAssump
,A.DummyDefaultAssump) mRates)
calcCashflow s@(ScheduleMortgageFlow beg_date flows _) d _
= Right $ CF.CashFlowFrame ( ((view CF.tsRowBalance) . head) flows, beg_date, Nothing ) flows
calcCashflow m@(AdjustRateMortgage _origin _arm _bal _rate _term _mbn _status) d mRates = Left $ "to be implement on adjust rate mortgage"
getCurrentBal (Mortgage _ _bal _ _ _ _) = _bal
getCurrentBal (AdjustRateMortgage _ _ _bal _ _ _ _) = _bal
getOriginBal (Mortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ ) = _bal
getOriginBal (AdjustRateMortgage (MortgageOriginalInfo _bal _ _ _ _ _ _ _) _ _ _ _ _ _ ) = _bal
getOriginRate m
= let
(MortgageOriginalInfo _ or _ _ _ _ _ _) = getOriginInfo m
in
case or of
IR.Fix _ _r -> _r
IR.Floater _ _ _ _r _ _ _ _ -> _r
getCurrentRate (Mortgage _ _ r _ _ _) = r
getCurrentRate (AdjustRateMortgage _ _ _ r _ _ _) = r
getCurrentRate (ScheduleMortgageFlow _ flows _) = 0.0
resetToOrig m@(Mortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) cb cr rt mBn st)
= Mortgage (MortgageOriginalInfo ob or ot p sd pt pp obr)
ob
(getOriginRate m)
ot
mBn
st --TODO borrowerNum is not being updated
resetToOrig m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd pt pp obr) arm cb cr rt mBn st)
= AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd pt pp obr)
arm
ob
(getOriginRate m)
ot
mBn
st --TODO borrowerNum is not being updated
resetToOrig m@(ScheduleMortgageFlow begDate flows dp) = m
getPaymentDates (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ _ _) extra = genDates sd p (ot+extra)
getPaymentDates (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ _ _ _) extra = genDates sd p (ot+extra)
getPaymentDates (ScheduleMortgageFlow begDate flows dp) extra
= let
lastPayDay = (getDate . last) flows
extDates = genSerialDates dp Exc lastPayDay extra
in
getDates flows ++ extDates
isDefaulted (Mortgage _ _ _ _ _ (Defaulted _)) = True
isDefaulted (AdjustRateMortgage _ _ _ _ _ _ (Defaulted _)) = True
isDefaulted Mortgage {} = False
isDefaulted AdjustRateMortgage {} = False
getOriginDate (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ ct _ _) = sd
getOriginDate (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ ct _ _) = sd
getOriginDate (ScheduleMortgageFlow begDate _ _) = begDate
getRemainTerms (Mortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ ct _ _) = ct
getRemainTerms (AdjustRateMortgage (MortgageOriginalInfo _ _ ot p sd _ _ _) _ _ _ ct _ _) = ct
getOriginInfo (Mortgage oi _ _ _ _ _) = oi
getOriginInfo (AdjustRateMortgage oi _ _ _ _ _ _) = oi
updateOriginDate (Mortgage (MortgageOriginalInfo ob or ot p sd _type mpn obr) cb cr ct mbn st) nd
= Mortgage (MortgageOriginalInfo ob or ot p nd _type mpn obr) cb cr ct mbn st
updateOriginDate (AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd _type mpn obr) arm cb cr ct mbn st) nd
= AdjustRateMortgage (MortgageOriginalInfo ob or ot p nd _type mpn obr) arm cb cr ct mbn st
-- project current mortgage with total default amt
projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current)
asOfDay
mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ,_ ,_)
mRates =
let
recoveryLag = maybe 0 getRecoveryLag amr
lastPayDate:cfDates = lastN (succ (recoveryLag + rt)) $ sd:getPaymentDates m recoveryLag
expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates)
unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals
remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates)
in
do
rateVector <- A.projRates cr or mRates cfDates
ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp
let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn)
(cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms)
let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr)
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM)
-- project current adjMortgage with total default amt
projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current)
asOfDay
mars@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams,_,_)
mRates =
let
ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm
passInitPeriod = (ot - rt) >= initPeriod
firstResetDate = monthsAfter sd (toInteger (succ initPeriod))
lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag
rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates
rateVector = fromRational <$> getValByDates rateCurve Inc cfDates
expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) (length cfDates)
unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals
recoveryLag = maybe 0 getRecoveryLag amr
remainTerms = paddingDefault 0 (reverse [0..(length cfDates - recoveryLag)]) (length cfDates)
in
do
ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp
let txns = projCashflowByDefaultAmt (cb,lastPayDate,prinPayType,p,cr,mbn) (cfDates,(expectedDefaultBals,unAppliedDefaultBals),ppyRates,rateVector,remainTerms)
let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery txns amr)
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM)
-- project schedule cashflow with total default amount
projCashflow m@(ScheduleMortgageFlow begDate flows dp) asOfDay
assumps@(pAssump@(A.MortgageAssump (Just (A.DefaultByAmt (dBal,vs))) amp amr ams ),dAssump,fAssump) _
= let
begBal = CF.mflowBegBalance $ head flows
begDate = getDate $ head flows
begRate = CF.mflowRate $ head flows
begMbn = CF.mflowBorrowerNum $ head flows
originCfDates = CF.getDate <$> flows
originFlowSize = length flows
recoveryLag = maybe 0 getRecoveryLag amr
totalLength = recoveryLag + originFlowSize
expectedDefaultBals = paddingDefault 0 (mulBR dBal <$> vs) totalLength
unAppliedDefaultBals = tail $ scanl (-) dBal expectedDefaultBals
endDate = (CF.getDate . last) flows
extraDates = genSerialDates dp Exc endDate recoveryLag
flowsWithEx = flows ++ extendTxns (last flows) extraDates -- `debug` (">> end date"++ show endDate++">>> extra dates"++show extraDates)
in
do
_ppyRate <- Ast.buildPrepayRates m (begDate:originCfDates) amp
let ppyRates = paddingDefault 0.0 _ppyRate totalLength
let (txns,_) = projScheduleCashflowByDefaultAmt
(begBal,begDate,begRate,begMbn)
(flowsWithEx,(expectedDefaultBals,unAppliedDefaultBals),ppyRates) -- `debug` ("exted flows"++ show flowsWithEx)
let (futureTxns,historyM) = CF.cutoffTrs asOfDay (patchLossRecovery txns amr) -- `debug` ("txn"++show txns)
let begBalAfterCut = CF.buildBegBal futureTxns
return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCut,asOfDay,Nothing) futureTxns) ,historyM) -- `debug` ("Future txn"++ show futureTxns)
-- project current mortgage(without delinq)
projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current)
asOfDay
mars@(A.MortgageAssump amd amp amr ams ,_ ,_)
mRates =
let
recoveryLag = maybe 0 getRecoveryLag amr
lastPayDate:cfDates = lastN (rt + 1) $ sd:getPaymentDates m 0
cfDatesLength = length cfDates
remainTerms = reverse [0..rt]
dc = getDayCount or -- `debug` ("day count"++ show dc)
recoveryDates = lastN recoveryLag $ sd:getPaymentDates m recoveryLag
in
do
rateVector <- A.projRates cr or mRates cfDates
defRates <- Ast.buildDefaultRates m (lastPayDate:cfDates) amd
ppyRates <- Ast.buildPrepayRates m (lastPayDate:cfDates) amp
let (txns',_,_) = projectMortgageFlow
(ob, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot)
(cfDates, defRates, ppyRates,rateVector,remainTerms)
let txns = DL.toList txns'
let lastProjTxn = last txns
let extraTxns = [ CF.emptyTsRow d lastProjTxn | d <- recoveryDates ]
let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (txns++extraTxns) amr)
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM)
-- project current mortgage(with delinq)
projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn Current)
asOfDay
mars@(A.MortgageDeqAssump amd amp amr ams
,_
,_)
mRates =
let
(recoveryRate, recoveryLag) = Ast.getRecoveryLagAndRate amr
lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m (recoveryLag+defaultLag)
(_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates
cfDatesLength = length cfDates + recoveryLag + defaultLag
in
do
rateVector <- A.projRates cr or mRates cfDates
(ppyRates,delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate m (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams)
let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector
(defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot)
(replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0)
let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay, Nothing) futureTxns) ,historyM)
-- project defaulted Mortgage
projCashflow m@(Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) cb cr rt mbn (Defaulted (Just defaultedDate)) )
asOfDay
(_,_,A.DefaultedRecovery rr lag timing) _ =
let
(emptyDates,recoveryDates) = splitAt (pred lag) $ genDates defaultedDate p (lag + length timing)
beforeRecoveryTxn = [ CF.MortgageFlow d 0 0 0 0 0 0 0 cr mbn Nothing Nothing | d <- emptyDates ]
recoveries = calcRecoveriesFromDefault cb rr timing
txns = [ CF.MortgageFlow d 0 0 0 0 0 r 0 cr mbn Nothing Nothing | (d,r) <- zip recoveryDates recoveries ]
futureTxns = cutBy Inc Future asOfDay $ beforeRecoveryTxn ++ txns
begBal = CF.buildBegBal futureTxns
in
Right $ (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns ,Map.empty)
-- project defaulted adjMortgage with a defaulted Date
projCashflow m@(AdjustRateMortgage mo arm cb cr rt mbn (Defaulted (Just defaultedDate)) ) asOfDay assumps mRates
= projCashflow (Mortgage mo cb cr rt mbn (Defaulted (Just defaultedDate))) asOfDay assumps mRates
-- project defaulted adjMortgage without a defaulted Date
projCashflow m@(AdjustRateMortgage _ _ cb cr rt mbn (Defaulted Nothing) ) asOfDay assumps _
= Right $ (CF.CashFlowFrame (cb,asOfDay,Nothing) [ CF.MortgageFlow asOfDay 0 0 0 0 0 0 0 cr mbn Nothing Nothing] ,Map.empty)
-- project defaulted Mortgage
projCashflow m@(Mortgage _ cb cr rt mbn (Defaulted Nothing) ) asOfDay assumps _
= Right $ (CF.CashFlowFrame (cb,asOfDay,Nothing) [ CF.MortgageFlow asOfDay 0 0 0 0 0 0 0 cr mbn Nothing Nothing] ,Map.empty)
-- project current AdjMortgage
projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current)
asOfDay
mars@(A.MortgageAssump amd amp amr ams,_,_)
mRates =
let
ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm
passInitPeriod = (ot - rt) >= initPeriod
firstResetDate = monthsAfter sd (toInteger (succ initPeriod))
(recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr
lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:getPaymentDates m recoveryLag
cfDatesLength = length cfDates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates ))
rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates
rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve)
scheduleBalToday = calcScheduleBalaceToday m mRates asOfDay
dc = getDayCount or
in
do
(ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate m (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams)
let remainTerms = reverse $ replicate recoveryLag 0 ++ [0..rt]
let (txns,_,_) = projectMortgageFlow (scheduleBalToday, cb,lastPayDate,mbn,prinPayType,dc,cr,p,ot) (cfDates, defRates, ppyRates,rateVector,remainTerms)
let (futureTxns,historyM)= CF.cutoffTrs asOfDay (patchLossRecovery (DL.toList txns) amr)
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM)
-- project current AdjMortgage with delinq
projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn _) arm cb cr rt mbn Current)
asOfDay
mars@(A.MortgageDeqAssump amd amp amr ams,_,_)
mRates
= let
ARM initPeriod initCap periodicCap lifeCap lifeFloor = arm
passInitPeriod = (ot - rt) >= initPeriod
firstResetDate = monthsAfter sd (toInteger (succ initPeriod))
(recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate amr
-- Ast.getDefaultDelinqAssump amd
lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:getPaymentDates m recoveryLag
(_,defaultLag,defaultPct) = Ast.getDefaultDelinqAssump amd cfDates
cfDatesLength = length cfDates
rateCurve = buildARMrates or (arm, sd, firstResetDate, last cfDates, getOriginRate m) mRates
rateVector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve)
in
do
(ppyRates, delinqRates,(_,_),_,_) <- Ast.buildAssumptionPpyDelinqDefRecRate m (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams)
let txns = projectDelinqMortgageFlow ([],[]) cb mbn lastPayDate cfDates delinqRates ppyRates rateVector
(defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType,ot)
(replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0)
let (futureTxns,historyM)= CF.cutoffTrs asOfDay txns
let begBal = CF.buildBegBal futureTxns
return $ (applyHaircut ams $ patchPrepayPenaltyFlow (ot,mpn) (CF.CashFlowFrame (begBal,asOfDay,Nothing) futureTxns) ,historyM)
-- schedule mortgage flow without delinq
projCashflow m@(ScheduleMortgageFlow begDate flows dp) asOfDay
assumps@(pAssump@(A.MortgageAssump _ _ mRa ams ),dAssump,fAssump) _
= let
begBal = CF.mflowBegBalance $ head flows
endDate = CF.getDate (last flows)
(recoveryRate,recoveryLag) = Ast.getRecoveryLagAndRate mRa
curveDatesLength = recoveryLag + length flows
extraDates = genSerialDates dp Exc endDate recoveryLag
cfDates = (CF.getDate <$> flows) ++ extraDates
in
do
(ppyRates,defRates,recoveryRate,recoveryLag) <- buildAssumptionPpyDefRecRate m (begDate:cfDates) pAssump
let txns = projectScheduleFlow [] 1.0 begBal flows defRates ppyRates
(replicate curveDatesLength 0.0)
(replicate curveDatesLength 0.0)
(recoveryLag,recoveryRate)
let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns
let begBalAfterCutoff = CF.buildBegBal futureTxns
return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff,asOfDay,Nothing) futureTxns) ,historyM)
-- schedule mortgage flow WITH delinq
projCashflow smf@(ScheduleMortgageFlow begDate flows dp) asOfDay assumps@(pAssump@(A.MortgageDeqAssump _ _ _ ams),dAssump,fAssump) mRates
=
let
begBal = CF.mflowBegBalance $ head flows -- `debug` ("beg date"++show beg_date)
in
do
(ppyRates, delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) <- Ast.buildAssumptionPpyDelinqDefRecRate smf (begDate:getDates flows) pAssump
let curveDatesLength = defaultLag + recoveryLag + length flows -- `debug` ("Length of rates"++show (length delinqRates)++">>"++show (length ppyRates))
let extraPeriods = defaultLag + recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag)
let endDate = CF.getDate (last flows)
let extraDates = genSerialDates dp Exc endDate extraPeriods
let extraFlows = [ CF.emptyTsRow d r | (d,r) <- zip extraDates (replicate extraPeriods (last flows)) ]
let flowWithExtraDates = flows ++ extraFlows
let cfDates = getDates flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates)
let txns = projectScheduleDelinqFlow ([],[]) 1.0 begBal flowWithExtraDates delinqRates ppyRates
(replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0)
(replicate curveDatesLength 0.0) (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates)
let (futureTxns,historyM) = CF.cutoffTrs asOfDay txns
let begBalAfterCutoff = CF.buildBegBal futureTxns
return $ (applyHaircut ams (CF.CashFlowFrame (begBalAfterCutoff, asOfDay,Nothing) futureTxns) ,historyM)
projCashflow a b c d = Left $ "Failed to match when proj mortgage with assumption >>" ++ show a ++ show b ++ show c ++ show d
getBorrowerNum m@(Mortgage _ cb cr rt mbn _ ) = fromMaybe 1 mbn
getBorrowerNum m@(AdjustRateMortgage _ _ cb cr rt mbn _ ) = fromMaybe 1 mbn
splitWith (Mortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn obr) cb cr rt mbn st ) rs
= [ Mortgage (MortgageOriginalInfo (mulBR ob ratio) or ot p sd prinPayType mpn obr) (mulBR cb ratio) cr rt mbn st
| ratio <- rs ]
splitWith (AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn obr) arm cb cr rt mbn st ) rs
= [ AdjustRateMortgage (MortgageOriginalInfo (mulBR ob ratio) or ot p sd prinPayType mpn obr) arm (mulBR cb ratio) cr rt mbn st
| ratio <- rs ]