{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}

module AssetClass.AssetCashflow
  (applyHaircut,patchPrepayPenaltyFlow,getRecoveryLag,decreaseBorrowerNum
  ,patchLossRecovery,getRecoveryLagFromAssumption)
  where

import qualified Data.Time as T
import qualified Cashflow as CF 
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 Debug.Trace
import qualified Assumptions as A 
import GHC.Float.RealFracMethods (truncateFloatInteger)
import Cashflow (mflowDefault)
debug :: c -> String -> c
debug = (String -> c -> c) -> c -> String -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> c -> c
forall a. String -> a -> a
trace

-- This module is a collection of common cashflow functions to project cashflow for different asset types.

-- ^ apply haircut to pool cashflow, reduce cash via a percentage
applyHaircut :: Maybe A.ExtraStress -> CF.CashFlowFrame -> CF.CashFlowFrame
applyHaircut :: Maybe ExtraStress -> CashFlowFrame -> CashFlowFrame
applyHaircut Maybe ExtraStress
Nothing CashFlowFrame
cf = CashFlowFrame
cf 
applyHaircut (Just A.ExtraStress{poolHairCut :: ExtraStress -> Maybe [(PoolSource, Rate)]
A.poolHairCut = Maybe [(PoolSource, Rate)]
Nothing}) CashFlowFrame
cf = CashFlowFrame
cf
applyHaircut (Just A.ExtraStress{poolHairCut :: ExtraStress -> Maybe [(PoolSource, Rate)]
A.poolHairCut = Just [(PoolSource, Rate)]
haircuts}) (CF.CashFlowFrame BeginStatus
st [TsRow]
txns)
  = BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ 
      (\TsRow
txn -> ((TsRow -> TsRow) -> TsRow -> TsRow)
-> TsRow -> [TsRow -> TsRow] -> TsRow
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 
                 (\TsRow -> TsRow
fn TsRow
acc -> TsRow -> TsRow
fn TsRow
acc ) 
                 TsRow
txn 
                 ((PoolSource, Rate) -> TsRow -> TsRow
applyHaircutTxn ((PoolSource, Rate) -> TsRow -> TsRow)
-> [(PoolSource, Rate)] -> [TsRow -> TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PoolSource, Rate)]
haircuts) ) (TsRow -> TsRow) -> [TsRow] -> [TsRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
txns
    where
      applyHaircutTxn :: (PoolSource, Rate) -> TsRow -> TsRow
applyHaircutTxn (PoolSource
CollectedInterest,Rate
r) 
                      (CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin (Balance -> Rate -> Balance
mulBR Balance
interest (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrincipal,Rate
r)
                      (CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Balance
bal (Balance -> Rate -> Balance
mulBR Balance
prin (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedRecoveries,Rate
r)
                      (CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def (Balance -> Rate -> Balance
mulBR Balance
recovery (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrepayment,Rate
r)
                      (CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest (Balance -> Rate -> Balance
mulBR Balance
ppy (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrepaymentPenalty,Rate
r)
                      (CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageDelinqFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
delinq Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn ((\Balance
x -> Balance -> Rate -> Balance
mulBR Balance
x (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r) ) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mppn) Maybe CumulativeStat
mst
      
      applyHaircutTxn (PoolSource
CollectedInterest,Rate
r) 
                      (CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Balance
bal Balance
prin (Balance -> Rate -> Balance
mulBR Balance
interest (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrincipal,Rate
r)
                      (CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Balance
bal (Balance -> Rate -> Balance
mulBR Balance
prin (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedRecoveries,Rate
r)
                      (CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def (Balance -> Rate -> Balance
mulBR Balance
recovery (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrepayment,Rate
r)
                      (CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst) 
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest (Balance -> Rate -> Balance
mulBR Balance
ppy (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r)) Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst
      applyHaircutTxn (PoolSource
CollectedPrepaymentPenalty,Rate
r)
                      (CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn Maybe Balance
mppn Maybe CumulativeStat
mst)
        = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe BorrowerNum
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
d Balance
bal Balance
prin Balance
interest Balance
ppy Balance
def Balance
recovery Balance
loss IRate
irate Maybe BorrowerNum
mbn ((\Balance
x -> Balance -> Rate -> Balance
mulBR Balance
x (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
r) ) (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
mppn) Maybe CumulativeStat
mst
      
      applyHaircutTxn (PoolSource, Rate)
_ TsRow
_ = String -> TsRow
forall a. HasCallStack => String -> a
error String
"Not implemented"
   
-- ^ apply a penalty cashflow
patchPrepayPenaltyFlow :: (Int,Maybe PrepayPenaltyType) -> CF.CashFlowFrame -> CF.CashFlowFrame
patchPrepayPenaltyFlow :: (BorrowerNum, Maybe PrepayPenaltyType)
-> CashFlowFrame -> CashFlowFrame
patchPrepayPenaltyFlow (BorrowerNum
ot,Maybe PrepayPenaltyType
mPpyPen) mflow :: CashFlowFrame
mflow@(CF.CashFlowFrame BeginStatus
st [TsRow]
trs) 
  = let 
      --(startDate,endDate) = CF.getDateRangeCashFlowFrame mflow
      prepaymentFlow :: [Balance]
prepaymentFlow = TsRow -> Balance
CF.mflowPrepayment (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs
      flowSize :: BorrowerNum
flowSize = CashFlowFrame -> BorrowerNum
CF.sizeCashFlowFrame CashFlowFrame
mflow
    in 
      case Maybe PrepayPenaltyType
mPpyPen of 
        Maybe PrepayPenaltyType
Nothing -> CashFlowFrame
mflow
        Just (ByTerm BorrowerNum
cutoff Rate
rate0 Rate
rate1) -> 
          let 
            rs :: [Rate]
rs = BorrowerNum -> [Rate] -> [Rate]
forall a. BorrowerNum -> [a] -> [a]
lastN BorrowerNum
flowSize ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
cutoff Rate
rate0 [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate (BorrowerNum
otBorrowerNum -> BorrowerNum -> BorrowerNum
forall a. Num a => a -> a -> a
-BorrowerNum
cutoff) Rate
rate1
          in 
            BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Balance] -> [TsRow] -> [TsRow]
CF.setPrepaymentPenaltyFlow ((Balance -> Rate -> Balance) -> [Balance] -> [Rate] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Balance -> Rate -> Balance
mulBR [Balance]
prepaymentFlow [Rate]
rs) [TsRow]
trs
        Just (FixAmount Balance
amt Maybe BorrowerNum
mCutoff) -> 
          let 
            projFlow :: [Balance]
projFlow = case Maybe BorrowerNum
mCutoff of 
                         Maybe BorrowerNum
Nothing -> BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
flowSize Balance
amt
                         Just BorrowerNum
cutoff -> BorrowerNum -> [Balance] -> [Balance]
forall a. BorrowerNum -> [a] -> [a]
lastN BorrowerNum
flowSize ([Balance] -> [Balance]) -> [Balance] -> [Balance]
forall a b. (a -> b) -> a -> b
$ BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
cutoff Balance
amt [Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++ BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate (BorrowerNum
otBorrowerNum -> BorrowerNum -> BorrowerNum
forall a. Num a => a -> a -> a
-BorrowerNum
cutoff) Balance
0 
            actFlow :: [Balance]
actFlow = [ if Balance
ppy Balance -> Balance -> Bool
forall a. Ord a => a -> a -> Bool
> Balance
0 then 
                          Balance
f
                        else
                          Balance
0
                        | (Balance
f,Balance
ppy) <- [Balance] -> [Balance] -> [(Balance, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Balance]
projFlow [Balance]
prepaymentFlow]
          in 
            BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Balance] -> [TsRow] -> [TsRow]
CF.setPrepaymentPenaltyFlow [Balance]
actFlow [TsRow]
trs
        Just (FixPct Rate
r Maybe BorrowerNum
mCutoff) ->
          let 
            rs :: [Rate]
rs = case Maybe BorrowerNum
mCutoff of 
                   Maybe BorrowerNum
Nothing -> BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
flowSize Rate
r
                   Just BorrowerNum
cutoff -> BorrowerNum -> [Rate] -> [Rate]
forall a. BorrowerNum -> [a] -> [a]
lastN BorrowerNum
flowSize ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
cutoff Rate
r [Rate] -> [Rate] -> [Rate]
forall a. [a] -> [a] -> [a]
++ BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate (BorrowerNum
otBorrowerNum -> BorrowerNum -> BorrowerNum
forall a. Num a => a -> a -> a
-BorrowerNum
cutoff) Rate
0
          in
            BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Balance] -> [TsRow] -> [TsRow]
CF.setPrepaymentPenaltyFlow ((Balance -> Rate -> Balance) -> [Balance] -> [Rate] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Balance -> Rate -> Balance
mulBR [Balance]
prepaymentFlow [Rate]
rs) [TsRow]
trs
        Just (Sliding Rate
sr Rate
changeRate) -> 
          let 
            rs :: [Rate]
rs = BorrowerNum -> [Rate] -> [Rate]
forall a. BorrowerNum -> [a] -> [a]
lastN BorrowerNum
flowSize ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ Rate -> [Rate] -> BorrowerNum -> [Rate]
forall a. a -> [a] -> BorrowerNum -> [a]
paddingDefault Rate
0 (Rate
0Rate -> [Rate] -> [Rate]
forall a. a -> [a] -> [a]
:[Rate
sr,(Rate
srRate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
changeRate)..Rate
0]) BorrowerNum
ot
          in
            BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Balance] -> [TsRow] -> [TsRow]
CF.setPrepaymentPenaltyFlow ((Balance -> Rate -> Balance) -> [Balance] -> [Rate] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Balance -> Rate -> Balance
mulBR [Balance]
prepaymentFlow [Rate]
rs) [TsRow]
trs
        Just (StepDown [(BorrowerNum, Rate)]
ps) ->
          let 
            rs :: [Rate]
rs = BorrowerNum -> [Rate] -> [Rate]
forall a. BorrowerNum -> [a] -> [a]
lastN BorrowerNum
flowSize ([Rate] -> [Rate]) -> [Rate] -> [Rate]
forall a b. (a -> b) -> a -> b
$ Rate -> [Rate] -> BorrowerNum -> [Rate]
forall a. a -> [a] -> BorrowerNum -> [a]
paddingDefault Rate
0 ([[Rate]] -> [Rate]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ BorrowerNum -> Rate -> [Rate]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
n Rate
r | (BorrowerNum
n,Rate
r) <- [(BorrowerNum, Rate)]
ps]) BorrowerNum
ot
          in 
            BeginStatus -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame BeginStatus
st ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ [Balance] -> [TsRow] -> [TsRow]
CF.setPrepaymentPenaltyFlow ((Balance -> Rate -> Balance) -> [Balance] -> [Rate] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Balance -> Rate -> Balance
mulBR [Balance]
prepaymentFlow [Rate]
rs) [TsRow]
trs

getRecoveryLag :: A.RecoveryAssumption -> Int
getRecoveryLag :: RecoveryAssumption -> BorrowerNum
getRecoveryLag (A.Recovery (Rate
_,BorrowerNum
lag)) = BorrowerNum
lag 
getRecoveryLag (A.RecoveryTiming (Rate
_,[Rate]
rs)) = [Rate] -> BorrowerNum
forall a. [a] -> BorrowerNum
forall (t :: * -> *) a. Foldable t => t a -> BorrowerNum
length [Rate]
rs

getRecoveryLagFromAssumption :: A.AssetPerfAssumption -> Maybe Int
getRecoveryLagFromAssumption :: AssetPerfAssumption -> Maybe BorrowerNum
getRecoveryLagFromAssumption (A.MortgageAssump Maybe AssetDefaultAssumption
_ Maybe AssetPrepayAssumption
_ (Just RecoveryAssumption
ra) Maybe ExtraStress
_) = BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ RecoveryAssumption -> BorrowerNum
getRecoveryLag RecoveryAssumption
ra
getRecoveryLagFromAssumption (A.MortgageDeqAssump Maybe AssetDelinquencyAssumption
_ Maybe AssetPrepayAssumption
_ (Just RecoveryAssumption
ra) Maybe ExtraStress
_) = BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ RecoveryAssumption -> BorrowerNum
getRecoveryLag RecoveryAssumption
ra
getRecoveryLagFromAssumption (A.LoanAssump Maybe AssetDefaultAssumption
_ Maybe AssetPrepayAssumption
_ (Just RecoveryAssumption
ra) Maybe ExtraStress
_) = BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ RecoveryAssumption -> BorrowerNum
getRecoveryLag RecoveryAssumption
ra
getRecoveryLagFromAssumption (A.InstallmentAssump Maybe AssetDefaultAssumption
_ Maybe AssetPrepayAssumption
_ (Just RecoveryAssumption
ra) Maybe ExtraStress
_) = BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ RecoveryAssumption -> BorrowerNum
getRecoveryLag RecoveryAssumption
ra
getRecoveryLagFromAssumption (A.ReceivableAssump Maybe AssetDefaultAssumption
_ (Just RecoveryAssumption
ra) Maybe ExtraStress
_) = BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ RecoveryAssumption -> BorrowerNum
getRecoveryLag RecoveryAssumption
ra
getRecoveryLagFromAssumption AssetPerfAssumption
_ = Maybe BorrowerNum
forall a. Maybe a
Nothing


decreaseBorrowerNum :: Balance -> Balance -> Maybe BorrowerNum -> Maybe Int
decreaseBorrowerNum :: Balance -> Balance -> Maybe BorrowerNum -> Maybe BorrowerNum
decreaseBorrowerNum Balance
bb Balance
0 Maybe BorrowerNum
mBn = Maybe BorrowerNum
forall a. Maybe a
Nothing
decreaseBorrowerNum Balance
bb Balance
eb Maybe BorrowerNum
mBn 
  = case Maybe BorrowerNum
mBn of
      Maybe BorrowerNum
Nothing -> Maybe BorrowerNum
forall a. Maybe a
Nothing::(Maybe BorrowerNum)
      Just BorrowerNum
0  -> Maybe BorrowerNum
forall a. Maybe a
Nothing::(Maybe BorrowerNum)
      Just BorrowerNum
bn -> BorrowerNum -> Maybe BorrowerNum
forall a. a -> Maybe a
Just (BorrowerNum -> Maybe BorrowerNum)
-> BorrowerNum -> Maybe BorrowerNum
forall a b. (a -> b) -> a -> b
$ Double -> BorrowerNum
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> BorrowerNum) -> Double -> BorrowerNum
forall a b. (a -> b) -> a -> b
$ Rate -> Double
forall a. Fractional a => Rate -> a
fromRational (Rate -> Double) -> Rate -> Double
forall a b. (a -> b) -> a -> b
$ BorrowerNum -> Rate -> Rate
mulIR BorrowerNum
bn Rate
downRate::(Maybe BorrowerNum)
    where 
      downRate :: Rate
downRate = if Balance
eb Balance -> Balance -> Bool
forall a. Eq a => a -> a -> Bool
== Balance
0 then 
                   Rate
0.0
                 else
                   Balance -> Balance -> Rate
divideBB Balance
eb Balance
bb

-- | given a list of future cashflows and patch recovery & loss
patchLossRecovery :: [CF.TsRow] -> Maybe A.RecoveryAssumption -> [CF.TsRow]
patchLossRecovery :: [TsRow] -> Maybe RecoveryAssumption -> [TsRow]
patchLossRecovery [TsRow]
trs Maybe RecoveryAssumption
Nothing 
  = [TsRow] -> [TsRow]
CF.dropTailEmptyTxns ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [ Balance -> TsRow -> TsRow
CF.tsSetRecovery Balance
0 (Balance -> TsRow -> TsRow
CF.tsSetLoss Balance
d TsRow
r) | (Balance
d,TsRow
r) <- [Balance] -> [TsRow] -> [(Balance, TsRow)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Balance]
defaultVec [TsRow]
trs ] -- `debug` ("Hit Nothign on recovery"++ show defaultVec)
    where 
      defaultVec :: [Balance]
defaultVec = TsRow -> Balance
mflowDefault (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs

-- ^ make sure trs has empty rows with length=lag. as it drop extended rows
patchLossRecovery [TsRow]
trs (Just (A.Recovery (Rate
rr,BorrowerNum
lag)))
  = [TsRow] -> [TsRow]
CF.dropTailEmptyTxns ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [ Balance -> TsRow -> TsRow
CF.tsSetRecovery Balance
recovery (Balance -> TsRow -> TsRow
CF.tsSetLoss Balance
loss TsRow
r) | (TsRow
r,Balance
recovery,Balance
loss) <- [TsRow] -> [Balance] -> [Balance] -> [(TsRow, Balance, Balance)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [TsRow]
trs [Balance]
recoveryAfterLag [Balance]
lossVecAfterLag]
    where 
      defaultVec :: [Balance]
defaultVec = TsRow -> Balance
mflowDefault (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs
      recoveriesVec :: [Balance]
recoveriesVec = (Balance -> Rate -> Balance
`mulBR` Rate
rr) (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
defaultVec -- `debug` ("Default Vec"++ show defaultVec)
      recoveryAfterLag :: [Balance]
recoveryAfterLag = BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
lag Balance
0.0 [Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++ [Balance]
recoveriesVec --  `debug` ("recovery"++ show recoveriesVec)
      lossVec :: [Balance]
lossVec = (Balance -> Rate -> Balance
`mulBR` (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
rr)) (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
defaultVec  --  `debug` ("Rec after lag"++ show recoveryAfterLag)
      lossVecAfterLag :: [Balance]
lossVecAfterLag = BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
lag Balance
0.0 [Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++ [Balance]
lossVec  -- drop last lag elements

patchLossRecovery [TsRow]
trs (Just (A.RecoveryTiming (Rate
rr,[Rate]
recoveryTimingDistribution)))
  = [TsRow] -> [TsRow]
CF.dropTailEmptyTxns ([TsRow] -> [TsRow]) -> [TsRow] -> [TsRow]
forall a b. (a -> b) -> a -> b
$ [ Balance -> TsRow -> TsRow
CF.tsSetRecovery Balance
recVal (Balance -> TsRow -> TsRow
CF.tsSetLoss Balance
loss TsRow
r) | (Balance
recVal,Balance
loss,TsRow
r) <- [Balance] -> [Balance] -> [TsRow] -> [(Balance, Balance, TsRow)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Balance]
sumRecovery [Balance]
sumLoss [TsRow]
trs ]
    where
      cfLength :: BorrowerNum
cfLength = [TsRow] -> BorrowerNum
forall a. [a] -> BorrowerNum
forall (t :: * -> *) a. Foldable t => t a -> BorrowerNum
length [TsRow]
trs -- cashflow length
      rLength :: BorrowerNum
rLength = [Rate] -> BorrowerNum
forall a. [a] -> BorrowerNum
forall (t :: * -> *) a. Foldable t => t a -> BorrowerNum
length [Rate]
recoveryTimingDistribution  -- recovery length
      defaultVec :: [Balance]
defaultVec = TsRow -> Balance
mflowDefault (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
trs  -- default balance of each row

      rs :: [Rate]
rs = (Rate
rr Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
*) (Rate -> Rate) -> [Rate] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
recoveryTimingDistribution 

      recoveriesVec :: [[Balance]]
recoveriesVec = [ Balance -> Rate -> Balance
mulBR Balance
defaultVal (Rate -> Balance) -> [Rate] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
rs  | Balance
defaultVal <- [Balance]
defaultVec ] 
      
      offsets :: [BorrowerNum]
offsets = [BorrowerNum
0..([Balance] -> BorrowerNum
forall a. [a] -> BorrowerNum
forall (t :: * -> *) a. Foldable t => t a -> BorrowerNum
length [Balance]
defaultVec BorrowerNum -> BorrowerNum -> BorrowerNum
forall a. Num a => a -> a -> a
- BorrowerNum
rLength)]
      
      paddedRecoveries :: [[Balance]]
paddedRecoveries = [ Balance -> [Balance] -> BorrowerNum -> [Balance]
forall a. a -> [a] -> BorrowerNum -> [a]
paddingDefault Balance
0 (BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate BorrowerNum
prePadding Balance
0 [Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++ [Balance]
recVal) BorrowerNum
cfLength 
                          | (BorrowerNum
prePadding,[Balance]
recVal) <- [BorrowerNum] -> [[Balance]] -> [(BorrowerNum, [Balance])]
forall a b. [a] -> [b] -> [(a, b)]
zip [BorrowerNum]
offsets [[Balance]]
recoveriesVec ]

      sumRecovery :: [Balance]
sumRecovery = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [[Balance]] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Balance]] -> [[Balance]]
forall a. [[a]] -> [[a]]
transpose [[Balance]]
paddedRecoveries
      lossVec :: [Balance]
lossVec = [ Balance -> Rate -> Balance
mulBR Balance
defaultVal (Rate
1Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
-Rate
rr) | Balance
defaultVal <- [Balance]
defaultVec ]
      sumLoss :: [Balance]
sumLoss = BorrowerNum -> Balance -> [Balance]
forall a. BorrowerNum -> a -> [a]
replicate (BorrowerNum -> BorrowerNum
forall a. Enum a => a -> a
pred BorrowerNum
rLength) Balance
0.0 [Balance] -> [Balance] -> [Balance]
forall a. [a] -> [a] -> [a]
++ [Balance]
lossVec