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

module AssetClass.ProjectedCashFlow  
  (ProjectedCashflow(..))
  where

import qualified Data.Time as T
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 qualified Cashflow as CF

import AssetClass.AssetBase
import AssetClass.AssetCashflow

import Cashflow (extendTxns,TsRow(..))

import Debug.Trace
import Control.Lens hiding (element,Index)
import Control.Lens.TH
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


projectScheduleFlow :: [CF.TsRow] -> Rate -> Balance -> [CF.TsRow] -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> (Int, Rate) -> [CF.TsRow]
projectScheduleFlow :: [TsRow]
-> Rate
-> Balance
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Balance]
-> [Balance]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow [TsRow]
trs Rate
_ Balance
last_bal [] [Rate]
_ [Rate]
_ [] [] (Int
_,Rate
_) = [TsRow]
trs 
projectScheduleFlow [TsRow]
trs Rate
bal_factor Balance
last_bal (TsRow
flow:[TsRow]
flows) (Rate
defRate:[Rate]
defRates) (Rate
ppyRate:[Rate]
ppyRates) [Balance]
recV [Balance]
lossV (Int
recoveryLag,Rate
recoveryRate)
  = [TsRow]
-> Rate
-> Balance
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Balance]
-> [Balance]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr]) Rate
surviveRate Balance
endBal [TsRow]
flows [Rate]
defRates [Rate]
ppyRates ([Balance] -> [Balance]
forall a. HasCallStack => [a] -> [a]
tail [Balance]
recVector) ([Balance] -> [Balance]
forall a. HasCallStack => [a] -> [a]
tail [Balance]
lossVector) (Int
recoveryLag,Rate
recoveryRate) -- `debug` ("===>C")
     where
       startBal :: Balance
startBal = Balance
last_bal
       defAmt :: Balance
defAmt = Balance -> Rate -> Balance
mulBR Balance
startBal Rate
defRate
       ppyAmt :: Balance
ppyAmt = Balance -> Rate -> Balance
mulBR (Balance
startBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
defAmt) Rate
ppyRate 
       afterBal :: Balance
afterBal = Balance
startBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
defAmt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
ppyAmt   
       
       surviveRate :: Rate
surviveRate = (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
defRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
ppyRate) Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
* Rate
bal_factor 
       schedulePrin :: Balance
schedulePrin = Balance -> Rate -> Balance
mulBR (TsRow -> Balance
CF.mflowPrincipal TsRow
flow) Rate
surviveRate --TODO round trip  -- `debug` ("Schedule Principal"++(printf "%.2f" (CF.mflowPrincipal flow))++" Rate"++show(_schedule_rate))
       scheduleInt :: Balance
scheduleInt = Balance -> Rate -> Balance
mulBR (TsRow -> Balance
CF.mflowInterest TsRow
flow) Rate
surviveRate

       newRec :: Balance
newRec = Balance -> Rate -> Balance
mulBR Balance
defAmt Rate
recoveryRate
       newLoss :: Balance
newLoss = Balance -> Rate -> Balance
mulBR Balance
defAmt (Rate
1 Rate -> Rate -> Rate
forall a. Num a => a -> a -> a
- Rate
recoveryRate)

       recVector :: [Balance]
recVector = [Balance] -> Int -> Balance -> [Balance]
forall a. [a] -> Int -> a -> [a]
replace [Balance]
recV Int
recoveryLag Balance
newRec
       lossVector :: [Balance]
lossVector = [Balance] -> Int -> Balance -> [Balance]
forall a. [a] -> Int -> a -> [a]
replace [Balance]
lossV Int
recoveryLag Balance
newLoss

       endBal :: Balance
endBal = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
max Balance
0 (Balance -> Balance) -> Balance -> Balance
forall a b. (a -> b) -> a -> b
$ Balance
afterBal Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
schedulePrin -- `debug` ("start bal"++ show startBal ++"sch prin"++ show schedulePrin)

       tr :: TsRow
tr = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe Int
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate TsRow
flow) Balance
endBal Balance
schedulePrin Balance
scheduleInt Balance
ppyAmt Balance
defAmt ([Balance] -> Balance
forall a. HasCallStack => [a] -> a
head [Balance]
recVector) ([Balance] -> Balance
forall a. HasCallStack => [a] -> a
head [Balance]
lossVector) IRate
0.0 Maybe Int
forall a. Maybe a
Nothing Maybe Balance
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing--TODO missing ppy-penalty here

projectScheduleFlow [TsRow]
trs Rate
b_factor Balance
lastBal [] [Rate]
_ [Rate]
_ (Balance
r:[Balance]
rs) (Balance
l:[Balance]
ls) (Int
recovery_lag,Rate
recovery_rate)
  = [TsRow]
-> Rate
-> Balance
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Balance]
-> [Balance]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow ([TsRow]
trs[TsRow] -> [TsRow] -> [TsRow]
forall a. [a] -> [a] -> [a]
++[TsRow
tr]) Rate
b_factor Balance
lastBal [] [] [] [Balance]
rs [Balance]
ls (Int
recovery_lag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1,Rate
recovery_rate) 
   where
      remain_length :: Int
remain_length = [Balance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Balance]
rs
      lastDate :: Date
lastDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
trs)
      flowDate :: Date
flowDate = Date -> Period -> Date
nextDate Date
lastDate Period
Lib.Monthly
      tr :: TsRow
tr = Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe Int
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
CF.MortgageFlow Date
flowDate Balance
lastBal Balance
0 Balance
0 Balance
0 Balance
0 Balance
r Balance
l IRate
0.0 Maybe Int
forall a. Maybe a
Nothing Maybe Balance
forall a. Maybe a
Nothing Maybe CumulativeStat
forall a. Maybe a
Nothing



-- ^ project cashflow with floater rate portion
projFixCfwithAssumption :: (CF.CashFlowFrame, DatePattern) -> ([Rate],[Rate],Rate,Int) -> Date -> Either String CF.CashFlowFrame
projFixCfwithAssumption :: (CashFlowFrame, DatePattern)
-> ([Rate], [Rate], Rate, Int)
-> Date
-> Either String CashFlowFrame
projFixCfwithAssumption (cf :: CashFlowFrame
cf@(CF.CashFlowFrame (Balance
begBal, Date
begDate, Maybe Balance
accInt) [TsRow]
flows), DatePattern
dp)
                        ([Rate]
ppyRates,[Rate]
defRates,Rate
recoveryRate,Int
recoveryLag)
                        Date
asOfDay
  = let
        curveDatesLength :: Int
curveDatesLength = Int
recoveryLag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows
        endDate :: Date
endDate = TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate ([TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
last [TsRow]
flows)
        extraDates :: Dates
extraDates = DatePattern -> CutoffType -> Date -> Int -> Dates
genSerialDates DatePattern
dp CutoffType
Exc Date
endDate Int
recoveryLag
        cfDates :: Dates
cfDates = (TsRow -> Date
forall ts. TimeSeries ts => ts -> Date
CF.getDate (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows) Dates -> Dates -> Dates
forall a. [a] -> [a] -> [a]
++ Dates
extraDates
    in 
      do
        let txns :: [TsRow]
txns = [TsRow]
-> Rate
-> Balance
-> [TsRow]
-> [Rate]
-> [Rate]
-> [Balance]
-> [Balance]
-> (Int, Rate)
-> [TsRow]
projectScheduleFlow [] Rate
1.0 Balance
begBal [TsRow]
flows [Rate]
defRates [Rate]
ppyRates
                    (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Balance
0.0)
                    (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Balance
0.0)
                    (Int
recoveryLag,Rate
recoveryRate) --  `debug` (" begin bal"++ show begBal)
        
        let ([TsRow]
futureTxns,Map CutoffFields Balance
historyM) = Date -> [TsRow] -> ([TsRow], Map CutoffFields Balance)
CF.cutoffTrs Date
asOfDay [TsRow]
txns 
        
        let cb :: Balance
cb = (TsRow -> Balance
CF.mflowBegBalance (TsRow -> Balance) -> ([TsRow] -> TsRow) -> [TsRow] -> Balance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head) [TsRow]
futureTxns
        CashFlowFrame -> Either String CashFlowFrame
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame -> Either String CashFlowFrame)
-> CashFlowFrame -> Either String CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (Balance, Date, Maybe Balance) -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame (Balance
cb,Date
asOfDay,Maybe Balance
forall a. Maybe a
Nothing) [TsRow]
futureTxns

-- ^ project cashflow with fix rate portion
projIndexCashflows :: ([Date],[Balance],[Principal],Index,Spread) -> DatePattern -> ([Rate],[Rate],Rate,Int) -> Maybe [RateAssumption] -> Either String CF.CashFlowFrame
projIndexCashflows :: (Dates, [Balance], [Balance], Index, IRate)
-> DatePattern
-> ([Rate], [Rate], Rate, Int)
-> Maybe [RateAssumption]
-> Either String CashFlowFrame
projIndexCashflows (Dates
ds,[Balance]
bals,[Balance]
principals,Index
index,IRate
spd) DatePattern
dp ([Rate], [Rate], Rate, Int)
pAssump (Just [RateAssumption]
ras) = 
  do
    -- mIndexToApply = A.getRateAssumption ras index
    [IRate]
indexRates <- [Either String IRate] -> Either String [IRate]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either String IRate] -> Either String [IRate])
-> [Either String IRate] -> Either String [IRate]
forall a b. (a -> b) -> a -> b
$ [RateAssumption] -> Index -> Date -> Either String IRate
A.lookupRate0 [RateAssumption]
ras Index
index (Date -> Either String IRate) -> Dates -> [Either String IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dates
ds 

    let rates :: [IRate]
rates = (IRate
spd IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+) (IRate -> IRate) -> [IRate] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IRate]
indexRates 
    let interestFlow :: [Balance]
interestFlow = (IRate -> Balance -> Balance) -> [IRate] -> [Balance] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Balance -> IRate -> Balance) -> IRate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> IRate -> Balance
mulBIR) [IRate]
rates [Balance]
bals
    let flowSize :: Int
flowSize = [Balance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Balance]
bals
    let scheduleCf :: CashFlowFrame
scheduleCf = (Balance, Date, Maybe Balance) -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame ([Balance] -> Balance
forall a. HasCallStack => [a] -> a
head [Balance]
bals, Dates -> Date
forall a. HasCallStack => [a] -> a
head Dates
ds, Maybe Balance
forall a. Maybe a
Nothing) ([TsRow] -> CashFlowFrame) -> [TsRow] -> CashFlowFrame
forall a b. (a -> b) -> a -> b
$ 
                                        (Date
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> IRate
 -> Maybe Int
 -> Maybe Balance
 -> Maybe CumulativeStat
 -> TsRow)
-> Dates
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [IRate]
-> [Maybe Int]
-> [Maybe Balance]
-> [Maybe CumulativeStat]
-> [TsRow]
forall a b c d e f g h i j k l m.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
-> [m]
zipWith12 Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe Int
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
MortgageFlow 
                                                  Dates
ds
                                                  [Balance]
bals
                                                  [Balance]
principals
                                                  [Balance]
interestFlow
                                                  (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0 )
                                                  (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0 )
                                                  (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0 )
                                                  (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0 )
                                                  [IRate]
rates
                                                  (Int -> Maybe Int -> [Maybe Int]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe Int
forall a. Maybe a
Nothing)
                                                  (Int -> Maybe Balance -> [Maybe Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe Balance
forall a. Maybe a
Nothing)
                                                  (Int -> Maybe CumulativeStat -> [Maybe CumulativeStat]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe CumulativeStat
forall a. Maybe a
Nothing) 
    (CashFlowFrame, DatePattern)
-> ([Rate], [Rate], Rate, Int)
-> Date
-> Either String CashFlowFrame
projFixCfwithAssumption (CashFlowFrame
scheduleCf, DatePattern
dp) ([Rate], [Rate], Rate, Int)
pAssump (Dates -> Date
forall a. HasCallStack => [a] -> a
head Dates
ds) 
    
-- ^ project cashflow with fix rate portion and floater rate portion
seperateCashflows :: ProjectedCashflow -> Maybe A.AssetPerfAssumption -> Maybe [RateAssumption] -> Either String (CF.CashFlowFrame, [CF.CashFlowFrame])
seperateCashflows :: ProjectedCashflow
-> Maybe AssetPerfAssumption
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, [CashFlowFrame])
seperateCashflows a :: ProjectedCashflow
a@(ProjectedFlowMixFloater pflow :: CashFlowFrame
pflow@(CF.CashFlowFrame (Balance
begBal, Date
begDate, Maybe Balance
accuredInt) [TsRow]
flows) DatePattern
dp (Rate
fixPct,IRate
fixRate) [FloatRatePortion]
floaterList)
                  Maybe AssetPerfAssumption
mPassump
                  Maybe [RateAssumption]
mRates
  = let
        begBal :: Balance
begBal = TsRow -> Balance
CF.mflowBegBalance (TsRow -> Balance) -> TsRow -> Balance
forall a b. (a -> b) -> a -> b
$ [TsRow] -> TsRow
forall a. HasCallStack => [a] -> a
head [TsRow]
flows
        totalBals :: [Balance]
totalBals = Balance
begBalBalance -> [Balance] -> [Balance]
forall a. a -> [a] -> [a]
: ((Getting Balance TsRow Balance -> TsRow -> Balance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Balance TsRow Balance
Lens' TsRow Balance
CF.tsRowBalance) (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows)
        ds :: Dates
ds = (Getting Date TsRow Date -> TsRow -> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Date TsRow Date
Lens' TsRow Date
CF.tsDate) (TsRow -> Date) -> [TsRow] -> Dates
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows
        flowSize :: Int
flowSize = Dates -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Dates
ds
        -- fix rate cashflow
        -- fix balance = total balance * fix percent
        fixedBals :: [Balance]
fixedBals = (Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR Rate
fixPct (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
totalBals
        -- fix principal flow = total principal flow * fix percent
        fixedPrincipalFlow :: [Balance]
fixedPrincipalFlow = (Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR Rate
fixPct (Balance -> Balance) -> (TsRow -> Balance) -> TsRow -> Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TsRow -> Balance
CF.mflowPrincipal (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows
        -- fix principal interest = total principal flow * fix rate
        fixedInterestFlow :: [Balance]
fixedInterestFlow = (Balance -> IRate -> Balance) -> IRate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> IRate -> Balance
mulBIR IRate
fixRate (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
fixedBals
        fixFlow :: [TsRow]
fixFlow = (Date
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> Balance
 -> IRate
 -> Maybe Int
 -> Maybe Balance
 -> Maybe CumulativeStat
 -> TsRow)
-> Dates
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [Balance]
-> [IRate]
-> [Maybe Int]
-> [Maybe Balance]
-> [Maybe CumulativeStat]
-> [TsRow]
forall a b c d e f g h i j k l m.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> m)
-> [a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [f]
-> [g]
-> [h]
-> [i]
-> [j]
-> [k]
-> [l]
-> [m]
zipWith12 Date
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> Balance
-> IRate
-> Maybe Int
-> Maybe Balance
-> Maybe CumulativeStat
-> TsRow
MortgageFlow Dates
ds [Balance]
fixedBals [Balance]
fixedPrincipalFlow [Balance]
fixedInterestFlow (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0) (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0) (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0) (Int -> Balance -> [Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Balance
0) (Int -> IRate -> [IRate]
forall a. Int -> a -> [a]
replicate Int
flowSize IRate
fixRate) (Int -> Maybe Int -> [Maybe Int]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe Int
forall a. Maybe a
Nothing) (Int -> Maybe Balance -> [Maybe Balance]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe Balance
forall a. Maybe a
Nothing) (Int -> Maybe CumulativeStat -> [Maybe CumulativeStat]
forall a. Int -> a -> [a]
replicate Int
flowSize Maybe CumulativeStat
forall a. Maybe a
Nothing)
        -- float rate cashflow
        -- float balance = total balance - fixed balance
        totalFloatBalFlow :: [Balance]
totalFloatBalFlow = (Balance -> Balance -> Balance)
-> [Balance] -> [Balance] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Balance]
totalBals [Balance]
fixedBals
        -- float principal flow = total principal flow - fixed principal flow
        floatPrincipalFlow :: [Balance]
floatPrincipalFlow = (Balance -> Balance -> Balance)
-> [Balance] -> [Balance] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (TsRow -> Balance
CF.mflowPrincipal (TsRow -> Balance) -> [TsRow] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TsRow]
flows) [Balance]
fixedPrincipalFlow
        
        rs :: [Rate]
rs = (\(Rate
a,IRate
b,Index
c) -> Rate
a) (FloatRatePortion -> Rate) -> [FloatRatePortion] -> [Rate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatRatePortion]
floaterList      -- portion of each floater
        spds :: [IRate]
spds = (\(Rate
a,IRate
b,Index
c) -> IRate
b) (FloatRatePortion -> IRate) -> [FloatRatePortion] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatRatePortion]
floaterList    -- spreads
        indexes :: [Index]
indexes = (\(Rate
a,IRate
b,Index
c) -> Index
c) (FloatRatePortion -> Index) -> [FloatRatePortion] -> [Index]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatRatePortion]
floaterList -- indexes
        floaterSize :: Int
floaterSize = [Rate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rate]
rs
        -- float bal brekdown by index
        floatBalsBreakDown :: [[Balance]]
floatBalsBreakDown = (\Rate
r -> (Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR Rate
r (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
totalFloatBalFlow ) (Rate -> [Balance]) -> [Rate] -> [[Balance]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
rs
        -- float principal flow breakdown by index
        floatPrincipalFlowBreakDown :: [[Balance]]
floatPrincipalFlowBreakDown = (\Rate
r -> (Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR Rate
r (Balance -> Balance) -> [Balance] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Balance]
floatPrincipalFlow)  (Rate -> [Balance]) -> [Rate] -> [[Balance]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rate]
rs -- `debug` ("float bal breakdown"++ show floatBalsBreakDown)
        recoveryLag :: Int
recoveryLag = case Maybe AssetPerfAssumption
mPassump of 
                        Maybe AssetPerfAssumption
Nothing -> Int
0 
                        Just AssetPerfAssumption
passump -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ AssetPerfAssumption -> Maybe Int
getRecoveryLagFromAssumption AssetPerfAssumption
passump
        curveDatesLength :: Int
curveDatesLength = [TsRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TsRow]
flows Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
recoveryLag
      in
        do
          ([Rate], [Rate], Rate, Int)
assumptionInput <- case Maybe AssetPerfAssumption
mPassump of 
                              Just AssetPerfAssumption
pAssump -> ProjectedCashflow
-> Dates
-> AssetPerfAssumption
-> Either String ([Rate], [Rate], Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either String ([Rate], [Rate], Rate, Int)
buildAssumptionPpyDefRecRate ProjectedCashflow
a (Date
begDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
ds) AssetPerfAssumption
pAssump 
                              Maybe AssetPerfAssumption
Nothing -> ([Rate], [Rate], Rate, Int)
-> Either String ([Rate], [Rate], Rate, Int)
forall a b. b -> Either a b
Right (Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Rate
0.0, Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
curveDatesLength Rate
0.0, Rate
0.0, Int
0)
          CashFlowFrame
fixedCashFlow <- (CashFlowFrame, DatePattern)
-> ([Rate], [Rate], Rate, Int)
-> Date
-> Either String CashFlowFrame
projFixCfwithAssumption (((Balance, Date, Maybe Balance) -> [TsRow] -> CashFlowFrame
CF.CashFlowFrame ( (((Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR) Rate
fixPct) Balance
begBal
                                                                    , Date
begDate
                                                                    , ((Balance -> Rate -> Balance) -> Rate -> Balance -> Balance
forall a b c. (a -> b -> c) -> b -> a -> c
flip Balance -> Rate -> Balance
mulBR) Rate
fixPct (Balance -> Balance) -> Maybe Balance -> Maybe Balance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Balance
accuredInt)
                                                                   [TsRow]
fixFlow)
                                                , DatePattern
dp) ([Rate], [Rate], Rate, Int)
assumptionInput Date
begDate 
          [CashFlowFrame]
floatedCashFlow <- [Either String CashFlowFrame] -> Either String [CashFlowFrame]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either String CashFlowFrame] -> Either String [CashFlowFrame])
-> [Either String CashFlowFrame] -> Either String [CashFlowFrame]
forall a b. (a -> b) -> a -> b
$ (\(Dates, [Balance], [Balance], Index, IRate)
x -> (Dates, [Balance], [Balance], Index, IRate)
-> DatePattern
-> ([Rate], [Rate], Rate, Int)
-> Maybe [RateAssumption]
-> Either String CashFlowFrame
projIndexCashflows (Dates, [Balance], [Balance], Index, IRate)
x DatePattern
dp ([Rate], [Rate], Rate, Int)
assumptionInput Maybe [RateAssumption]
mRates) ((Dates, [Balance], [Balance], Index, IRate)
 -> Either String CashFlowFrame)
-> [(Dates, [Balance], [Balance], Index, IRate)]
-> [Either String CashFlowFrame]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Dates]
-> [[Balance]]
-> [[Balance]]
-> [Index]
-> [IRate]
-> [(Dates, [Balance], [Balance], Index, IRate)]
forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 
                                                                                              (Int -> Dates -> [Dates]
forall a. Int -> a -> [a]
replicate Int
floaterSize Dates
ds) 
                                                                                              [[Balance]]
floatBalsBreakDown 
                                                                                              [[Balance]]
floatPrincipalFlowBreakDown 
                                                                                              [Index]
indexes
                                                                                              [IRate]
spds
          (CashFlowFrame, [CashFlowFrame])
-> Either String (CashFlowFrame, [CashFlowFrame])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame
fixedCashFlow, [CashFlowFrame]
floatedCashFlow) -- `debug` ("float cf"++ show floatedCashFlow)



instance Ast.Asset ProjectedCashflow where

    getCurrentBal :: ProjectedCashflow -> Balance
getCurrentBal (ProjectedFlowFixed cf :: CashFlowFrame
cf@(CF.CashFlowFrame (Balance
begBal,Date
_,Maybe Balance
_) [TsRow]
_) DatePattern
_) = Balance
begBal
    getCurrentBal (ProjectedFlowMixFloater cf :: CashFlowFrame
cf@(CF.CashFlowFrame (Balance
begBal,Date
_,Maybe Balance
_) [TsRow]
_) DatePattern
_ (Rate, IRate)
_ [FloatRatePortion]
_) = Balance
begBal

    getOriginBal :: ProjectedCashflow -> Balance
getOriginBal ProjectedCashflow
x = ProjectedCashflow -> Balance
forall a. Asset a => a -> Balance
getCurrentBal ProjectedCashflow
x
    getOriginRate :: ProjectedCashflow -> IRate
getOriginRate ProjectedCashflow
x = IRate
0.0

    isDefaulted :: ProjectedCashflow -> Bool
isDefaulted ProjectedCashflow
f = String -> Bool
forall a. HasCallStack => String -> a
error String
""
    getOriginDate :: ProjectedCashflow -> Date
getOriginDate ProjectedCashflow
f = String -> Date
forall a. HasCallStack => String -> a
error String
""
    getOriginInfo :: ProjectedCashflow -> OriginalInfo
getOriginInfo ProjectedCashflow
f = String -> OriginalInfo
forall a. HasCallStack => String -> a
error String
""

    getCurrentRate :: ProjectedCashflow -> IRate
getCurrentRate ProjectedCashflow
f = IRate
0.0

    calcCashflow :: ProjectedCashflow
-> Date -> Maybe [RateAssumption] -> Either String CashFlowFrame
calcCashflow f :: ProjectedCashflow
f@(ProjectedFlowFixed CashFlowFrame
cf DatePattern
_) Date
d Maybe [RateAssumption]
_ = CashFlowFrame -> Either String CashFlowFrame
forall a b. b -> Either a b
Right (CashFlowFrame -> Either String CashFlowFrame)
-> CashFlowFrame -> Either String CashFlowFrame
forall a b. (a -> b) -> a -> b
$ CashFlowFrame
cf

    calcCashflow f :: ProjectedCashflow
f@(ProjectedFlowMixFloater CashFlowFrame
cf DatePattern
_ (Rate, IRate)
fxPortion [FloatRatePortion]
floatPortion) Date
d Maybe [RateAssumption]
mRate
      = do
          (CashFlowFrame
fixedCashFlow, [CashFlowFrame]
floatedCashFlow) <- ProjectedCashflow
-> Maybe AssetPerfAssumption
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, [CashFlowFrame])
seperateCashflows ProjectedCashflow
f Maybe AssetPerfAssumption
forall a. Maybe a
Nothing Maybe [RateAssumption]
mRate   -- `debug` ("running fixed cashflow"++show fixedCashFlow)
          CashFlowFrame -> Either String CashFlowFrame
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame -> Either String CashFlowFrame)
-> CashFlowFrame -> Either String CashFlowFrame
forall a b. (a -> b) -> a -> b
$ (CashFlowFrame -> CashFlowFrame -> CashFlowFrame)
-> CashFlowFrame -> [CashFlowFrame] -> CashFlowFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CashFlowFrame -> CashFlowFrame -> CashFlowFrame
CF.combine CashFlowFrame
fixedCashFlow [CashFlowFrame]
floatedCashFlow

    projCashflow :: ProjectedCashflow
-> Date
-> AssetPerf
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, Map CutoffFields Balance)
projCashflow f :: ProjectedCashflow
f@(ProjectedFlowFixed CashFlowFrame
cf DatePattern
dp) Date
asOfDay (AssetPerfAssumption
pAssump,AssetDelinqPerfAssumption
_,AssetDefaultedPerfAssumption
_) Maybe [RateAssumption]
mRates 
      = do 
          let cfDates :: Dates
cfDates = CashFlowFrame -> Dates
CF.getDatesCashFlowFrame CashFlowFrame
cf
          let begDate :: Date
begDate = Getting Date CashFlowFrame Date -> CashFlowFrame -> Date
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (((Balance, Date, Maybe Balance)
 -> Const Date (Balance, Date, Maybe Balance))
-> CashFlowFrame -> Const Date CashFlowFrame
Lens' CashFlowFrame (Balance, Date, Maybe Balance)
CF.cfBeginStatus (((Balance, Date, Maybe Balance)
  -> Const Date (Balance, Date, Maybe Balance))
 -> CashFlowFrame -> Const Date CashFlowFrame)
-> ((Date -> Const Date Date)
    -> (Balance, Date, Maybe Balance)
    -> Const Date (Balance, Date, Maybe Balance))
-> Getting Date CashFlowFrame Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Date -> Const Date Date)
-> (Balance, Date, Maybe Balance)
-> Const Date (Balance, Date, Maybe Balance)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Balance, Date, Maybe Balance)
  (Balance, Date, Maybe Balance)
  Date
  Date
_2) CashFlowFrame
cf
          ([Rate], [Rate], Rate, Int)
pRates <- ProjectedCashflow
-> Dates
-> AssetPerfAssumption
-> Either String ([Rate], [Rate], Rate, Int)
forall a.
Asset a =>
a
-> Dates
-> AssetPerfAssumption
-> Either String ([Rate], [Rate], Rate, Int)
buildAssumptionPpyDefRecRate ProjectedCashflow
f (Date
begDateDate -> Dates -> Dates
forall a. a -> [a] -> [a]
:Dates
cfDates) AssetPerfAssumption
pAssump 
          CashFlowFrame
p <- (CashFlowFrame, DatePattern)
-> ([Rate], [Rate], Rate, Int)
-> Date
-> Either String CashFlowFrame
projFixCfwithAssumption (CashFlowFrame
cf, DatePattern
dp) ([Rate], [Rate], Rate, Int)
pRates Date
asOfDay
          (CashFlowFrame, Map CutoffFields Balance)
-> Either String (CashFlowFrame, Map CutoffFields Balance)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (CashFlowFrame
p, Map CutoffFields Balance
forall k a. Map k a
Map.empty)

    projCashflow ProjectedCashflow
f Date
asOfDay (AssetPerfAssumption
pAssump, AssetDelinqPerfAssumption
_, AssetDefaultedPerfAssumption
_) Maybe [RateAssumption]
mRates
      = do
          (CashFlowFrame
fixedCashFlow, [CashFlowFrame]
floatedCashFlow) <- ProjectedCashflow
-> Maybe AssetPerfAssumption
-> Maybe [RateAssumption]
-> Either String (CashFlowFrame, [CashFlowFrame])
seperateCashflows ProjectedCashflow
f (AssetPerfAssumption -> Maybe AssetPerfAssumption
forall a. a -> Maybe a
Just AssetPerfAssumption
pAssump) Maybe [RateAssumption]
mRates
          (CashFlowFrame, Map CutoffFields Balance)
-> Either String (CashFlowFrame, Map CutoffFields Balance)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CashFlowFrame, Map CutoffFields Balance)
 -> Either String (CashFlowFrame, Map CutoffFields Balance))
-> (CashFlowFrame, Map CutoffFields Balance)
-> Either String (CashFlowFrame, Map CutoffFields Balance)
forall a b. (a -> b) -> a -> b
$ ((CashFlowFrame -> CashFlowFrame -> CashFlowFrame)
-> CashFlowFrame -> [CashFlowFrame] -> CashFlowFrame
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl CashFlowFrame -> CashFlowFrame -> CashFlowFrame
CF.combine CashFlowFrame
fixedCashFlow [CashFlowFrame]
floatedCashFlow, Map CutoffFields Balance
forall k a. Map k a
Map.empty)
          --(fixedCashFlow, Map.empty)

    projCashflow ProjectedCashflow
a Date
b AssetPerf
c Maybe [RateAssumption]
d = String -> Either String (CashFlowFrame, Map CutoffFields Balance)
forall a b. a -> Either a b
Left (String -> Either String (CashFlowFrame, Map CutoffFields Balance))
-> String
-> Either String (CashFlowFrame, Map CutoffFields Balance)
forall a b. (a -> b) -> a -> b
$ String
"Failed to match when proj projected flow with assumption >>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ProjectedCashflow -> String
forall a. Show a => a -> String
show ProjectedCashflow
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ Date -> String
forall a. Show a => a -> String
show Date
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ AssetPerf -> String
forall a. Show a => a -> String
show AssetPerf
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe [RateAssumption] -> String
forall a. Show a => a -> String
show Maybe [RateAssumption]
d
    
    getBorrowerNum :: ProjectedCashflow -> Int
getBorrowerNum ProjectedCashflow
f = Int
0

    splitWith :: ProjectedCashflow -> [Rate] -> [ProjectedCashflow]
splitWith ProjectedCashflow
f [Rate]
rs = [ProjectedCashflow
f]

-- instance IR.UseRate ProjectedCashflow where 
--       isAdjustbleRate _ = False
--       getIndex _ = Nothing
--       getIndexes _ = Nothing