From b8eba42f772b0dfc3eecc7160df3b24a231a5bf7 Mon Sep 17 00:00:00 2001 From: Shawn Zhang Date: Thu, 12 Oct 2023 13:44:46 +0800 Subject: [PATCH] Pre 0.21.x (#90) * seperate assump by status * deprecate on fee due on end of collection * implement haircut * add new query on deal status * missing asset stats to pool level stats * include missing-stats when project cashflow * fix rate use * fix rate adjust reset dates for bonds * include st change on closing date * fix query on origin pool balance logic * create a new DateUtil ns * Fix delinq cf back to performing status * use current rate to start for fixed rate asset * support mix of dlinq mortgage flow with mortgage flow * update borrower num * bump version to-> < 0.21.9 > --------- Co-authored-by: yellowbean --- .../.cache/v1/cljs/agency.config.transit.json | 1 + .../.cache/v1/cljs/agency.core.transit.json | 1 + .../.cache/v1/cljs/agency.db.transit.json | 1 + .../.cache/v1/cljs/agency.views.transit.json | 1 + .../v1/cljs/structuring.views.transit.json | 1 + .clj-kondo/.cache/v1/lock | 0 .lsp/.cache/db.transit.json | 1 + ChangeLog.md | 14 +- Hastructure.cabal | 1 + Hastructure.code-workspace | 36 ++ README.md | 16 +- app/Main.hs | 39 ++- config.yml | 4 +- ghcid.txt | 27 ++ publish.sh | 2 + src/Accounts.hs | 21 +- src/Analytics.hs | 1 + src/Asset.hs | 51 ++- src/AssetClass/Installment.hs | 1 + src/AssetClass/Lease.hs | 1 + src/AssetClass/Loan.hs | 1 + src/AssetClass/Mortgage.hs | 198 ++++++----- src/Assumptions.hs | 17 +- src/Cashflow.hs | 330 +++++++++++------- src/CreditEnhancement.hs | 1 + src/DateUtil.hs | 306 ++++++++++++++++ src/Deal.hs | 45 ++- src/Deal/DealAction.hs | 65 +++- src/Deal/DealBase.hs | 38 +- src/Deal/DealQuery.hs | 17 +- src/Expense.hs | 1 + src/Hastructure.code-workspace | 13 + src/Hedge.hs | 1 + src/InterestRate.hs | 1 + src/Liability.hs | 1 + src/Reports.hs | 10 +- src/Stmt.hs | 2 +- src/Types.hs | 17 +- src/Util.hs | 290 +-------------- swagger.json | 105 +++++- test/MainTest.hs | 1 + test/UT/AccountTest.hs | 11 +- test/UT/AssetTest.hs | 82 +++-- test/UT/CashflowTest.hs | 155 +++++--- test/UT/DealTest.hs | 12 +- test/UT/QueryTest.hs | 8 +- test/UT/UtilTest.hs | 1 + wreq.png | Bin 0 -> 4467 bytes 48 files changed, 1222 insertions(+), 727 deletions(-) create mode 100644 .clj-kondo/.cache/v1/cljs/agency.config.transit.json create mode 100644 .clj-kondo/.cache/v1/cljs/agency.core.transit.json create mode 100644 .clj-kondo/.cache/v1/cljs/agency.db.transit.json create mode 100644 .clj-kondo/.cache/v1/cljs/agency.views.transit.json create mode 100644 .clj-kondo/.cache/v1/cljs/structuring.views.transit.json create mode 100644 .clj-kondo/.cache/v1/lock create mode 100644 .lsp/.cache/db.transit.json create mode 100644 Hastructure.code-workspace create mode 100644 ghcid.txt create mode 100644 src/DateUtil.hs create mode 100644 src/Hastructure.code-workspace create mode 100644 wreq.png diff --git a/.clj-kondo/.cache/v1/cljs/agency.config.transit.json b/.clj-kondo/.cache/v1/cljs/agency.config.transit.json new file mode 100644 index 00000000..b632ab18 --- /dev/null +++ b/.clj-kondo/.cache/v1/cljs/agency.config.transit.json @@ -0,0 +1 @@ +["^ ","~$debug?",["^ ","~:row",3,"~:col",1,"~:name","^0","~:ns","~$agency.config","~:top-ns","^5"],"~:filename","/Users/xiaoyu/Projects/absbox.work/agency/src/agency/config.cljs"] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/cljs/agency.core.transit.json b/.clj-kondo/.cache/v1/cljs/agency.core.transit.json new file mode 100644 index 00000000..c8c42f30 --- /dev/null +++ b/.clj-kondo/.cache/v1/cljs/agency.core.transit.json @@ -0,0 +1 @@ +["^ ","~$dev-setup",["^ ","~:row",11,"~:col",1,"~:fixed-arities",["~#set",[0]],"~:name","^0","~:ns","~$agency.core","~:top-ns","^7","~:arities",["^ ","~i0",["^ ","~:ret",["^4",["~:nil"]],"~:arglist-str","[]"]],"~:type","~:fn"],"~$mount-root",["^ ","^1",15,"^2",1,"^3",["^4",[0]],"^5","^?","^6","^7","^8","^7","^=","^>"],"~$init",["^ ","^1",21,"^2",1,"^3",["^4",[0]],"^5","^@","^6","^7","^8","^7","^=","^>"],"~:filename","/Users/xiaoyu/Projects/absbox.work/agency/src/agency/core.cljs"] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/cljs/agency.db.transit.json b/.clj-kondo/.cache/v1/cljs/agency.db.transit.json new file mode 100644 index 00000000..6be1e3a7 --- /dev/null +++ b/.clj-kondo/.cache/v1/cljs/agency.db.transit.json @@ -0,0 +1 @@ +["^ ","~$default-db",["^ ","~:row",3,"~:col",1,"~:name","^0","~:ns","~$agency.db","~:top-ns","^5","~:type",["^ ","^7","~:map","~:val",["^ ","^3",["^ ","^1",4,"^2",10,"~:end-row",4,"~:end-col",20,"~:tag","~:string"]]]],"~:filename","/Users/xiaoyu/Projects/absbox.work/agency/src/agency/db.cljs"] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/cljs/agency.views.transit.json b/.clj-kondo/.cache/v1/cljs/agency.views.transit.json new file mode 100644 index 00000000..b0074b95 --- /dev/null +++ b/.clj-kondo/.cache/v1/cljs/agency.views.transit.json @@ -0,0 +1 @@ +["^ ","~$main-panel",["^ ","~:row",6,"~:col",1,"~:fixed-arities",["~#set",[0]],"~:name","^0","~:ns","~$agency.views","~:top-ns","^7","~:arities",["^ ","~i0",["^ ","~:ret","~:vector","~:arglist-str","[]"]],"~:type","~:fn"],"~:filename","/Users/xiaoyu/Projects/absbox.work/agency/src/agency/views.cljs"] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/cljs/structuring.views.transit.json b/.clj-kondo/.cache/v1/cljs/structuring.views.transit.json new file mode 100644 index 00000000..d04da446 --- /dev/null +++ b/.clj-kondo/.cache/v1/cljs/structuring.views.transit.json @@ -0,0 +1 @@ +["^ ","~$get-values-from-list",["^ ","~:row",65,"~:col",1,"~:fixed-arities",["~#set",[1]],"~:name","^0","~:ns","~$structuring.views","~:top-ns","^7","~:arities",["^ ","~i1",["^ ","~:ret","~:seq","~:arglist-str","[x]"]],"~:type","~:fn"],"~$bond-editor",["^ ","^1",510,"^2",1,"^3",["^4",[1]],"^5","^?","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","~:vector","^<","[x]"]],"^=","^>"],"~$dropdown-options",["^ ","^1",19,"^2",1,"^3",["^4",[1,2]],"^5","^A","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"],"~i2",["^ ","^:","^@","^<","[xs default]"]],"^=","^>"],"~$to-keywords",["^ ","^1",68,"^2",1,"^3",["^4",[1]],"^5","^B","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^;","^<","[x]"]],"^=","^>"],"~$add-evt",["^ ","^1",108,"^2",1,"^3",["^4",[5]],"^5","^C","^6","^7","^8","^7","^=","^>"],"~$comp-call",["^ ","^1",480,"^2",1,"^3",["^4",[0]],"^5","^D","^6","^7","^8","^7","^=","^>"],"~$main-panel",["^ ","^1",626,"^2",1,"^3",["^4",[0]],"^5","^E","^6","^7","^8","^7","^9",["^ ","~i0",["^ ","^:","^@","^<","[]"]],"^=","^>"],"~$stmtView",["^ ","^1",587,"^2",1,"^3",["^4",[2]],"^5","^F","^6","^7","^8","^7","^=","^>"],"~$comp-pool",["^ ","^1",261,"^2",1,"^3",["^4",[1]],"^5","^G","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"]],"^=","^>"],"~$wrap-on-change",["^ ","^1",71,"^2",1,"^3",["^4",[4]],"^5","^H","^6","^7","^8","^7","^=","^>"],"~$checkbox-shape?",["^ ","^1",60,"^2",1,"^3",["^4",[1]],"^5","^I","^6","^7","^8","^7","^=","^>"],"~$deal-run-result-comp",["^ ","^1",592,"^2",1,"^3",["^4",[0]],"^5","^J","^6","^7","^8","^7","^=","^>"],"~$comp-fees",["^ ","^1",282,"^2",1,"^3",["^4",[1]],"^5","^K","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"]],"^=","^>"],"~$pool-editor",["^ ","^1",570,"^2",1,"^3",["^4",[1]],"^5","^L","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~$build-bond",["^ ","^3",["^4",[4]],"~:private",true,"^6","^7","^5","^M","^=","^>","^2",1,"^8","^7","^1",407],"~$render-notice",["^ ","^1",618,"^2",1,"^3",["^4",[1]],"^5","^O","^6","^7","^8","^7","^=","^>"],"~$palette",["^ ","^1",130,"^2",1,"^3",["^4",[1]],"^5","^P","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~:filename","/Users/xiaoyu/Projects/absbox.work/deal-bench/src/structuring/views.cljs","~$input-builder",["^ ","^1",183,"^2",1,"^3",["^4",[1]],"^5","^R","^6","^7","^8","^7","^=","^>"],"~$fee-editor",["^ ","^1",525,"^2",1,"^3",["^4",[1]],"^5","^S","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~$wrap-on-change2",["^ ","^1",47,"^2",1,"^3",["^4",[4]],"^5","^T","^6","^7","^8","^7","^9",["^ ","~i4",["^ ","^:","^@","^<","[tag evt-name params tf]"]],"^=","^>"],"~$comp-waterfall",["^ ","^1",343,"^2",1,"^3",["^4",[1]],"^5","^U","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"]],"^=","^>"],"~$comp-bonds",["^ ","^1",422,"^2",1,"^3",["^4",[1]],"^5","^V","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"]],"^=","^>"],"~$dispatch-to",["^ ","^1",125,"^2",1,"^3",["^4",[1]],"^5","^W","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^>","^<","[dispatch-path]"]],"^=","^>"],"~$-build-input",["^ ","^1",489,"^2",1,"^3",["^4",[3]],"^5","^X","^6","^7","^8","^7","^=","^>"],"~$waterfall-editor",["^ ","^1",555,"^2",1,"^3",["^4",[1]],"^5","^Y","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~$checkbox-options",["^ ","^1",33,"^2",1,"^3",["^4",[1,2]],"^5","^Z","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"],"~i2",["^ ","^:","^@","^<","[xs selected]"]],"^=","^>"],"~$account-editor",["^ ","^1",540,"^2",1,"^3",["^4",[1]],"^5","^[","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~$comp-options",["^ ","^1",459,"^2",1,"^3",["^4",[0]],"^5","^10","^6","^7","^8","^7","^=","^>"],"~$comp-accounts",["^ ","^1",306,"^2",1,"^3",["^4",[1]],"^5","^11","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[xs]"]],"^=","^>"],"~$deal-edit",["^ ","^1",580,"^2",1,"^3",["^4",[1]],"^5","^12","^6","^7","^8","^7","^9",["^ ","~i1",["^ ","^:","^@","^<","[x]"]],"^=","^>"],"~$call-assump-comp",["^ ","^1",141,"^2",1,"^3",["^4",[2]],"^5","^13","^6","^7","^8","^7","^9",["^ ","~i2",["^ ","^:","^@","^<","[opts p]"]],"^=","^>"],"~$comp-assump",["^ ","^1",190,"^2",1,"^3",["^4",[0]],"^5","^14","^6","^7","^8","^7","^9",["^ ","~i0",["^ ","^:","^@","^<","[]"]],"^=","^>"],"~$comp-dates",["^ ","^1",170,"^2",1,"^3",["^4",[1]],"^5","^15","^6","^7","^8","^7","^=","^>"],"~$-convert",["^ ","^1",120,"^2",1,"^3",["^4",[1]],"^5","^16","^6","^7","^8","^7","^=","^>"]] \ No newline at end of file diff --git a/.clj-kondo/.cache/v1/lock b/.clj-kondo/.cache/v1/lock new file mode 100644 index 00000000..e69de29b diff --git a/.lsp/.cache/db.transit.json b/.lsp/.cache/db.transit.json new file mode 100644 index 00000000..b68aed83 --- /dev/null +++ b/.lsp/.cache/db.transit.json @@ -0,0 +1 @@ +["^ ","~:classpath",["~#set",[]],"~:project-hash","","~:project-root","/Users/xiaoyu/Projects/Hastructure","~:kondo-config-hash","8130318a7ed6c88a5f0fea1e88da4b97f2ce388a2115384ee7ff0112aa12c899","~:dependency-scheme","jar","~:analysis",null,"~:analysis-checksums",["^ "],"~:project-analysis-type","~:project-and-full-dependencies","~:version",11,"~:stubs-generation-namespaces",["^1",[]]] \ No newline at end of file diff --git a/ChangeLog.md b/ChangeLog.md index 3164fe0b..1d312d3f 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,12 +1,24 @@ # Changelog for Hastructure +## 0.21.5 +### 2023-10-8 +* ENHANCE: in the revolving buy , now buy amount is no longer a multipler of revolving assets face value +* FIX: now revolving asset may have remtain term == original term + +## 0.21.4 +### 2023-9-27 +* ENHANCE: require a new status when defining a deal in `preClosing` stage +* FIX: fix a bug when reading financial report logs + + ## 0.21.3 ### 2023-9-26 -* NEW: include a default/delinq/loss status map when projecting cashflow +* NEW: include a `default`/`delinq`/`loss` status map when projecting cashflow * NEW: implement `haircut` as extra stress projecting `mortgage` * ENHANCE: include `called` deal status, which will be set when deal was triggered with a clean up call assumption * ENHANCE: expose `runAsset` endpoint * ENHANCE: expose formula query on `deal status` as well as `trigger status` +* ENHANCE: add `rampUp` deal status * FIX: adjust bond reset date from `cutoff date` to `closing date` ## 0.21.1 diff --git a/Hastructure.cabal b/Hastructure.cabal index ed8cb1e0..b347fa02 100644 --- a/Hastructure.cabal +++ b/Hastructure.cabal @@ -38,6 +38,7 @@ library Call Cashflow CreditEnhancement + DateUtil Deal Deal.DealAction Deal.DealBase diff --git a/Hastructure.code-workspace b/Hastructure.code-workspace new file mode 100644 index 00000000..654a402e --- /dev/null +++ b/Hastructure.code-workspace @@ -0,0 +1,36 @@ +{ + "folders": [ + { + "path": "." + }, + { + "path": "../PyABS" + }, + { + "path": "../pyabs-doc" + }, + { + "path": "../absbox-doc" + }, + { + "path": "../absbox.work" + }, + { + "path": "../absbox.org" + } + ], + "settings": { + "esbonio.sphinx.confDir": "", + "sqltools.connections": [ + { + "previewLimit": 50, + "driver": "SQLite", + "name": "a", + "database": "${workspaceFolder:absbox.work}/data/chinabond/DB.db" + } + ], + "files.exclude": { + "**/.ipynb": true + } + } +} \ No newline at end of file diff --git a/README.md b/README.md index 084834dc..af03b21a 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,25 @@ [![Actions Status](https://github.com/yellowbean/Hastructure/workflows/Haskell%20CI/badge.svg)](https://github.com/yellowbean/Hastructure/actions) [![Docker Build](https://img.shields.io/docker/v/yellowbean/hastructure?color=green&label=docker)](https://hub.docker.com/r/yellowbean/hastructure) +# What is Hastructure ? + +``Hastructure`` names after ``Haskell`` and ``Structured Finance``, aims to provide cashflow projection for deal/transactions describled in either Haskell structure or ``JSON`` via REST Service, with inputs: + +* deal components (bonds,assets,accounts,waterfall,trigger,fees etc.) +* pool performance prediction input as well as interest rate assumption + +the engine will yields outputs: + +* cashflow of bonds/accounts/fees +* pricing of bonds +* or other outputs make your lose all of the money faster :sunglasses: + # Why Hastructure ? -* :dollar: A structured finance cashflow engine written in Haskell * :coffee: Easy integration with Java/C#/C++/JavaScript/Python with RESTful interface and Docker image ready * :bricks: A building block engine to model cashflows of structured product, all the formula and variables are exposed. * :car: In-house and white-label friendly. * :flags: No lock-in risk, all JSONs input/output, no proprietary file formats. -* :snake: [Python wrapper](https://github.com/yellowbean/PyABS) on the way +* :snake: [Python wrapper](https://github.com/yellowbean/PyABS) is in ``Beta`` now ! ### Features * Integration diff --git a/app/Main.hs b/app/Main.hs index 9fabb0b1..4d721280 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Main where @@ -30,7 +31,7 @@ import qualified Data.Text as T --import Data.Swagger import Data.Maybe import Data.Yaml as Y -import Data.OpenApi hiding (Server) +import Data.OpenApi hiding (Server,contentType) import qualified Data.Map as Map import Data.String.Conversions import Data.Time.Calendar @@ -41,7 +42,7 @@ import qualified Data.ByteString.Char8 as BS import Lucid hiding (type_) import Network.Wai import Network.Wai.Handler.Warp -import Network.Wai.Middleware.Servant.Errors (errorMwDefJson, HasErrorBody(..)) +import Network.Wai.Middleware.Servant.Errors (errorMw, HasErrorBody(..),errorMwDefJson) import qualified Data.Aeson.Parser import Language.Haskell.TH @@ -49,6 +50,7 @@ import Language.Haskell.TH import Servant.OpenApi import Servant import Servant.Types.SourceT (source) +import Servant.API.ContentTypes (contentType) import Types import qualified Deal as D @@ -76,6 +78,7 @@ import qualified Triggers as TRG import qualified Revolving as RV import qualified Lib import qualified Util as U +import qualified DateUtil as DU import Debug.Trace @@ -89,7 +92,7 @@ $(deriveJSON defaultOptions ''Version) instance ToSchema Version version1 :: Version -version1 = Version "0.21.3" +version1 = Version "0.21.9" data PoolType = MPool (P.Pool AB.Mortgage) | LPool (P.Pool AB.Loan) @@ -331,15 +334,40 @@ myServer = return engineSwagger runMultiDeals (MultiDealRunReq mDts assump nonPerfAssump) = return $ Map.map (\singleDealType -> wrapRun singleDealType assump nonPerfAssump) mDts runDate (RunDateReq sd dp) - = return $ U.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") + = return $ DU.genSerialDatesTill2 IE sd dp (Lib.toDate "20990101") writeSwaggerJSON :: IO () writeSwaggerJSON = BL8.writeFile "swagger.json" (encodePretty engineSwagger) -data Config = Config { port :: Int} deriving (Show,Generic) +data Config = Config { port :: Int} + deriving (Show,Generic) + instance FromJSON Config +-- data Ctyp a +-- +-- {- +-- if you are using GHC 8.6 and above you can make use of deriving Via +-- for creating the Accept Instance +-- +-- >> data Ctyp a +-- >> deriving Accept via JSON +-- -} +-- +-- instance Accept (Ctyp JSON) where +-- contentType _ = contentType (Proxy @JSON) +-- +-- instance HasErrorBody (Ctyp JSON) '[] where +-- encodeError = undefined -- write your custom implementation +-- +-- -- | Example Middleware with a different 'HasErrorBody' instance for JSON +-- errorMwJson :: Application -> Application +-- errorMwJson = errorMw @(Ctyp JSON) @'[] + +--instance HasErrorBody (Ctyp JSON) '["error","warning","resp"] where +-- encodeError = error + main :: IO () main = do @@ -350,6 +378,7 @@ main = Left exp -> Config 8081 Right c -> c run _p + -- $ errorMwJson @JSON @'["error","warning","status"] $ errorMwDefJson $ serve (Proxy :: Proxy API) myServer diff --git a/config.yml b/config.yml index 715b41c6..fbfccd4a 100644 --- a/config.yml +++ b/config.yml @@ -1 +1,3 @@ -port: 8081 \ No newline at end of file +port: 8081 +maxScenario : 10 +maxDealNum : 10 \ No newline at end of file diff --git a/ghcid.txt b/ghcid.txt new file mode 100644 index 00000000..4daff468 --- /dev/null +++ b/ghcid.txt @@ -0,0 +1,27 @@ +/Users/xiaoyu/Projects/Hastructure/src/AssetClass/Loan.hs:86:10-19: warning: [-Wmissing-methods] + • No explicit implementation for + ‘getBorrowerNum’ + • In the instance declaration for ‘Asset Loan’ + | +86 | instance Asset Loan where + | ^^^^^^^^^^ +/Users/xiaoyu/Projects/Hastructure/src/AssetClass/Lease.hs:166:10-20: warning: [-Wmissing-methods] + • No explicit implementation for + ‘getBorrowerNum’ + • In the instance declaration for ‘Asset Lease’ + | +166 | instance Asset Lease where + | ^^^^^^^^^^^ +/Users/xiaoyu/Projects/Hastructure/src/AssetClass/Installment.hs:102:10-26: warning: [-Wmissing-methods] + • No explicit implementation for + ‘getBorrowerNum’ + • In the instance declaration for ‘Asset Installment’ + | +102 | instance Asset Installment where + | ^^^^^^^^^^^^^^^^^ +/Users/xiaoyu/Projects/Hastructure/src/Deal.hs:966:10-64: warning: [-Woverlapping-patterns] + Pattern match is redundant + In a case alternative: _ -> ... + | +966 | _ -> error $ "Failed to match action on Date"++ show ad + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/publish.sh b/publish.sh index 46553bfe..4dfb2a69 100755 --- a/publish.sh +++ b/publish.sh @@ -34,6 +34,8 @@ fi echo " Tagging" git add app/Main.hs git add swagger.json +git add Hastructure.cabal +git add ChangeLog.md git commit -m "bump version to-> < $2 >" git tag -a $1$2 -m "$3" diff --git a/src/Accounts.hs b/src/Accounts.hs index 2c33ac3d..c4cf230e 100644 --- a/src/Accounts.hs +++ b/src/Accounts.hs @@ -12,6 +12,7 @@ import Stmt (Statement(..),appendStmt,Txn(..),getTxnBegBalance,getDate import Types import Lib import Util +import DateUtil import Data.Aeson hiding (json) import Language.Haskell.TH import Data.Aeson.TH @@ -22,7 +23,7 @@ import Debug.Trace debug = flip trace data InterestInfo = BankAccount IRate Date DatePattern -- ^ fix reinvest return rate - | InvestmentAccount Index Spread Date DatePattern -- ^ float reinvest return rate + | InvestmentAccount Index Spread Date DatePattern -- ^ float reinvest return rate (index,spread, dp) deriving (Show, Generic) data ReserveAmount = PctReserve DealStats Rate -- ^ target amount with reference to % of formula @@ -81,16 +82,14 @@ depositIntByCurve a@(Account bal _ (Just (InvestmentAccount idx spd lastCollectD rc ed = a {accBalance = newBal - ,accStmt= new_stmt + ,accStmt= newStmt ,accInterest = Just (InvestmentAccount idx spd ed dp)} where - accrued_int = case stmt of + accruedInt = case stmt of Nothing -> let curve_ds = [lastCollectDate] ++ subDates EE lastCollectDate ed (getTsDates rc) ++ [ed] - curve_vs = map - (\x -> toRational (getValByDate rc Exc x) + toRational spd) - (init curve_ds) + curve_vs = (\x -> toRational (getValByDate rc Exc x) + toRational spd) <$> (init curve_ds) ds_factor = getIntervalFactors curve_ds weightInt = sum $ zipWith (*) curve_vs ds_factor -- `debug` ("ds"++show curve_ds++"vs"++show curve_vs++"factors"++show ds_factor) in @@ -98,16 +97,14 @@ depositIntByCurve a@(Account bal _ (Just (InvestmentAccount idx spd lastCollectD Just (Statement _txns) -> let curve_ds = [lastCollectDate] ++ subDates EE lastCollectDate ed (getTsDates rc) ++ [ed] - curve_vs = map - (\x -> toRational (getValByDate rc Exc x) + toRational spd) - (init curve_ds) + curve_vs = (\x -> toRational (getValByDate rc Exc x) + toRational spd) <$> (init curve_ds) bals = weightAvgBalanceByDates curve_ds _txns in sum $ zipWith mulBR bals curve_vs -- `debug` ("cds"++show curve_ds++"vs"++ show curve_vs++"bs"++show bals) - newBal = accrued_int + bal - new_txn = AccTxn ed newBal accrued_int BankInt - new_stmt = appendStmt stmt new_txn + newBal = accruedInt + bal + newTxn = AccTxn ed newBal accruedInt BankInt + newStmt = appendStmt stmt newTxn -- | move cash from account A to account B diff --git a/src/Analytics.hs b/src/Analytics.hs index a918dfb6..77de89f7 100644 --- a/src/Analytics.hs +++ b/src/Analytics.hs @@ -8,6 +8,7 @@ module Analytics (calcDuration,pv,calcWAL,pv2,pv3) import Types import Lib import Util +import DateUtil import Data.Aeson hiding (json) import Language.Haskell.TH import Data.Aeson.TH diff --git a/src/Asset.hs b/src/Asset.hs index 54a12183..5637361d 100644 --- a/src/Asset.hs +++ b/src/Asset.hs @@ -78,7 +78,7 @@ class Show a => Asset a where calcAlignDate ast d = let payDates = getPaymentDates ast 0 remainTerms = getRemainTerms ast - benchDate = (reverse payDates)!!remainTerms --TODO 24/24 raises error + benchDate = (reverse payDates)!!(pred remainTerms) -- `debug` ("\nPayDates"++show payDates++"\nremain terms"++ show remainTerms) offset = daysBetween benchDate d in T.addDays offset $ getOriginDate ast @@ -92,7 +92,7 @@ data Pool a = Pool {assets :: [a] -- ^ ,asOfDate :: Date -- ^ include cashflow after this date ,issuanceStat :: Maybe (Map.Map CutoffFields Balance) -- ^ cutoff balance of pool ,extendPeriods :: Maybe DatePattern -- ^ dates for extend pool collection - }deriving (Show,Generic) + } deriving (Show,Generic) -- | get stats of pool getIssuanceField :: Pool a -> CutoffFields -> Centi @@ -141,21 +141,38 @@ applyHaircut (Just ExtraStress{A.poolHairCut = Just haircuts}) (CF.CashFlowFrame (applyHaircutTxn <$> haircuts) ) <$> txns where applyHaircutTxn (CollectedInterest,r) - (CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) - = CF.MortgageFlow d bal prin (mulBR interest (1-r)) ppy delinq def recovery loss irate mbn mppn + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) + = CF.MortgageDelinqFlow d bal prin (mulBR interest (1-r)) ppy delinq def recovery loss irate mbn mppn applyHaircutTxn (CollectedPrincipal,r) - (CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) - = CF.MortgageFlow d bal (mulBR prin (1-r)) interest ppy delinq def recovery loss irate mbn mppn + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) + = CF.MortgageDelinqFlow d bal (mulBR prin (1-r)) interest ppy delinq def recovery loss irate mbn mppn applyHaircutTxn (CollectedRecoveries,r) - (CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) - = CF.MortgageFlow d bal prin interest ppy delinq def (mulBR recovery (1-r)) loss irate mbn mppn + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) + = CF.MortgageDelinqFlow d bal prin interest ppy delinq def (mulBR recovery (1-r)) loss irate mbn mppn applyHaircutTxn (CollectedPrepayment,r) - (CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) - = CF.MortgageFlow d bal prin interest (mulBR ppy (1-r)) delinq def recovery loss irate mbn mppn + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) + = CF.MortgageDelinqFlow d bal prin interest (mulBR ppy (1-r)) delinq def recovery loss irate mbn mppn applyHaircutTxn (CollectedPrepaymentPenalty,r) - (CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) - = CF.MortgageFlow d bal prin interest ppy delinq def recovery loss irate mbn ((\x -> mulBR x (1-r) ) <$> mppn) - applyHaircutTxn x y = y + (CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn mppn) + = CF.MortgageDelinqFlow d bal prin interest ppy delinq def recovery loss irate mbn ((\x -> mulBR x (1-r) ) <$> mppn) + + applyHaircutTxn (CollectedInterest,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn) + = CF.MortgageFlow d bal prin (mulBR interest (1-r)) ppy def recovery loss irate mbn mppn + applyHaircutTxn (CollectedPrincipal,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn) + = CF.MortgageFlow d bal (mulBR prin (1-r)) interest ppy def recovery loss irate mbn mppn + applyHaircutTxn (CollectedRecoveries,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn) + = CF.MortgageFlow d bal prin interest ppy def (mulBR recovery (1-r)) loss irate mbn mppn + applyHaircutTxn (CollectedPrepayment,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn) + = CF.MortgageFlow d bal prin interest (mulBR ppy (1-r)) def recovery loss irate mbn mppn + applyHaircutTxn (CollectedPrepaymentPenalty,r) + (CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn mppn) + = CF.MortgageFlow d bal prin interest ppy def recovery loss irate mbn ((\x -> mulBR x (1-r) ) <$> mppn) + + applyHaircutTxn _ _ = error "Not implemented" buildPrepayRates :: [Date] -> Maybe A.AssetPrepayAssumption -> [Rate] @@ -290,7 +307,7 @@ priceAsset m d (PVCurve curve) assumps mRates (CF.CashFlowFrame txns,_) = projCashflow m d assumps mRates ds = getDate <$> txns amts = CF.tsTotalCash <$> txns - pv = pv3 curve d ds amts + pv = pv3 curve d ds amts -- `debug` ("pricing"++ show d++ show ds++ show amts) cb = getCurrentBal m wal = calcWAL ByYear cb d (zip amts ds) in @@ -300,13 +317,13 @@ priceAsset m d (BalanceFactor currentFactor defaultedFactor) assumps mRates = let cb = getCurrentBal m val = if isDefaulted m then - mulBR cb currentFactor + mulBR cb defaultedFactor -- `debug` ("Defulat CB"++ show cb) else - mulBR cb defaultedFactor + mulBR cb currentFactor -- `debug` ("CB"++ show cb) (CF.CashFlowFrame txns,_) = projCashflow m d assumps mRates ds = getDate <$> txns amts = CF.tsTotalCash <$> txns - wal = calcWAL ByYear cb d (zip amts ds) + wal = calcWAL ByYear cb d (zip amts ds) -- `debug` ("pricing"++ show d++ show ds++ show amts) in AssetPrice val wal (-1) (-1) (-1) --TODO missing duration and convixity diff --git a/src/AssetClass/Installment.hs b/src/AssetClass/Installment.hs index f307ec64..1dbfa83d 100644 --- a/src/AssetClass/Installment.hs +++ b/src/AssetClass/Installment.hs @@ -24,6 +24,7 @@ import qualified Assumptions as A import Types import Lib import Util +import DateUtil import qualified Cashflow as CF import AssetClass.AssetBase diff --git a/src/AssetClass/Lease.hs b/src/AssetClass/Lease.hs index fef9985b..e81b8eb5 100644 --- a/src/AssetClass/Lease.hs +++ b/src/AssetClass/Lease.hs @@ -15,6 +15,7 @@ import Asset import Types import Lib import Util +import DateUtil import qualified Data.Map as Map import Data.List diff --git a/src/AssetClass/Loan.hs b/src/AssetClass/Loan.hs index ebb2430e..4df989fa 100644 --- a/src/AssetClass/Loan.hs +++ b/src/AssetClass/Loan.hs @@ -13,6 +13,7 @@ import InterestRate import Asset import Lib import Util +import DateUtil import Types import qualified Data.Map as Map import Data.List diff --git a/src/AssetClass/Mortgage.hs b/src/AssetClass/Mortgage.hs index 351cad49..9e5f99e1 100644 --- a/src/AssetClass/Mortgage.hs +++ b/src/AssetClass/Mortgage.hs @@ -13,6 +13,7 @@ import Asset as Ast import Types import Lib import Util +import DateUtil import InterestRate as IR import qualified Data.Map as Map @@ -29,6 +30,7 @@ import AssetClass.AssetBase import Debug.Trace import Assumptions (AssetPerfAssumption(MortgageAssump)) +import GHC.Float.RealFracMethods (truncateFloatInteger) debug = flip trace projectMortgageFlow :: [CF.TsRow] -> Balance -> Maybe Rational -> Date -> Dates -> [DefaultRate] -> [PrepaymentRate] -> [Amount] -> [Amount] -> [IRate] -> (Int,Rate) -> Period -> AmortPlan -> [CF.TsRow] @@ -36,7 +38,7 @@ projectMortgageFlow trs _bal mbn _last_date (pDate:pDates) (_def_rate:_def_rates | _bal > 0.01 = projectMortgageFlow (trs++[tr]) endBal - ( toRational <$> _new_mbn) + ( toRational <$> newMbn) pDate pDates _def_rates @@ -68,62 +70,80 @@ projectMortgageFlow trs _bal mbn _last_date (pDate:pDates) (_def_rate:_def_rates endBal = newBalAfterPpy - newPrin _survive_rate = ((1 - _def_rate) * (1 - _ppy_rate)) _temp = _survive_rate * (toRational (1 - newPrin / newBalAfterPpy)) - _new_mbn = (\y -> fromInteger (round (_temp * (toRational y)))) <$> mbn - tr = CF.MortgageFlow pDate endBal newPrin newInt newPrepay 0 newDefault (head currentRec) (head currentLoss) _rate _new_mbn Nothing --TODO missing ppy-penalty here + newMbn = (\y -> fromInteger (round (_temp * (toRational y)))) <$> mbn + tr = CF.MortgageFlow pDate endBal newPrin newInt newPrepay newDefault (head currentRec) (head currentLoss) _rate newMbn Nothing --TODO missing ppy-penalty here projectMortgageFlow trs _b mbn _last_date (pDate:_pdates) _ _ (_rec_amt:_rec_amts) (_loss_amt:_loss_amts) _ _lag_rate _p _pt = projectMortgageFlow (trs++[tr]) _b mbn pDate _pdates [] [] _rec_amts _loss_amts [0.0] _lag_rate _p _pt where - tr = CF.MortgageFlow pDate _b 0 0 0 0 0 _rec_amt _loss_amt 0.0 Nothing Nothing + tr = CF.MortgageFlow pDate _b 0 0 0 0 _rec_amt _loss_amt 0.0 Nothing Nothing projectMortgageFlow trs _ _ _ [] _ _ [] [] _ _ _ _ = trs projectDelinqMortgageFlow :: ([CF.TsRow],[CF.TsRow]) -> Balance -> Maybe Rational -> Date -> [Date] -> [Rate] -> [PrepaymentRate] -> [IRate] -> (Rate,Lag,Rate,Lag,Period,AmortPlan) -> ([Balance],[Balance],[Balance]) -> [CF.TsRow] +projectDelinqMortgageFlow (trs,[]) _ _ _ [] _ _ _ _ _ = trs projectDelinqMortgageFlow (trs,backToPerfs) _ _ _ [] _ _ _ _ _ = let - consolTxn = sort $ trs ++ backToPerfs + 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 - CF.combineTss CF.mflowAmortAmount2 [] consolTxn -projectDelinqMortgageFlow (trs,backToPerfs) beginBal mBorrowerNum lastDate (pDate:pDates) (delinqRate:delinqRates) (ppyRate:ppyRates) (rate:rates) + 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) (dBal:defaultVec,rAmt:recoveryVec,lAmt:lossVec) - = projectDelinqMortgageFlow (trs++[tr],backToPerfs++newPerfCfs) endingBal mNewBn pDate pDates delinqRates ppyRates rates + -- | beginBal < 0.01 = let + -- (trsKeep,trsMerge) = splitByDate trs (getDate (head backToPerfs)) EqToRight + -- mergedTrs = CF.combineTss [] trsMerge backToPerfs `debug` ("trsMerge"++show trsMerge++"defalt/rec/loss"++show (dBal,rAmt,lAmt)) + -- in + -- trsKeep ++ mergedTrs `debug` ("MErgeed \n \n "++ show mergedTrs) + | otherwise = projectDelinqMortgageFlow (trs++[tr],CF.combineTss [] backToPerfs newPerfCfs) endingBal ( (downFactor *) <$> mbn) pDate pDates delinqRates ppyRates rates (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinType) - (newDefaultVec,newRecoveryVec,newLossVec) -- `debug` ("new flows>>>"++ show newPerfCfs) - where - remainTerms = 1 + 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 - - backToPerf = mulBR delinqBal (1 - defaultPct) - - restPerfVector = replicate (length delinqRates) 0 - restPerfBal = fromRational <$> restPerfVector - newPerfCfs = projectDelinqMortgageFlow ([],[]) backToPerf Nothing pDate (drop defaultLag pDates) - restPerfVector restPerfVector (rate:(drop defaultLag rates)) - (0,0,0,0,p,prinType) - (restPerfBal,restPerfBal,restPerfBal) -- `debug` ("Starting new perf"++ show backToPerf) - - balAfterDelinq = beginBal - delinqBal - ppyAmt = mulBR balAfterDelinq ppyRate - balAfterPpy = balAfterDelinq - ppyAmt - periodRate = periodRateFromAnnualRate p rate - intAmt = mulBI balAfterPpy periodRate - pmt = calcPmt balAfterPpy periodRate remainTerms - prinAmt = case prinType of - Level -> pmt - intAmt -- `debug` ("Pmt>>"++show pmt++">>used bal"++show balAfterPpy++">>"++show periodRate++">>remain term"++show remainTerms) - Even -> balAfterPpy / fromIntegral remainTerms - - endingBal = beginBal - prinAmt - ppyAmt - delinqBal -- `debug` ("DATE"++show pDate++">>>"++ show beginBal++">>"++show prinAmt ++ ">>" ++ show ppyAmt ++ ">>"++ show delinqBal) - mNewBn = Nothing --TODO - tr = CF.MortgageFlow pDate endingBal prinAmt intAmt ppyAmt delinqBal dBal rAmt lAmt rate mNewBn Nothing -- `debug` ("Date"++ show pDate ++ "ENDING BAL AT"++ show endingBal) + (newDefaultVec,newRecoveryVec,newLossVec) -- `debug` ("\n calc Date"++ show pDate ++"\n from new perf"++ show backToPerfBal ++"\n new cfs >>> \n"++ show newPerfCfs) + where + remainTerms = 1 + max 0 (length pDates - recoveryLag - defaultLag) + -- remainTerms = 1 + 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) + (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 + intAmt = mulBI balAfterPpy periodRate + pmt = calcPmt balAfterPpy periodRate remainTerms + prinAmt = case prinType of + Level -> pmt - intAmt -- `debug` ("Pmt>> \n"++show pmt++">>used bal"++show balAfterPpy++">>"++show periodRate++">>remain term"++show remainTerms) + Even -> balAfterPpy / fromIntegral remainTerms + + endingBal = beginBal - prinAmt - ppyAmt - delinqBal -- `debug` ("DATE"++show pDate++">>>"++ show beginBal++">>"++show prinAmt ++ ">>" ++ show ppyAmt ++ ">>"++ show delinqBal) + downFactor = divideBB beginBal endingBal + newMbn = case mbn of + Just bn -> Just (((fromInteger . round) ((divideBB beginBal endingBal) * bn))::Int) + Nothing -> Nothing + -- mNewBorrowerNum = (fromIntegral . toInteger . fromRational) <$> ((divideBB beginBal endingBal) *) <$> mBorrowerNum + tr = CF.MortgageDelinqFlow pDate endingBal prinAmt intAmt ppyAmt delinqBal dBal rAmt lAmt rate newMbn 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] @@ -150,7 +170,7 @@ projectScheduleFlow trs bal_factor last_bal (flow:flows) (_def_rate:_def_rates) _end_bal = max 0 $ _after_bal - _schedule_prin - tr = CF.MortgageFlow (CF.getDate flow) _end_bal _schedule_prin _schedule_int _ppy_amt 0 _def_amt (head _rec_vector) (head _loss_vector) 0.0 Nothing Nothing --TODO missing ppy-penalty here + tr = CF.MortgageFlow (CF.getDate flow) _end_bal _schedule_prin _schedule_int _ppy_amt _def_amt (head _rec_vector) (head _loss_vector) 0.0 Nothing Nothing --TODO missing ppy-penalty here projectScheduleFlow trs b_factor last_bal [] _ _ (r:rs) (l:ls) (recovery_lag,recovery_rate) = projectScheduleFlow (trs++[tr]) b_factor last_bal [] [] [] rs ls (recovery_lag - 1,recovery_rate) @@ -158,25 +178,31 @@ projectScheduleFlow trs b_factor last_bal [] _ _ (r:rs) (l:ls) (recovery_lag,rec remain_length = length rs last_date = CF.getDate (last trs) flow_date = nextDate last_date Lib.Monthly - tr = CF.MortgageFlow flow_date last_bal 0 0 0 0 0 r l 0.0 Nothing Nothing + tr = CF.MortgageFlow flow_date last_bal 0 0 0 0 r l 0.0 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,newPerfs) _ _ flows [] [] defaults recoveries losses _ = +projectScheduleDelinqFlow (trs,[]) _ begBal flows [] [] defaults recoveries losses _ = let - patchedFlows = [ CF.MortgageFlow d bal prin int prepay delinq defVal recVal lossVal rate mB mPPN - | ((CF.MortgageFlow d bal prin int prepay delinq defAmt recoveryAmt lossAmt rate mB mPPN),defVal,recVal,lossVal) <- zip4 flows defaults recoveries losses] `debug` ("Length of default"++ show defaults++">>recovery>>"++ show recoveries++">>loss>>"++ show losses) - r1 = sort $ trs ++ patchedFlows - -- original cashflow done - r2 = r1 -- foldl (CF.reduceTs2 CF.mflowAmortAmount2) [] r1 - -- back to performance cashflow - r3 = sort $ r2 ++ newPerfs - r4 = CF.combineTss CF.mflowAmortAmount2 [] r3 + patchedFlows = [ CF.MortgageDelinqFlow d begBal prin int prepay delinq defVal recVal lossVal rate mB mPPN + | (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN,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 - r4 + 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 + | (CF.MortgageDelinqFlow d bal prin int prepay delinq _ _ _ rate mB mPPN,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],backToPerfCfs++currentBackToPerfCfs) newSurviveRate endBal flows delinqRates ppyRates newDefaultBals newRecoveryBals newLossBals (defaultPct,defaultLag,recoveryRate,recoveryLag) `debug` ("new back to perf flow"++ show backToPerfCfs) + = 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) @@ -198,8 +224,8 @@ projectScheduleDelinqFlow (trs,backToPerfCfs) surviveRate begBal (flow:flows) (d 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.MortgageFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt delinqAmt defaultBal recoveryBal lossBal (CF.mflowRate flow) Nothing - Nothing -- `debug` ("Default Bal"++ show newDefaultBals ++ "Rec Bal"++ show newRecoveryBals ++ "Loss Bal"++ show newLossBals) + tr = CF.MortgageDelinqFlow (CF.getDate flow) endBal schedulePrin scheduleInt ppyAmt delinqAmt defaultBal recoveryBal lossBal (CF.mflowRate flow) Nothing + Nothing -- `debug` ("|||>>> proj at date"++ show (CF.getDate flow)) -- | implementation on prepayment penalty, which patch cashflow to cashflow frame patchPrepayPentalyFlow :: Mortgage -> CF.CashFlowFrame -> CF.CashFlowFrame @@ -308,13 +334,13 @@ instance Ast.Asset Mortgage where (applyHaircut ams $ patchPrepayPentalyFlow m (CF.CashFlowFrame futureTxns) ,historyM) where - last_pay_date:cf_dates = lastN (recovery_lag + rt + 1) $ sd:(getPaymentDates m recovery_lag) - cf_dates_length = length cf_dates + lastPayDate:cfDates = lastN (recovery_lag + rt + 1) $ sd:(getPaymentDates m recovery_lag) + cf_dates_length = length cfDates - rate_vector = A.projRates cr or mRates cf_dates + rate_vector = A.projRates cr or mRates cfDates - (ppy_rates,def_rates,recovery_rate,recovery_lag) = Ast.buildAssumptionPpyDefRecRate (last_pay_date:cf_dates) (A.MortgageAssump amd amp amr ams) -- `debug` ("Rate vector"++ show rate_vector) - txns = projectMortgageFlow [] cb (toRational <$> mbn) last_pay_date cf_dates def_rates ppy_rates + (ppy_rates,def_rates,recovery_rate,recovery_lag) = Ast.buildAssumptionPpyDefRecRate (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) -- `debug` ("Rate vector"++ show rate_vector) + txns = projectMortgageFlow [] cb (toRational <$> mbn) lastPayDate cfDates def_rates ppy_rates (replicate cf_dates_length 0.0) (replicate cf_dates_length 0.0) rate_vector (recovery_lag,recovery_rate) p prinPayType @@ -329,26 +355,26 @@ instance Ast.Asset Mortgage where (applyHaircut ams $ patchPrepayPentalyFlow m (CF.CashFlowFrame futureTxns) ,historyM) where - last_pay_date:cf_dates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:(getPaymentDates m (recoveryLag+defaultLag)) - cf_dates_length = length cf_dates + recoveryLag + defaultLag + lastPayDate:cfDates = lastN (recoveryLag + defaultLag + rt + 1) $ sd:(getPaymentDates m (recoveryLag+defaultLag)) + cfDatesLength = length cfDates + recoveryLag + defaultLag - rate_vector = A.projRates cr or mRates cf_dates + rateVector = A.projRates cr or mRates cfDates - (ppyRates,delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) = Ast.buildAssumptionPpyDelinqDefRecRate (last_pay_date:cf_dates) (A.MortgageDeqAssump amd amp amr ams) + (ppyRates,delinqRates,(defaultPct,defaultLag),recoveryRate,recoveryLag) = Ast.buildAssumptionPpyDelinqDefRecRate (lastPayDate:cfDates) (A.MortgageDeqAssump amd amp amr ams) - txns = projectDelinqMortgageFlow ([],[]) cb (toRational <$> mbn) last_pay_date cf_dates delinqRates ppyRates rate_vector + txns = projectDelinqMortgageFlow ([],[]) cb (toRational <$> mbn) lastPayDate cfDates delinqRates ppyRates rateVector (defaultPct,defaultLag,recoveryRate,recoveryLag,p,prinPayType) - ((replicate cf_dates_length 0.0),(replicate cf_dates_length 0.0),(replicate cf_dates_length 0.0)) + (replicate cfDatesLength 0.0,replicate cfDatesLength 0.0,replicate cfDatesLength 0.0) -- 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 (cf_dates1,cf_dates2) = splitAt lag $ genDates defaultedDate p (lag+ length timing) - beforeRecoveryTxn = [ CF.MortgageFlow d cb 0 0 0 0 0 0 0 cr mbn Nothing | d <- cf_dates1 ] + beforeRecoveryTxn = [ CF.MortgageDelinqFlow d cb 0 0 0 0 0 0 0 cr mbn Nothing | d <- cf_dates1 ] recoveries = calcRecoveriesFromDefault cb rr timing bals = scanl (-) cb recoveries - txns = [ CF.MortgageFlow d b 0 0 0 0 0 r 0 cr mbn Nothing | (b,d,r) <- zip3 bals cf_dates2 recoveries ] + txns = [ CF.MortgageFlow d b 0 0 0 0 r 0 cr mbn Nothing | (b,d,r) <- zip3 bals cf_dates2 recoveries ] in (CF.CashFlowFrame $ cutBy Inc Future asOfDay (beforeRecoveryTxn ++ txns) ,Map.empty) @@ -358,11 +384,11 @@ instance Ast.Asset Mortgage where = 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 _ - = (CF.CashFlowFrame $ [ CF.MortgageFlow asOfDay cb 0 0 0 0 0 0 0 cr mbn Nothing ] + = (CF.CashFlowFrame $ [ CF.MortgageFlow asOfDay cb 0 0 0 0 0 0 cr mbn Nothing ] ,Map.empty) -- project defaulted Mortgage projCashflow m@(Mortgage _ cb cr rt mbn (Defaulted Nothing) ) asOfDay assumps _ - = (CF.CashFlowFrame $ [ CF.MortgageFlow asOfDay cb 0 0 0 0 0 0 0 cr mbn Nothing ] + = (CF.CashFlowFrame $ [ CF.MortgageFlow asOfDay cb 0 0 0 0 0 0 cr mbn Nothing ] ,Map.empty) -- project current AdjMortgage @@ -380,27 +406,27 @@ instance Ast.Asset Mortgage where passInitPeriod = (ot - rt) >= initPeriod firstResetDate = monthsAfter sd (toInteger (succ initPeriod)) - last_pay_date:cf_dates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recovery_lag + 1) $ sd:(getPaymentDates m recovery_lag) + lastPayDate:cfDates = sliceDates (SliceOnAfterKeepPrevious asOfDay) $ lastN (rt + recoveryLag + 1) $ sd:(getPaymentDates m recoveryLag) - cf_dates_length = length cf_dates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates )) - rate_curve = case or of + cf_dates_length = length cfDates -- `debug` (" cf dates >>" ++ show (last_pay_date:cf_dates )) + rateCurve = case or of IR.Fix _ r -> error "ARM should have floater rate" IR.Floater _ idx sprd initRate dp _ _ mRoundBy -> let - resetDates = genSerialDatesTill2 IE firstResetDate dp (last cf_dates) + resetDates = genSerialDatesTill2 IE firstResetDate dp (last cfDates) projectFutureActualCurve = runInterestRate2 arm (sd,getOriginRate m) or resetDates in case A.getRateAssumption (fromMaybe [] mRates) idx of Just (RateCurve idx curve) -> projectFutureActualCurve curve -- `debug` ("Curve") Just (RateFlat idx v) - -> projectFutureActualCurve (mkRateTs [(getOriginDate m,v),(last cf_dates,v)]) -- `debug` ("lpd"++show last_pay_date++"lpd"++ show (last cf_dates)) + -> projectFutureActualCurve (mkRateTs [(getOriginDate m,v),(last cfDates,v)]) -- `debug` ("lpd"++show last_pay_date++"lpd"++ show (last cf_dates)) Nothing -> error $ "Failed to find index"++ show idx - rate_vector = fromRational <$> getValByDates rate_curve Inc cf_dates -- `debug` ("RateCurve"++ show rate_curve) + rate_vector = fromRational <$> getValByDates rateCurve Inc cfDates -- `debug` ("RateCurve"++ show rate_curve) - (ppy_rates,def_rates,recovery_rate,recovery_lag) = buildAssumptionPpyDefRecRate (last_pay_date:cf_dates) (A.MortgageAssump amd amp amr ams) - txns = projectMortgageFlow [] cb (toRational <$> mbn) last_pay_date cf_dates def_rates ppy_rates (replicate cf_dates_length 0.0) (replicate cf_dates_length 0.0) rate_vector (recovery_lag,recovery_rate) p prinPayType + (ppyRates,defRates,recoveryRate,recoveryLag) = buildAssumptionPpyDefRecRate (lastPayDate:cfDates) (A.MortgageAssump amd amp amr ams) + txns = projectMortgageFlow [] cb (toRational <$> mbn) lastPayDate cfDates defRates ppyRates (replicate cf_dates_length 0.0) (replicate cf_dates_length 0.0) rate_vector (recoveryLag,recoveryRate) p prinPayType -- project current AdjMortgage with delinq projCashflow m@(AdjustRateMortgage (MortgageOriginalInfo ob or ot p sd prinPayType mpn) arm cb cr rt mbn Current) @@ -453,7 +479,7 @@ instance Ast.Asset Mortgage where extraPeriods = recoveryLag endDate = CF.getDate (last flows) extraDates = genSerialDates dp endDate extraPeriods - cfDates = (map CF.getDate flows) ++ extraDates + cfDates = (CF.getDate <$> flows) ++ extraDates txns = projectScheduleFlow [] 1.0 @@ -480,10 +506,8 @@ instance Ast.Asset Mortgage where extraPeriods = defaultLag + recoveryLag -- `debug` ("lags "++show defaultLag++">>"++show recoveryLag) endDate = CF.getDate (last flows) extraDates = genSerialDates dp endDate extraPeriods - extraFlows = let - _extraFlows = replicate extraPeriods (last flows) - in - [ CF.emptyTsRow d r | (d,r) <- zip extraDates _extraFlows ] + -- extra empty cashflow with dates proj from `date pattern` from pool + extraFlows = [ CF.emptyTsRow d r | (d,r) <- zip extraDates (replicate extraPeriods (last flows)) ] flowWithExtraDates = flows ++ extraFlows cfDates = getDates flowWithExtraDates -- `debug` ("CF dates"++ show flowWithExtraDates) txns = projectScheduleDelinqFlow @@ -496,7 +520,7 @@ instance Ast.Asset Mortgage where (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) (replicate curveDatesLength 0.0) - (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("curveDatesLength"++ show curveDatesLength) + (defaultPct,defaultLag,recoveryRate,recoveryLag) -- `debug` ("Delinq rates"++ show delinqRates++">>ppy rates"++ show ppyRates) projCashflow a b c d = error $ "Failed to match when proj mortgage>>" ++ show a ++ show b ++ show c ++ show d diff --git a/src/Assumptions.hs b/src/Assumptions.hs index c8663067..2b85c6fb 100644 --- a/src/Assumptions.hs +++ b/src/Assumptions.hs @@ -13,13 +13,14 @@ module Assumptions (BondPricingInput(..) ,LeaseAssetRentAssump(..) ,NonPerfAssumption(..),AssetPerf ,AssetDelinquencyAssumption(..) - ,AssetPerfAssumption(..),AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) + ,AssetDelinqPerfAssumption(..),AssetDefaultedPerfAssumption(..) ,getCDR,calcResetDates) where import Call as C import Lib (Ts(..),TsPoint(..),toDate,mkRateTs) import Util +import DateUtil import qualified Data.Map as Map import Data.List import qualified Data.Set as Set @@ -81,7 +82,7 @@ data AssetPrepayAssumption = PrepaymentConstant Rate | PrepaymentVec [Rate] deriving (Show,Generic) -data AssetDelinquencyAssumption = DelinqCDR Rate (Lag,Rate) -- Annualized Rate to Delinq status , period lag become defaulted, loss rate, period become loss +data AssetDelinquencyAssumption = DelinqCDR Rate (Lag,Rate) -- Annualized Rate to Delinq status , period lag become defaulted, loss rate, period lag become loss | Dummy3 deriving (Show,Generic) @@ -119,9 +120,9 @@ data AssetPerfAssumption = MortgageAssump (Maybe AssetDefaultAssumption) (May | InstallmentAssump (Maybe AssetDefaultAssumption) (Maybe AssetPrepayAssumption) (Maybe RecoveryAssumption) (Maybe ExtraStress) deriving (Show,Generic) -data RevolvingAssumption = AvailableAssets RevolvingPool AssetPerf - | Dummy4 - deriving (Show,Generic) +data RevolvingAssumption = AvailableAssets RevolvingPool ApplyAssumptionType + | Dummy4 + deriving (Show,Generic) data BondPricingInput = DiscountCurve Date Ts -- ^ PV curve used to discount bond cashflow and a PV date where cashflow discounted to | RunZSpread Ts (Map.Map BondName (Date,Rational)) -- ^ PV curve as well as bond trading price with a deal used to calc Z - spread @@ -140,7 +141,7 @@ lookupRate rAssumps (index,spd) d = case find (\x -> getIndexFromRateAssumption x == index ) rAssumps of Just (RateCurve _ ts) -> spd + fromRational (getValByDate ts Inc d) Just (RateFlat _ r) -> r + spd - Nothing -> error $ "Failed to find Index "++show index + Nothing -> error $ "Failed to find Index " ++ show index getRateAssumption :: [RateAssumption] -> Index -> Maybe RateAssumption getRateAssumption assumps idx @@ -152,7 +153,7 @@ getRateAssumption assumps idx -- | project rates used by rate type ,with interest rate assumptions and observation dates projRates :: IRate -> RateType -> Maybe [RateAssumption] -> [Date] -> [IRate] -projRates sr (Fix _ r) _ ds = replicate (length ds) r +projRates sr (Fix _ r) _ ds = replicate (length ds) sr projRates sr (Floater _ idx spd r dp rfloor rcap mr) (Just assumps) ds = case getRateAssumption assumps idx of Nothing -> error ("Failed to find index rate " ++ show idx ++ " from "++ show assumps) @@ -173,6 +174,8 @@ projRates sr (Floater _ idx spd r dp rfloor rcap mr) (Just assumps) ds (Just fv, Just cv) -> capWith cv $ floorWith fv $ fromRational <$> ratesUsedByDates (Just fv, Nothing) -> floorWith fv $ fromRational <$> ratesUsedByDates (Nothing, Just cv) -> capWith cv $ fromRational <$> ratesUsedByDates +projRates _ rt rassump ds = error ("Invalid rate type: "++ show rt++" assump"++ show rassump) + -- ^ Given a list of rates, calcualte whether rates was reset calcResetDates :: [IRate] -> [Bool] -> [Bool] diff --git a/src/Cashflow.hs b/src/Cashflow.hs index 12d38f02..579dc215 100644 --- a/src/Cashflow.hs +++ b/src/Cashflow.hs @@ -5,24 +5,25 @@ module Cashflow (CashFlowFrame(..),Principals,Interests,Amount ,combine,mergePoolCf,sumTsCF,tsSetDate ,sizeCashFlowFrame,aggTsByDates, getTsCashFlowFrame ,mflowInterest,mflowPrincipal,mflowRecovery,mflowPrepayment - ,mflowRental,mflowRate,sumPoolFlow,splitTrs + ,mflowRental,mflowRate,sumPoolFlow,splitTrs,aggregateTsByDate ,mflowDefault,mflowLoss,mflowDate ,getSingleTsCashFlowFrame,getDatesCashFlowFrame,getDateRangeCashFlowFrame - ,lookupSource,reduceTs,reduceTs2,combineTss + ,lookupSource,reduceTs,combineTss ,mflowBalance,mflowBegBalance,tsDefaultBal ,mflowBorrowerNum,mflowPrepaymentPenalty - ,splitCashFlowFrameByDate,emptyTsRow,mflowAmortAmount,mflowAmortAmount2 + ,splitCashFlowFrameByDate,emptyTsRow,mflowAmortAmount ,tsTotalCash, setPrepaymentPenalty, setPrepaymentPenaltyFlow ,tsDateLT,getDate,getTxnLatestAsOf ,mflowWeightAverageBalance,appendCashFlow,combineCashFlow ,addFlowBalance,totalLoss,totalDefault,totalRecovery,firstDate ,shiftCfToStartDate,cfInsertHead,buildBegTsRow,insertBegTsRow - ,TsRow(..),cfAt,cutoffTrs) where + ,TsRow(..),cfAt,cutoffTrs,patchBeginBalance) where import Data.Time (Day) import Data.Fixed import Lib (weightedBy,toDate,getIntervalFactors,daysBetween) -import Util (mulBR,splitByDate,mulBInt,mulIR) +import Util (mulBR,mulBInt,mulIR) +import DateUtil ( splitByDate ) import Types import qualified Data.Map as Map import qualified Data.Time as T @@ -39,6 +40,7 @@ import Text.Printf import Debug.Trace import qualified Control.Lens as Map +import Data.OpenApi (HasPatch(patch)) debug = flip trace type Delinquent = Centi @@ -51,7 +53,8 @@ type Rates = [Rate] data TsRow = CashFlow Date Amount | BondFlow Date Balance Principal Interest - | MortgageFlow Date Balance Principal Interest Prepayment Delinquent Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) + | MortgageFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) + | MortgageDelinqFlow Date Balance Principal Interest Prepayment Delinquent Default Recovery Loss IRate (Maybe BorrowerNum) (Maybe PrepaymentPenalty) | LoanFlow Date Balance Principal Interest Prepayment Default Recovery Loss IRate | LeaseFlow Date Balance Rental deriving(Show,Eq,Ord,Generic) @@ -59,7 +62,8 @@ data TsRow = CashFlow Date Amount instance TimeSeries TsRow where getDate (CashFlow x _) = x getDate (BondFlow x _ _ _) = x - getDate (MortgageFlow x _ _ _ _ _ _ _ _ _ _ _) = x + getDate (MortgageFlow x _ _ _ _ _ _ _ _ _ _) = x + getDate (MortgageDelinqFlow x _ _ _ _ _ _ _ _ _ _ _) = x getDate (LoanFlow x _ _ _ _ _ _ _ _) = x getDate (LeaseFlow x _ _ ) = x @@ -100,177 +104,225 @@ splitCashFlowFrameByDate (CashFlowFrame txns) d st in (CashFlowFrame ls,CashFlowFrame rs) - getTxnLatestAsOf :: CashFlowFrame -> Date -> Maybe TsRow getTxnLatestAsOf (CashFlowFrame txn) d = L.find (\x -> getDate x <= d) $ reverse txn -addTs :: TsRow -> TsRow -> TsRow -- left is ealier ,right is later,combine TS from same cashflow +addTs :: TsRow -> TsRow -> TsRow +-- ^ left cashflow is ealier ,right one is later,combine both and yield cashflow with earlier date addTs (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) addTs (BondFlow d1 b1 p1 i1 ) tr@(BondFlow _ b2 p2 i2 ) = BondFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) -addTs (MortgageFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) +addTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2) = let bn = (+) <$> mbn1 <*> mbn2 p = (+) <$> pn1 <*> pn2 - delinq = (+) delinq1 delinq2 in - (MortgageFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2]))) bn p) -addTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2) - = (LoanFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2])))) -addTs (LeaseFlow d1 b1 r1) tr@(LeaseFlow d2 b2 r2) - = (LeaseFlow d1 (b1 - mflowAmortAmount tr) (r1 + r2) ) - -addTs2 :: (TsRow -> Balance) -> TsRow -> TsRow -> TsRow -addTs2 f (MortgageFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) + MortgageFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p +addTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageDelinqFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) = let bn = (+) <$> mbn1 <*> mbn2 p = (+) <$> pn1 <*> pn2 delinq = (+) delinq1 delinq2 in - (MortgageFlow d1 (b1 - f tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2]))) bn p) + MortgageDelinqFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p -combineTs :: TsRow -> TsRow -> TsRow -- left is ealier ,right is later,combine TS from two cashflow +addTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2) + = LoanFlow d1 (b1 - mflowAmortAmount tr) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) +addTs (LeaseFlow d1 b1 r1) tr@(LeaseFlow d2 b2 r2) + = LeaseFlow d1 (b1 - mflowAmortAmount tr) (r1 + r2) + +combineTs :: TsRow -> TsRow -> TsRow +-- ^ combine two cashflow records from two entities, return cashflow with earlier date combineTs (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) combineTs (BondFlow d1 b1 p1 i1 ) tr@(BondFlow _ b2 p2 i2 ) = BondFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) -combineTs (MortgageFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) +combineTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageDelinqFlow _ b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) = let bn = (+) <$> mbn1 <*> mbn2 p = (+) <$> pn1 <*> pn2 delinq = (+) delinq1 delinq2 in - (MortgageFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2]))) bn p) + MortgageDelinqFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p +combineTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1) tr@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2) + = let + bn = (+) <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + in + MortgageFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p combineTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1) tr@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2) - = (LoanFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2])))) + = LoanFlow d1 (b1 + b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) combineTs (LeaseFlow d1 b1 r1) tr@(LeaseFlow d2 b2 r2) - = (LeaseFlow d1 (b1 + b2) (r1 + r2) ) - --- combine two cashflows from two entities -combineTss :: (TsRow -> Balance) -> [TsRow] -> [TsRow] -> [TsRow] -combineTss f r [] = reverse r -combineTss f [] (tr:trs) = combineTss f [tr] trs -combineTss f (r:rs) (tr:trs) - | getDate r == getDate tr = combineTss f ((combineTs r tr):rs) trs - | getDate r < getDate tr = combineTss f ((appendTs2 f r tr):r:rs) trs - | getDate r > getDate tr = combineTss f (tr:(appendTs2 f tr r):rs) trs - -appendTs2 :: (TsRow -> Balance) -> TsRow -> TsRow -> TsRow -appendTs2 f (MortgageFlow d1 b1 p1 i1 prep1 _ def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageFlow {}) - = updateFlowBalance (b1 - f bn2) bn2 - -appendTs :: TsRow -> TsRow -> TsRow --early row on left, later row on right, update right TS balance + = LeaseFlow d1 (b1 + b2) (r1 + r2) + +combineTss :: [TsRow] -> [TsRow] -> [TsRow] -> [TsRow] +-- ^ combine two cashflows from two entities,(auto patch a beg balance) +combineTss [] [] r = r +combineTss [] r [] = r +combineTss [] (r1:r1s) (r2:r2s) + | getDate r1 > getDate r2 = combineTss [] (r2:r2s) (r1:r1s) + | getDate r1 == getDate r2 = combineTss [combineTs r1 r2] + r1s + r2s + | otherwise = combineTss [updateFlowBalance ((mflowBegBalance r2)+(mflowBalance r1)) r1] + r1s + (r2:r2s) +combineTss consols [] [] = reverse consols +combineTss (consol:consols) (r:rs) [] = combineTss ((appendTs consol r):consol:consols) rs [] +combineTss (consol:consols) [] (tr:trs) = combineTss ((appendTs consol tr):consol:consols) [] trs +combineTss (consol:consols) (r:rs) (tr:trs) + | getDate r == getDate tr = combineTss ((appendTs consol (combineTs r tr)):consol:consols) rs trs + | getDate r < getDate tr = combineTss ((appendTs consol r):consol:consols) rs (tr:trs) + | getDate r > getDate tr = combineTss ((appendTs consol tr):consol:consols) (r:rs) trs +combineTss a b c = error $ "combineTss not supported "++show a++" "++show b++" "++show c + + +appendTs :: TsRow -> TsRow -> TsRow +-- ^ combine two cashflow records from two entities ,(early row on left, later row on right) appendTs bn1@(BondFlow d1 b1 _ _ ) bn2@(BondFlow d2 b2 p2 i2 ) - = updateFlowBalance (b1 - (mflowAmortAmount bn2)) bn2 -- `debug` ("b1 >> "++show b1++">>"++show (mflowAmortAmount bn2)) -appendTs (MortgageFlow d1 b1 p1 i1 prep1 _ def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageFlow _ b2 p2 i2 prep2 _ def2 rec2 los2 rat2 mbn2 _) - = updateFlowBalance (b1 - (mflowAmortAmount bn2)) bn2 + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 -- `debug` ("b1 >> "++show b1++">>"++show (mflowAmortAmount bn2)) +appendTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 _ def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageDelinqFlow _ b2 p2 i2 prep2 _ def2 rec2 los2 rat2 mbn2 _) + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 _) + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 appendTs (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1) bn2@(LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2) - = updateFlowBalance (b1 - (mflowAmortAmount bn2)) bn2 + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 appendTs (LeaseFlow d1 b1 r1) bn2@(LeaseFlow d2 b2 r2) - = updateFlowBalance (b1 - (mflowAmortAmount bn2)) bn2 + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (MortgageDelinqFlow d1 b1 p1 i1 prep1 _ def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 _) + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 _) bn2@(MortgageDelinqFlow _ b2 p2 i2 prep2 _ def2 rec2 los2 rat2 mbn2 _) + = updateFlowBalance (b1 - mflowAmortAmount bn2) bn2 +appendTs _1 _2 = error $ "appendTs failed with "++ show _1 ++ ">>" ++ show _2 addTsCF :: TsRow -> TsRow -> TsRow -addTsCF (CashFlow d1 a1 ) (CashFlow _ a2 ) = (CashFlow d1 (a1 + a2)) -addTsCF (BondFlow d1 b1 p1 i1 ) (BondFlow _ b2 p2 i2 ) = (BondFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) ) -addTsCF (MortgageFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) (MortgageFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) +-- ^ add up TsRow from same entity +addTsCF (CashFlow d1 a1 ) (CashFlow _ a2 ) = CashFlow d1 (a1 + a2) +addTsCF (BondFlow d1 b1 p1 i1 ) (BondFlow _ b2 p2 i2 ) = BondFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) +addTsCF (MortgageFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1 mbn1 pn1) (MortgageFlow d2 b2 p2 i2 prep2 def2 rec2 los2 rat2 mbn2 pn2) + = let + bn = min <$> mbn1 <*> mbn2 + p = (+) <$> pn1 <*> pn2 + in + MortgageFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p +addTsCF (MortgageDelinqFlow d1 b1 p1 i1 prep1 delinq1 def1 rec1 los1 rat1 mbn1 pn1) (MortgageDelinqFlow d2 b2 p2 i2 prep2 delinq2 def2 rec2 los2 rat2 mbn2 pn2) = let bn = min <$> mbn1 <*> mbn2 p = (+) <$> pn1 <*> pn2 delinq = (+) delinq1 delinq2 in - (MortgageFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2]))) bn p) + MortgageDelinqFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) delinq (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) bn p addTsCF (LoanFlow d1 b1 p1 i1 prep1 def1 rec1 los1 rat1) (LoanFlow _ b2 p2 i2 prep2 def2 rec2 los2 rat2) - = (LoanFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (map toRational [rat1,rat2]))) ) -addTsCF (LeaseFlow d1 b1 r1) (LeaseFlow d2 b2 r2) = (LeaseFlow d1 (min b1 b2) (r1 + r2) ) + = LoanFlow d1 (min b1 b2) (p1 + p2) (i1 + i2) (prep1 + prep2) (def1 + def2) (rec1 + rec2) (los1+los2) (fromRational (weightedBy [b1,b2] (toRational <$> [rat1,rat2]))) +addTsCF (LeaseFlow d1 b1 r1) (LeaseFlow d2 b2 r2) = LeaseFlow d1 (min b1 b2) (r1 + r2) sumTs :: [TsRow] -> Date -> TsRow sumTs trs d = tsSetDate (foldr1 addTs trs) d + sumTsCF :: [TsRow] -> Date -> TsRow +-- ^ group cashflow from same entity by a single date sumTsCF trs d = tsSetDate (foldl1 addTsCF trs) d -- `debug` ("Summing"++show trs++">>"++ show (tsSetDate (foldr1 addTsCF trs) d)) tsTotalCash :: TsRow -> Balance tsTotalCash (CashFlow _ x) = x tsTotalCash (BondFlow _ _ a b) = a + b -tsTotalCash (MortgageFlow x _ a b c _ _ e _ _ _ mPn) = a + b + c + e + fromMaybe 0 mPn +tsTotalCash (MortgageDelinqFlow x _ a b c _ _ e _ _ _ mPn) = a + b + c + e + fromMaybe 0 mPn +tsTotalCash (MortgageFlow x _ a b c _ e _ _ _ mPn) = a + b + c + e + fromMaybe 0 mPn tsTotalCash (LoanFlow _ _ a b c _ e _ _) = a + b + c + e tsTotalCash (LeaseFlow _ _ a) = a tsDefaultBal :: TsRow -> Balance tsDefaultBal CashFlow {} = error "not supported" tsDefaultBal BondFlow {} = error "not supported" -tsDefaultBal (MortgageFlow _ _ _ _ _ _ x _ _ _ _ _) = x +tsDefaultBal (MortgageDelinqFlow _ _ _ _ _ _ x _ _ _ _ _) = x +tsDefaultBal (MortgageFlow _ _ _ _ _ x _ _ _ _ _) = x tsDefaultBal (LoanFlow _ _ _ _ _ x _ _ _) = x tsDefaultBal LeaseFlow {} = error "not supported" tsSetDate :: TsRow -> Date -> TsRow tsSetDate (CashFlow _ a) x = CashFlow x a tsSetDate (BondFlow _ a b c) x = BondFlow x a b c -tsSetDate (MortgageFlow _ a b c d e f g h i j k ) x = MortgageFlow x a b c d e f g h i j k +tsSetDate (MortgageDelinqFlow _ a b c d e f g h i j k ) x = MortgageDelinqFlow x a b c d e f g h i j k +tsSetDate (MortgageFlow _ a b c d e f g h i j ) x = MortgageFlow x a b c d e f g h i j tsSetDate (LoanFlow _ a b c d e f g h) x = LoanFlow x a b c d e f g h tsSetDate (LeaseFlow _ a b) x = LeaseFlow x a b tsSetBalance :: Balance -> TsRow -> TsRow tsSetBalance x (CashFlow _d a) = CashFlow _d x tsSetBalance x (BondFlow _d a b c) = BondFlow _d x b c -tsSetBalance x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow _d x b c d e f g h i j k +tsSetBalance x (MortgageDelinqFlow _d a b c d e f g h i j k) = MortgageDelinqFlow _d x b c d e f g h i j k +tsSetBalance x (MortgageFlow _d a b c d e f g h i j) = MortgageFlow _d x b c d e f g h i j tsSetBalance x (LoanFlow _d a b c d e f g h) = LoanFlow _d x b c d e f g h tsSetBalance x (LeaseFlow _d a b) = LeaseFlow _d x b tsOffsetDate :: Integer -> TsRow -> TsRow tsOffsetDate x (CashFlow _d a) = CashFlow (T.addDays x _d) a tsOffsetDate x (BondFlow _d a b c) = BondFlow (T.addDays x _d) a b c -tsOffsetDate x (MortgageFlow _d a b c d e f g h i j k) = MortgageFlow (T.addDays x _d) a b c d e f g h i j k +tsOffsetDate x (MortgageDelinqFlow _d a b c d e f g h i j k) = MortgageDelinqFlow (T.addDays x _d) a b c d e f g h i j k +tsOffsetDate x (MortgageFlow _d a b c d e f g h i j) = MortgageFlow (T.addDays x _d) a b c d e f g h i j tsOffsetDate x (LoanFlow _d a b c d e f g h) = LoanFlow (T.addDays x _d) a b c d e f g h tsOffsetDate x (LeaseFlow _d a b) = LeaseFlow (T.addDays x _d) a b --- ^ consolidate cashflow , update balance of newer cashflow record +-- ^ consolidate cashflow from same entity , update balance of newer cashflow record reduceTs :: [TsRow] -> TsRow -> [TsRow] reduceTs [] _tr = [_tr] reduceTs (tr:trs) _tr | sameDate tr _tr = addTs tr _tr : trs | otherwise = appendTs tr _tr : tr : trs -reduceTs2 :: (TsRow -> Balance) -> [TsRow] -> TsRow -> [TsRow] -reduceTs2 f [] _tr = [_tr] -reduceTs2 f (tr:trs) _tr - | sameDate tr _tr = addTs2 f tr _tr : trs - | otherwise = appendTs2 f tr _tr : tr : trs +aggregateTsByDate :: [TsRow] -> [TsRow] -> [TsRow] +aggregateTsByDate rs [] = reverse rs +aggregateTsByDate [] (tr:trs) = aggregateTsByDate [tr] trs +aggregateTsByDate (r:rs) (tr:trs) + | sameDate r tr = aggregateTsByDate ((combineTs r tr):rs) trs + | otherwise = aggregateTsByDate (tr:r:rs) trs firstDate :: CashFlowFrame -> Date +firstDate (CashFlowFrame []) = error "empty cashflow frame to get first date" firstDate (CashFlowFrame rs) = getDate $ head rs -combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame -- Left CF is earlier than Right CF -combine cf1@(CashFlowFrame rs1) cf2@(CashFlowFrame rs2) - | ds1 == ds2 = CashFlowFrame $ (zipWith combineTs rs1 rs2) - | fdRs1 == fdRs2 - = combineCashFlow - (CashFlowFrame [combineTs (head rs1) (head rs2)]) - $ combine (CashFlowFrame (tail rs1)) (CashFlowFrame (tail rs2)) - | fdRs1 > fdRs2 = combine cf2 cf1 - | otherwise = - let - (ts_patch,ts_keep) = splitByDate rs1 fdRs2 EqToRight - patch_bal = mflowBegBalance $ head rs2 -- `debug` ("rs2 -> \n"++ show rs2) - ts_patched = [ addFlowBalance patch_bal y | y <- ts_patch ] -- `debug` ("patch bal \n "++ show patch_bal) - sorted_cff = L.sortOn getDate (ts_keep++rs2) -- `debug` ("TS patched->\n"++ show ts_patched) - in - CashFlowFrame $ ts_patched ++ (tail (reverse (foldl reduceTs [last ts_patched] sorted_cff))) -- `debug` ("In sorted_cff"++ show sorted_cff) - where - firstDateOfCfs r = getDate $ head r -- the first date of cashflow - (fdRs1,fdRs2) = (firstDateOfCfs rs1,firstDateOfCfs rs2) - (ds1,ds2) = (getDate <$> rs1,getDate <$> rs2) +combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +combine (CashFlowFrame txn1) (CashFlowFrame txn2) = CashFlowFrame $ combineTss [] txn1 txn2 + +-- combine :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +-- -- combine two cashflow from two entities +-- combine cf1@(CashFlowFrame rs1) cf2@(CashFlowFrame []) = cf1 +-- combine cf1@(CashFlowFrame []) cf2@(CashFlowFrame rs2) = cf2 +-- combine cf1@(CashFlowFrame rs1) cf2@(CashFlowFrame rs2) +-- | ds1 == ds2 = CashFlowFrame $ (zipWith combineTs rs1 rs2) +-- | fdRs1 == fdRs2 +-- = let +-- rtr = combineTs (head rs1) (head rs2) +-- in +-- CashFlowFrame (rtr:) +-- $ combine (CashFlowFrame (tail rs1)) (CashFlowFrame (tail rs2)) +-- | fdRs1 > fdRs2 = combine cf2 cf1 +-- | otherwise = -- fdRs1 < fdRs2,means cf1 is earlier than cf2 +-- let +-- (ts_keep,ts_patch) = splitByDate rs1 fdRs2 EqToRight +-- patchBal = mflowBegBalance $ head rs2 -- `debug` ("rs2 -> \n"++ show rs2) +-- ts_patched = [ addFlowBalance patchBal y | y <- ts_patch ] -- `debug` ("patch bal \n "++ show patch_bal) +-- sorted_cff = L.sortOn getDate (ts_keep++rs2) -- `debug` ("TS patched->\n"++ show ts_patched) +-- in +-- CashFlowFrame $ ts_patched ++ (tail (reverse (foldl reduceTs [last ts_patched] sorted_cff))) -- `debug` ("In sorted_cff"++ show sorted_cff) +-- where +-- firstDateOfCfs r = getDate $ head r -- the first date of cashflow +-- (fdRs1,fdRs2) = (firstDateOfCfs rs1,firstDateOfCfs rs2) +-- (ds1,ds2) = (getDate <$> rs1,getDate <$> rs2) tsDateLT :: Date -> TsRow -> Bool tsDateLT td (CashFlow d _) = d < td tsDateLT td (BondFlow d _ _ _) = d < td -tsDateLT td (MortgageFlow d _ _ _ _ _ _ _ _ _ _ _) = d < td +tsDateLT td (MortgageDelinqFlow d _ _ _ _ _ _ _ _ _ _ _) = d < td +tsDateLT td (MortgageFlow d _ _ _ _ _ _ _ _ _ _) = d < td tsDateLT td (LoanFlow d _ _ _ _ _ _ _ _) = d < td tsDateLT td (LeaseFlow d _ _ ) = d < td tsDateLET :: Date -> TsRow -> Bool tsDateLET td (CashFlow d _) = d <= td tsDateLET td (BondFlow d _ _ _) = d <= td -tsDateLET td (MortgageFlow d _ _ _ _ _ _ _ _ _ _ _) = d <= td +tsDateLET td (MortgageDelinqFlow d _ _ _ _ _ _ _ _ _ _ _) = d <= td +tsDateLET td (MortgageFlow d _ _ _ _ _ _ _ _ _ _) = d <= td tsDateLET td (LoanFlow d _ _ _ _ _ _ _ _) = d <= td tsDateLET td (LeaseFlow d _ _ ) = d <= td @@ -294,88 +346,105 @@ aggTsByDates trs ds = mflowPrincipal :: TsRow -> Balance -mflowPrincipal (MortgageFlow _ _ x _ _ _ _ _ _ _ _ _) = x +mflowPrincipal (MortgageFlow _ _ x _ _ _ _ _ _ _ _) = x +mflowPrincipal (MortgageDelinqFlow _ _ x _ _ _ _ _ _ _ _ _) = x mflowPrincipal (LoanFlow _ _ x _ _ _ _ _ _) = x mflowPrincipal _ = error "not supported" mflowInterest :: TsRow -> Balance -mflowInterest (MortgageFlow _ _ _ x _ _ _ _ _ _ _ _) = x +mflowInterest (MortgageDelinqFlow _ _ _ x _ _ _ _ _ _ _ _) = x +mflowInterest (MortgageFlow _ _ _ x _ _ _ _ _ _ _) = x mflowInterest (LoanFlow _ _ _ x _ _ _ _ _) = x mflowInterest _ = error "not supported" mflowPrepayment :: TsRow -> Balance -mflowPrepayment (MortgageFlow _ _ _ _ x _ _ _ _ _ _ _) = x +mflowPrepayment (MortgageFlow _ _ _ _ x _ _ _ _ _ _) = x +mflowPrepayment (MortgageDelinqFlow _ _ _ _ x _ _ _ _ _ _ _) = x mflowPrepayment (LoanFlow _ _ _ _ x _ _ _ _) = x mflowPrepayment _ = error "not supported" mflowDefault :: TsRow -> Balance -mflowDefault (MortgageFlow _ _ _ _ _ _ x _ _ _ _ _) = x +mflowDefault (MortgageFlow _ _ _ _ _ x _ _ _ _ _) = x +mflowDefault (MortgageDelinqFlow _ _ _ _ _ _ x _ _ _ _ _) = x mflowDefault (LoanFlow _ _ _ _ _ x _ _ _) = x mflowDefault _ = 0 mflowRecovery :: TsRow -> Balance -mflowRecovery (MortgageFlow _ _ _ _ _ _ _ x _ _ _ _) = x +mflowRecovery (MortgageFlow _ _ _ _ _ _ x _ _ _ _) = x +mflowRecovery (MortgageDelinqFlow _ _ _ _ _ _ _ x _ _ _ _) = x mflowRecovery (LoanFlow _ _ _ _ _ _ x _ _) = x mflowRecovery _ = error "not supported" mflowBalance :: TsRow -> Balance -mflowBalance (MortgageFlow _ x _ _ _ _ _ _ _ _ _ _) = x +mflowBalance (MortgageFlow _ x _ _ _ _ _ _ _ _ _) = x +mflowBalance (MortgageDelinqFlow _ x _ _ _ _ _ _ _ _ _ _) = x mflowBalance (LoanFlow _ x _ _ _ _ _ _ _) = x mflowBalance (LeaseFlow _ x _ ) = x addFlowBalance :: Balance -> TsRow -> TsRow addFlowBalance 0 x = x -addFlowBalance b (MortgageFlow a x c d e f g h i j k l) = (MortgageFlow a (x+b) c d e f g h i j k l) -addFlowBalance b (LoanFlow a x c d e f g i j) = (LoanFlow a (x+b) c d e f g i j) -addFlowBalance b (LeaseFlow a x c ) = (LeaseFlow a (x+b) c ) +addFlowBalance b (MortgageFlow a x c d e f g h i j k ) = MortgageFlow a (x+b) c d e f g h i j k +addFlowBalance b (MortgageDelinqFlow a x c d e f g h i j k l) = MortgageDelinqFlow a (x+b) c d e f g h i j k l +addFlowBalance b (LoanFlow a x c d e f g i j) = LoanFlow a (x+b) c d e f g i j +addFlowBalance b (LeaseFlow a x c ) = LeaseFlow a (x+b) c updateFlowBalance :: Balance -> TsRow -> TsRow -updateFlowBalance b (MortgageFlow a x c d e f g h i j k l ) = (MortgageFlow a b c d e f g h i j k l) -updateFlowBalance b (LoanFlow a x c d e f g i j) = (LoanFlow a b c d e f g i j) -updateFlowBalance b (LeaseFlow a x c ) = (LeaseFlow a b c ) +updateFlowBalance b (MortgageDelinqFlow a x c d e f g h i j k l ) = MortgageDelinqFlow a b c d e f g h i j k l +updateFlowBalance b (MortgageFlow a x c d e f g h i j k ) = MortgageFlow a b c d e f g h i j k +updateFlowBalance b (LoanFlow a x c d e f g i j) = LoanFlow a b c d e f g i j +updateFlowBalance b (LeaseFlow a x c ) = LeaseFlow a b c mflowBegBalance :: TsRow -> Balance -mflowBegBalance (MortgageFlow _ x p _ ppy delinq def _ _ _ _ _) = x + p + ppy + def + delinq +mflowBegBalance (MortgageDelinqFlow _ x p _ ppy delinq def _ _ _ _ _) = x + p + ppy + delinq +mflowBegBalance (MortgageFlow _ x p _ ppy def _ _ _ _ _) = x + p + ppy + def mflowBegBalance (LoanFlow _ x p _ ppy def _ _ _) = x + p + ppy + def mflowBegBalance (LeaseFlow _ b r) = b + r mflowLoss :: TsRow -> Balance -mflowLoss (MortgageFlow _ _ _ _ _ _ _ _ x _ _ _) = x +mflowLoss (MortgageFlow _ _ _ _ _ _ _ x _ _ _) = x +mflowLoss (MortgageDelinqFlow _ _ _ _ _ _ _ _ x _ _ _) = x mflowLoss (LoanFlow _ _ _ _ _ _ _ x _) = x mflowLoss _ = 0 mflowDelinq :: TsRow -> Balance -mflowDelinq (MortgageFlow _ _ _ _ _ x _ _ _ _ _ _) = x +mflowDelinq (MortgageDelinqFlow _ _ _ _ _ x _ _ _ _ _ _) = x mflowDelinq _ = 0 mflowRate :: TsRow -> IRate -mflowRate (MortgageFlow _ _ _ _ _ _ _ _ _ x _ _) = x +-- ^ get rate(weigthed avg rate) for a cashflow record +mflowRate (MortgageFlow _ _ _ _ _ _ _ _ x _ _) = x +mflowRate (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ x _ _) = x mflowRate (LoanFlow _ _ _ _ _ _ _ _ x) = x mflowRental :: TsRow -> Amount mflowRental (LeaseFlow _ _ x ) = x mflowDate :: TsRow -> Date -mflowDate (MortgageFlow x _ _ _ _ _ _ _ _ _ _ _) = x +-- ^ get date for a cashflow record +mflowDate (MortgageFlow x _ _ _ _ _ _ _ _ _ _) = x +mflowDate (MortgageDelinqFlow x _ _ _ _ _ _ _ _ _ _ _) = x mflowDate (LoanFlow x _ _ _ _ _ _ _ _) = x mflowDate (LeaseFlow x _ _ ) = x mflowAmortAmount :: TsRow -> Balance -mflowAmortAmount (MortgageFlow _ _ p _ ppy _ def _ _ _ _ _) = p + ppy + def +-- ^ calculate amortized amount for cashflow (for defaults only) +mflowAmortAmount (MortgageFlow _ _ p _ ppy def _ _ _ _ _) = p + ppy + def +mflowAmortAmount (MortgageDelinqFlow _ _ p _ ppy delinq _ _ _ _ _ _) = p + ppy + delinq mflowAmortAmount (LoanFlow _ _ x _ y z _ _ _) = x + y + z mflowAmortAmount (LeaseFlow _ _ x ) = x --- ^ for cashflow with delinquency -mflowAmortAmount2 :: TsRow -> Balance -mflowAmortAmount2 (MortgageFlow _ _ p _ ppy delinq _ _ _ _ _ _) = p + ppy + delinq - mflowBorrowerNum :: TsRow -> Maybe BorrowerNum -mflowBorrowerNum (MortgageFlow _ _ _ _ _ _ _ _ _ _ x _) = x +-- ^ get borrower numfer for Mortgage Flow +mflowBorrowerNum (MortgageFlow _ _ _ _ _ _ _ _ _ x _) = x +mflowBorrowerNum (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ x _) = x mflowBorrowerNum _ = undefined mflowPrepaymentPenalty :: TsRow -> Balance -mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ _ (Just x)) = x -mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ _ Nothing) = 0 +-- ^ get prepayment penalty for a cashflow record +mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ (Just x)) = x +mflowPrepaymentPenalty (MortgageFlow _ _ _ _ _ _ _ _ _ _ Nothing) = 0 +mflowPrepaymentPenalty (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ _ (Just x)) = x +mflowPrepaymentPenalty (MortgageDelinqFlow _ _ _ _ _ _ _ _ _ _ _ Nothing) = 0 mflowPrepaymentPenalty _ = undefined mflowWeightAverageBalance :: Date -> Date -> [TsRow] -> Balance @@ -388,16 +457,19 @@ mflowWeightAverageBalance sd ed trs _dfs = getIntervalFactors $ sd:_ds appendCashFlow :: CashFlowFrame -> [TsRow] -> CashFlowFrame +-- ^ append cashflows to a cashflow frame appendCashFlow (CashFlowFrame _tsr) tsr = CashFlowFrame $ _tsr ++ tsr emptyTsRow :: Date -> TsRow -> TsRow -emptyTsRow _d (MortgageFlow a x c d e f g h i j k l) = (MortgageFlow _d 0 0 0 0 0 0 0 0 0 Nothing Nothing) -emptyTsRow _d (LoanFlow a x c d e f g i j) = (LoanFlow _d 0 0 0 0 0 0 0 0) -emptyTsRow _d (LeaseFlow a x c ) = (LeaseFlow _d 0 0 ) +-- ^ reset all cashflow fields to zero and init with a date +emptyTsRow _d (MortgageDelinqFlow a x c d e f g h i j k l) = MortgageDelinqFlow _d 0 0 0 0 0 0 0 0 0 Nothing Nothing +emptyTsRow _d (MortgageFlow a x c d e f g h i j k) = MortgageFlow _d 0 0 0 0 0 0 0 0 Nothing Nothing +emptyTsRow _d (LoanFlow a x c d e f g i j) = LoanFlow _d 0 0 0 0 0 0 0 0 +emptyTsRow _d (LeaseFlow a x c ) = LeaseFlow _d 0 0 --- | given a row ,build a new cf row with begin balance buildBegTsRow :: Date -> TsRow -> TsRow +-- ^ given a cashflow,build a new cf row with begin balance buildBegTsRow d tr = (tsSetBalance (mflowBalance tr + mflowAmortAmount tr)) (emptyTsRow d tr) @@ -423,20 +495,21 @@ totalRecovery :: CashFlowFrame -> Balance totalRecovery (CashFlowFrame rs) = sum $ mflowRecovery <$> rs mergePoolCf :: CashFlowFrame -> CashFlowFrame -> CashFlowFrame +-- ^ merge two cashflow frame but no patching beg balance mergePoolCf cf (CashFlowFrame []) = cf mergePoolCf (CashFlowFrame []) cf = cf mergePoolCf cf1@(CashFlowFrame txns1) cf2@(CashFlowFrame txns2) -- first day of left is earlier than right one | startDate1 > startDate2 = mergePoolCf cf2 cf1 | otherwise = let - splitDate = firstDate cf2 - (CashFlowFrame txn0,cfToBeMerged) = splitCashFlowFrameByDate cf1 splitDate EqToRight - (CashFlowFrame txn1) = combine cfToBeMerged cf2 -- `debug` ("left"++show cfToBeMerged++">> right"++ show cf2) + splitDate = firstDate cf2 -- (ls,rs) = splitByDate txns d st + (txn0,txnToMerged) = splitByDate txns1 splitDate EqToRight + txn1 = combineTss [] txnToMerged txns2 -- `debug` ("left"++show cfToBeMerged++">> right"++ show cf2) in CashFlowFrame (txn0++txn1) -- `debug` ("Txn1"++show txn1) where [startDate1,startDate2] = firstDate <$> [cf1,cf2] - rightToLeft = startDate1 >= startDate2 + -- rightToLeft = startDate1 >= startDate2 shiftCfToStartDate :: Date -> CashFlowFrame -> CashFlowFrame shiftCfToStartDate d cf@(CashFlowFrame (txn:txns)) @@ -444,7 +517,7 @@ shiftCfToStartDate d cf@(CashFlowFrame (txn:txns)) fstDate = firstDate cf diffDays = daysBetween fstDate d in - CashFlowFrame $ (tsOffsetDate diffDays) <$> (txn:txns) + CashFlowFrame $ tsOffsetDate diffDays <$> (txn:txns) sumPoolFlow :: CashFlowFrame -> PoolSource -> Balance sumPoolFlow (CashFlowFrame trs) ps @@ -467,17 +540,22 @@ lookupSource tr NewDefaults = mflowDefault tr lookupSource tr NewLosses = mflowLoss tr setPrepaymentPenalty :: Balance -> TsRow -> TsRow -setPrepaymentPenalty bal (MortgageFlow a b c d e f g h i j k l) = MortgageFlow a b c d e f g h i j k (Just bal) +setPrepaymentPenalty bal (MortgageDelinqFlow a b c d e f g h i j k l) = MortgageDelinqFlow a b c d e f g h i j k (Just bal) +setPrepaymentPenalty bal (MortgageFlow b c d e f g h i j k l) = MortgageFlow b c d e f g h i j k (Just bal) setPrepaymentPenalty _ _ = error "prepay pental only applies to MortgageFlow" setPrepaymentPenaltyFlow :: [Balance] -> [TsRow] -> [TsRow] setPrepaymentPenaltyFlow bals trs = [ setPrepaymentPenalty bal tr | (bal,tr) <- zip bals trs] splitTs :: Rate -> TsRow -> TsRow -splitTs r (MortgageFlow d bal p i ppy delinq def recovery loss rate mB mPPN) +splitTs r (MortgageDelinqFlow d bal p i ppy delinq def recovery loss rate mB mPPN) + = MortgageDelinqFlow d (mulBR bal r) (mulBR p r) (mulBR i r) (mulBR ppy r) + (mulBR delinq r) (mulBR def r) (mulBR recovery r) (mulBR loss r) + rate ((\x -> round (toRational x * r)) <$> mB) ((`mulBR` r) <$> mPPN) +splitTs r (MortgageFlow d bal p i ppy def recovery loss rate mB mPPN) = MortgageFlow d (mulBR bal r) (mulBR p r) (mulBR i r) (mulBR ppy r) - (mulBR delinq r) (mulBR def r) (mulBR recovery r) (mulBR loss r) - rate ((\x -> round (toRational x * r)) <$> mB) ((`mulBR` r) <$> mPPN) + (mulBR def r) (mulBR recovery r) (mulBR loss r) + rate ((\x -> round (toRational x * r)) <$> mB) ((`mulBR` r) <$> mPPN) splitTs _ tr = error $ "Not support for spliting TsRow"++show tr splitTrs :: Rate -> [TsRow] -> [TsRow] @@ -497,6 +575,14 @@ cutoffTrs d trs in (afterTrs, m) +patchBeginBalance :: Date -> CashFlowFrame -> CashFlowFrame +patchBeginBalance _ (CashFlowFrame []) = CashFlowFrame [] +patchBeginBalance d cf@(CashFlowFrame txns) + = let + begRow = buildBegTsRow d (head txns) + in + CashFlowFrame (begRow:txns) + $(deriveJSON defaultOptions ''TsRow) $(deriveJSON defaultOptions ''CashFlowFrame) diff --git a/src/CreditEnhancement.hs b/src/CreditEnhancement.hs index da80704f..d59dec91 100644 --- a/src/CreditEnhancement.hs +++ b/src/CreditEnhancement.hs @@ -23,6 +23,7 @@ import Data.Fixed import Data.Maybe import Types import Util +import DateUtil import Stmt type LiquidityProviderName = String diff --git a/src/DateUtil.hs b/src/DateUtil.hs new file mode 100644 index 00000000..933a1185 --- /dev/null +++ b/src/DateUtil.hs @@ -0,0 +1,306 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DateUtil( + yearCountFraction,genSerialDates,genSerialDatesTill,genSerialDatesTill2,subDates,sliceDates,SliceType(..) + ,splitByDate,projDatesByPattern +) + + where + +import qualified Data.Time as T +import Data.List +import Data.Maybe +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Ratio ((%)) +import Debug.Trace +import Data.Time (addDays) +import Types +import Data.Ix + +debug = flip trace + +-- http://www.deltaquants.com/day-count-conventions +yearCountFraction :: DayCount -> Date -> Date -> Rational --TODO https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm +yearCountFraction dc sd ed + = case dc of + DC_ACT_ACT -> if sameYear then + _diffDays % daysOfYear syear + else + (sDaysTillYearEnd % (daysOfYear syear)) + (eDaysAfterYearBeg % (daysOfYear eyear)) + (pred _diffYears) + -- `debug` ("<>"++show sDaysTillYearEnd++"<>"++show(daysOfYear syear) ++"<>"++show (daysOfYear eyear)++"<>"++ show eyear) + + DC_ACT_365F -> _diffDays % 365 -- `debug` ("DIFF Days"++show(_diffDays)) + + DC_ACT_360 -> _diffDays % 360 + + DC_ACT_365A -> if has_leap_day then + _diffDays % 366 + else + _diffDays % 365 + + DC_ACT_365L -> if T.isLeapYear eyear then + _diffDays % 366 + else + _diffDays % 365 + + DC_NL_365 -> if has_leap_day then + (pred _diffDays) % 365 + else + _diffDays % 365 + + DC_30E_360 -> let + _sday = f31to30 sday + _eday = f31to30 eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 -- `debug` ("NUM->"++show num++"E S month"++show emonth++show smonth) + + DC_30Ep_360 -> let + _sday = f31to30 sday + (_eyear,_emonth,_eday) = T.toGregorian $ + if eday==31 then + T.addDays 1 ed + else + ed + __gapMonth = (toInteger $ _emonth - smonth) % 1 + __diffYears = (toInteger $ _eyear - syear) % 1 + num = toRational (_eday - _sday) + 30*__gapMonth + 360*__diffYears + in + num / 360 + DC_30_360_ISDA -> let + _sday = f31to30 sday + _eday = if _sday>=30 && eday==31 then + 30 + else + eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 + -- 30/360 Bond basis , this was call 30E/360 ISDA by kalotay + DC_30_360_German -> let + _sday = if sday==31 || (endOfFeb syear smonth sday) then + 30 -- `debug` ("German eof start if>> "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) + else + sday + -- `debug` ("German eof start else "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) + _eday = if eday==31 || (endOfFeb eyear emonth eday) then + 30 + else + eday + -- `debug` ("German eof end "++ show (endOfFeb eyear emonth eday)++show eyear++show emonth++show eday) + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears -- `debug` ("German"++show(_sday)++"<>"++show _eday) + in + num / 360 + DC_30_360_US -> let + _sday = if (endOfFeb syear smonth sday) || sday==31 then + 30 + else + sday + _eday = if (eday==31 && sday >= 30)||(endOfFeb eyear emonth eday) && (endOfFeb syear smonth sday) then + 30 + else + eday + num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears + in + num / 360 + -- https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm + + where + daysOfYear y = if T.isLeapYear y then 366 else 365 + f31to30 d = if d==31 then + 30 + else + d + endOfFeb y m d = if T.isLeapYear y then + (m==2) && d == 29 + else + (m==2) && d == 28 + sameYear = syear == eyear + has_leap_day + = case (sameYear,sLeap,eLeap) of + (True,False,False) -> False + (True,True,_) -> inRange (sd,ed) (T.fromGregorian syear 2 29) + _ -> let + _leapDays = [ T.fromGregorian _y 2 29 | _y <- range (syear,eyear) , (T.isLeapYear _y) ] + in + any (inRange (sd,ed)) _leapDays + + _diffYears = (eyear - syear) % 1 -- Ratio Integer + _gapDay = toInteger (eday - sday) % 1 + _gapMonth = toInteger (emonth - smonth) % 1 + sDaysTillYearEnd = succ $ T.diffDays (T.fromGregorian syear 12 31) sd + eDaysAfterYearBeg = T.diffDays ed (T.fromGregorian eyear 1 1) + _diffDays = toInteger $ T.diffDays ed sd + sLeap = T.isLeapYear syear + eLeap = T.isLeapYear eyear + (syear,smonth,sday) = T.toGregorian sd + (eyear,emonth,eday) = T.toGregorian ed + +genSerialDates :: DatePattern -> Date -> Int -> Dates +genSerialDates dp sd num + = take num $ filter (>= sd) $ + case dp of + MonthEnd -> + [T.fromGregorian yearRange (fst __md) (snd __md) | yearRange <- [_y..(_y+yrs)] + ,__md <- monthEnds yearRange ] + where + yrs = fromIntegral $ div num 12 + 1 + QuarterEnd -> + [T.fromGregorian yearRange __m __d | yearRange <- [_y..(_y+yrs)] + ,(__m,__d) <- quarterEnds] + where + yrs = fromIntegral $ div num 4 + 1 + YearEnd -> + [T.fromGregorian yearRange 12 31 | yearRange <- [_y..(_y+(toInteger num))]] + YearFirst -> + [T.fromGregorian yearRange 1 1 | yearRange <- [_y..(_y+(toInteger num))]] + MonthFirst -> + [T.fromGregorian yearRange monthRange 1 | yearRange <- [_y..(_y+yrs)] + , monthRange <- [1..12]] + where + yrs = fromIntegral $ div num 12 + 1 + QuarterFirst -> + [T.fromGregorian yearRange __m 1 | yearRange <- [_y..(_y+yrs)] + ,__m <- [3,6,9,12]] + where + yrs = fromIntegral $ div num 4 + 1 + MonthDayOfYear m d -> + [T.fromGregorian yearRange m d | yearRange <- [_y..(_y+(toInteger num))]] + DayOfMonth d -> + [T.fromGregorian yearRange monthRange d | yearRange <- [_y..(_y+yrs)] + , monthRange <- [1..12]] + where + yrs = fromIntegral $ div num 12 + 1 + CustomDate ds -> ds + EveryNMonth d n -> + d:[ T.addGregorianDurationClip (T.CalendarDiffDays ((toInteger _n)*(toInteger n)) 0) d | _n <- [1..num] ] + + where + quarterEnds = [(3,31),(6,30),(9,30),(12,31)] + monthEnds y = + if T.isLeapYear y then + [(1,31),(2,29),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] + else + [(1,31),(2,28),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] + (_y,_m,_d) = T.toGregorian sd + +genSerialDatesTill:: Date -> DatePattern -> Date -> Dates +genSerialDatesTill sd ptn ed + = filter (<= ed) $ genSerialDates ptn sd (fromInteger (succ num)) --`debug` ("Num"++show num) + where + (sy,sm,sday) = T.toGregorian sd + (ey,em,eday) = T.toGregorian ed + T.CalendarDiffDays cdM cdD = T.diffGregorianDurationRollOver ed sd + num = case ptn of + MonthEnd -> cdM + QuarterEnd -> div cdM 3 + YearEnd -> div cdM 12 + MonthFirst -> cdM + QuarterFirst-> div cdM 3 + YearFirst-> div cdM 12 + MonthDayOfYear _m _d -> div cdM 12 -- T.MonthOfYear T.DayOfMonth + DayOfMonth _d -> cdM -- T.DayOfMonth + CustomDate ds -> 2 + toInteger (length ds) + EveryNMonth _d _n -> div cdM (toInteger _n) + _ -> error $ "failed to match" ++ show ptn + -- DayOfWeek Int -> -- T.DayOfWeek + +genSerialDatesTill2 :: RangeType -> Date -> DatePattern -> Date -> Dates +genSerialDatesTill2 rt sd dp ed + = case (rt, head _r==sd, last _r==ed) of + (II,True,True) -> _r + (II,True,False) -> _r ++ [ed] + (II,False,True)-> sd:_r + (II,False,False)-> sd:_r ++ [ed] + (EI,True,True) -> tail _r + (EI,True,False) -> tail _r ++ [ed] + (EI,False,True) -> _r + (EI,False,False) -> _r ++ [ed] + (IE,True,True) -> init _r + (IE,True,False) -> _r + (IE,False,True) -> sd:init _r + (IE,False,False) -> sd:_r + (EE,True,True) -> init $ tail _r + (EE,True,False) -> tail _r + (EE,False,True) -> init _r + (EE,False,False) -> _r + (NO_IE,_,_) -> _r + where + _r = case dp of + AllDatePattern dps -> concat [ genSerialDatesTill sd _dp ed | _dp <- dps ] + StartsExclusive d _dp -> filter (> d) $ genSerialDatesTill2 rt sd _dp ed + Exclude _d _dps -> + let + a = S.fromList $ genSerialDatesTill2 rt sd _d ed + b = S.fromList $ genSerialDatesTill2 rt sd (AllDatePattern _dps) ed + in + sort $ S.toList $ S.difference a b + OffsetBy _dp _n -> [ T.addDays (toInteger _n) _d | _d <- genSerialDatesTill2 rt sd _dp ed ] + _ -> genSerialDatesTill sd dp ed -- maybe sd/ed in _r + + +subDates :: RangeType -> Date -> Date -> [Date] -> [Date] +subDates rt sd ed ds + = case rt of + II -> filter (\x -> x >= sd && x <= ed ) ds + EI -> filter (\x -> x > sd && x <= ed ) ds + IE -> filter (\x -> x >= sd && x < ed ) ds + EE -> filter (\x -> x > sd && x < ed ) ds + NO_IE -> error "Need to specify II/EI/EE/IE when subset dates vector " + +data SliceType = SliceAfter Date + | SliceOnAfter Date + | SliceAfterKeepPrevious Date + | SliceOnAfterKeepPrevious Date + +sliceDates :: SliceType -> [Date] -> [Date] +sliceDates st ds = + case st of + SliceAfter d -> filter (> d) ds + SliceOnAfter d -> filter (>= d) ds + SliceAfterKeepPrevious d -> + case findIndex (> d) ds of + Just idx -> snd $ splitAt (pred idx) ds + Nothing -> [] + SliceOnAfterKeepPrevious d -> + case findIndex (>= d) ds of + Just idx -> snd $ splitAt (pred idx) ds + Nothing -> [] + + +projDatesByPattern :: DatePattern -> Date -> Date -> Dates --TODO to be replace by generateDateSeries +projDatesByPattern dp sd ed + = let + (T.CalendarDiffDays cdm cdd) = T.diffGregorianDurationClip ed sd + num = case dp of + MonthEnd -> cdm + 1 + QuarterEnd -> (div cdm 3) + 1 -- `debug` ("cdm"++show cdm) + YearEnd -> (div cdm 12) + 1 + MonthFirst -> cdm + 1 + QuarterFirst -> (div cdm 3) + 1 + YearFirst -> (div cdm 12) + 1 + MonthDayOfYear _ _ -> (div cdm 12) + 1 + DayOfMonth _ -> cdm + 1 + in + genSerialDates dp sd (fromInteger num) + +splitByDate :: TimeSeries a => [a] -> Date -> SplitType -> ([a],[a]) +splitByDate xs d st + = case st of + EqToLeft -> span (\x -> getDate x <= d) xs + EqToRight -> span (\x -> getDate x < d) xs + EqToLeftKeepOne -> + case findIndex (\x -> getDate x >= d ) xs of + Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) + Nothing -> (xs,[]) + -- EqToRightKeepOne -> + -- case findIndex (\x -> (getDate x) >= d ) xs of + -- Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) + -- Nothing -> (xs,[]) + + -- EqToLeftKeepOnes -> + -- case findIndices (\x -> (getDate x) <= d) xs of + -- [] -> (xs,[]) + -- inds -> \ No newline at end of file diff --git a/src/Deal.hs b/src/Deal.hs index 7ed8fb67..830bea99 100644 --- a/src/Deal.hs +++ b/src/Deal.hs @@ -35,6 +35,7 @@ import Deal.DealAction import Stmt import Lib import Util +import DateUtil import Types import Revolving import Triggers @@ -250,13 +251,13 @@ runTriggers t@TestDeal{status=oldStatus, triggers = Just trgM} d dcycle = -- -- runWithLog2 :: P.Asset a => TestDeal a -> Writer [ResultComponent] (TestDeal a) -run :: P.Asset a => TestDeal a -> CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe [C.CallOption] -> Maybe (RevolvingPool , AP.AssetPerf)-> [ResultComponent] -> (TestDeal a,[ResultComponent]) +run :: P.Asset a => TestDeal a -> CF.CashFlowFrame -> Maybe [ActionOnDate] -> Maybe [RateAssumption] -> Maybe [C.CallOption] -> Maybe (RevolvingPool , AP.ApplyAssumptionType)-> [ResultComponent] -> (TestDeal a,[ResultComponent]) run t@TestDeal{status=Ended} pcf ads _ _ _ log = (prepareDeal t,log) `debug` ("Deal Ended") run t pcf (Just []) _ _ _ log = (prepareDeal t,log) `debug` "End with Empty ActionOnDate" run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status=dStatus} poolFlow (Just (ad:ads)) rates calls rAssump log | (CF.sizeCashFlowFrame poolFlow == 0) && (queryDeal t AllAccBalance == 0) = let - _dealAfterCleanUp = foldl (performAction (getDate ad)) t cleanUpActions `debug` ("CleanUp deal") + _dealAfterCleanUp = foldl (performAction (getDate ad)) t cleanUpActions `debug` ("CleanUp deal:"++ (name t)) in (prepareDeal _dealAfterCleanUp,log) `debug` "End with pool cf == 0 and all account bals are 0" -- ++ "> Remain Actions" ++ show (ad:ads)) | otherwise @@ -264,17 +265,17 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= PoolCollection d _ -> if CF.sizeCashFlowFrame poolFlow > 0 then let - (collected_flow,outstanding_flow) = CF.splitCashFlowFrameByDate poolFlow d EqToLeft - accs = depositPoolInflow (collects t) d collected_flow accMap -- `debug` ("Splitting:"++show(d)++"|||"++show(collected_flow))-- `debug` ("Running AD P"++show(d)) --`debug` ("Deposit-> Collection Date "++show(d)++"with"++show(collected_flow)) - dAfterDeposit = (appendCollectedCF d t collected_flow) {accounts=accs} -- `debug` ("CF size collected"++ show (CF.getTsCashFlowFrame)) + (collectedFlow, outstandingFlow) = CF.splitCashFlowFrameByDate poolFlow d EqToLeft + accs = depositPoolInflow (collects t) d collectedFlow accMap -- `debug` ("Collected"++ show d++"pool CF\n"++ show poolFlow)-- `debug` ("Running AD P"++show(d)) --`debug` ("Deposit-> Collection Date "++show(d)++"with"++show(collected_flow)) + dAfterDeposit = (appendCollectedCF d t collectedFlow) {accounts=accs} -- `debug` ("CF size collected"++ show (CF.getTsCashFlowFrame)) (dRunWithTrigger0,newLogs0) = runTriggers dAfterDeposit d EndCollection waterfallToExe = Map.findWithDefault [] W.EndOfPoolCollection (waterfall t) -- `debug` ("AD->"++show(ad)++"remain ads"++show(length ads)) (dAfterAction,rc,newLogs) = foldl (performActionWrap d) (dRunWithTrigger0 - ,RunContext outstanding_flow rAssump rates + ,RunContext outstandingFlow rAssump rates ,log ) waterfallToExe (dRunWithTrigger1,newLogs1) = runTriggers dAfterAction d EndCollectionWF -- `debug` ("Running T end of Collection"++show (queryTrigger dAfterAction EndCollectionWF)) in - run dRunWithTrigger1 (runPoolFlow rc) (Just ads) rates calls rAssump (log++newLogs0++newLogs1) -- `debug` ("Logs"++ show d++"is"++ show log++">>"++show newLogs0++show newLogs1) + run dRunWithTrigger1 (runPoolFlow rc) (Just ads) rates calls rAssump (log++newLogs0++newLogs1) -- `debug` ("End :after new pool flow"++ show (runPoolFlow rc)) else run t (CF.CashFlowFrame []) (Just ads) rates calls rAssump log @@ -307,11 +308,13 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= let newAcc = Map.adjust (\a -> case a of - (A.Account _ _ (Just (A.BankAccount _ _ _)) _ _ ) -> (A.depositInt a d) -- `debug` ("int acc"++show accName) - (A.Account _ _ (Just (A.InvestmentAccount idx _ _ _)) _ _ ) -> + (A.Account _ _ (Just (A.BankAccount {})) _ _ ) -> (A.depositInt a d) -- `debug` ("int acc"++show accName) + (A.Account _ _ (Just (A.InvestmentAccount idx _ lastAccureDate _)) _ _ ) -> case AP.getRateAssumption (fromMaybe [] rates) idx of Nothing -> a -- `debug` ("error..."++show accName) - Just (RateCurve _ _ts) -> A.depositIntByCurve a _ts d ) -- `debug` ("int acc"++show accName) + Just (RateCurve _ _ts) -> A.depositIntByCurve a _ts d + Just (RateFlat _ r ) -> A.depositIntByCurve a (mkRateTs [(lastAccureDate,r),(d,r)]) d + _ -> error ("Failed to match index "++show idx++" In rate assumpt" ++ (name t)) ) -- `debug` ("int acc"++show accName) accName accMap in @@ -343,11 +346,12 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= DealClosed d -> let + (PreClosing newSt) = status t `debug` (">>>>>>"++ show (status t)) w = Map.findWithDefault [] W.OnClosingDay (waterfall t) -- `debug` ("DDD0") rc = RunContext poolFlow rAssump rates -- `debug` ("DDD1") - (newDeal,newRc, newLog) = foldl (performActionWrap d) (t, rc, log) w -- `debug` ("ClosingDay Action:"++show w) + (newDeal, newRc, newLog) = foldl (performActionWrap d) (t, rc, log) w -- `debug` ("ClosingDay Action:"++show w) in - run newDeal (runPoolFlow newRc) (Just ads) rates calls rAssump newLog -- `debug` ("New pool flow"++show (runPoolFlow newRc)) + run newDeal{status=newSt} (runPoolFlow newRc) (Just ads) rates calls rAssump (newLog++[DealStatusChangeTo d (PreClosing newSt) newSt]) -- `debug` ("New pool flow"++show (runPoolFlow newRc)) ChangeDealStatusTo d s -> run (t{status=s}) poolFlow (Just ads) rates calls rAssump log @@ -374,7 +378,7 @@ run t@TestDeal{accounts=accMap,fees=feeMap,triggers=mTrgMap,bonds=bndMap,status= ResetBondRate d bn -> let newBndMap = case rates of - Nothing -> error ("No rate assumption for floating bond:"++bn) + Nothing -> error ("No rate assumption for floating bond:"++bn++"Deal"++ (name t)) (Just _rates) -> Map.adjustWithKey (\k v-> setBondNewRate t d _rates v) bn @@ -457,6 +461,7 @@ runDeal t _ perfAssumps nonPerfAssumps@AP.NonPerfAssumption{AP.callWhen = opts Just _bpi -> Just (priceBonds finalDeal _bpi) -- `debug` ("Pricing with") getRunResult :: TestDeal a -> [ResultComponent] +-- ^ get bond principal and interest shortfalls from a deal getRunResult t = os_bn_i ++ os_bn_b where bs = Map.elems $ bonds t @@ -494,6 +499,7 @@ prepareDeal t@TestDeal {bonds = bndMap} -- buildCallOptions _ = Nothing appendCollectedCF :: Date -> TestDeal a -> CF.CashFlowFrame -> TestDeal a +-- ^ append cashflow frame (consolidate by a date) into deals collected pool appendCollectedCF d t (CF.CashFlowFrame []) = t appendCollectedCF d t@TestDeal { pool = mpool } cf@(CF.CashFlowFrame _trs) = case P.futureCf mpool of @@ -503,6 +509,7 @@ appendCollectedCF d t@TestDeal { pool = mpool } cf@(CF.CashFlowFrame _trs) mergedPoolStats = [CF.sumTsCF _trs d] removePoolCf :: TestDeal a -> TestDeal a +-- ^ empty deal's pool cashflow removePoolCf t@TestDeal {pool = _pool} = case P.futureCf _pool of Nothing -> t @@ -560,7 +567,7 @@ runPool (P.Pool [] (Just cf) asof _ _) Nothing _ = [(cf, Map.empty)] runPool (P.Pool [] (Just (CF.CashFlowFrame txn)) asof _ (Just dp)) (Just (AP.PoolLevel assumps)) mRates = [ P.projCashflow (ACM.ScheduleMortgageFlow asof txn dp) asof assumps mRates ] -- `debug` ("PROJ in schedule flow") -- contractual cashflow will use interest rate assumption -runPool (P.Pool as _ asof _ _) Nothing mRates = map (\x -> (P.calcCashflow x asof mRates,Map.empty)) as -- `debug` ("RUNPOOL-> calc cashflow") +runPool (P.Pool as _ asof _ _) Nothing mRates = map (\x -> (P.calcCashflow x asof mRates,Map.empty)) as -- `debug` ("RUNPOOL-> calc cashflow") -- asset cashflow with credit stress runPool (P.Pool as Nothing asof _ _) (Just (AP.PoolLevel assumps)) mRates = map (\x -> P.projCashflow x asof assumps mRates) as -- `debug` (">> Single Pool") @@ -577,7 +584,7 @@ runPool _a _b _c = error $ "Failed to match" ++ show _a ++ show _b ++ show _c getInits :: P.Asset a => TestDeal a -> Maybe AP.ApplyAssumptionType -> Maybe AP.NonPerfAssumption -> (TestDeal a,[ActionOnDate], CF.CashFlowFrame) getInits t@TestDeal{fees= feeMap,pool=thePool} mAssumps mNonPerfAssump - = (newT, allActionDates, pCollectionCfAfterCutoff) `debug` ("init done actions->"++ show (head allActionDates)) + = (newT, allActionDates, pCollectionCfAfterCutoff) -- `debug` ("init done actions->"++ show pCollectionCfAfterCutoff) where (startDate,closingDate,firstPayDate,pActionDates,bActionDates,endDate) = populateDealDates (dates t) dealStatusDates = calcDealStageDate (dates t) @@ -641,7 +648,7 @@ getInits t@TestDeal{fees= feeMap,pool=thePool} mAssumps mNonPerfAssump ,concat irSwapRateDates,inspectDates, bndRateResets,financialRptDates] -- `debug` ("fee acc dates"++show feeAccrueDates) in case dates t of - (PreClosingDates {}) -> sortBy sortActionOnDate $ (DealClosed closingDate):a -- `debug` ("add a closing date"++show closingDate) + (PreClosingDates {}) -> sortBy sortActionOnDate $ (DealClosed closingDate ):a -- `debug` ("add a closing date"++show closingDate) _ -> sortBy sortActionOnDate a in case mNonPerfAssump of @@ -669,8 +676,10 @@ getInits t@TestDeal{fees= feeMap,pool=thePool} mAssumps mNonPerfAssump -- -> Map.adjust (\x -> x {F.feeType = F.FeeFlow projectedFlow}) fn feeMap Just AP.NonPerfAssumption{AP.projectedExpense = Just pairs } -> foldr (\(feeName,feeFlow) accM -> Map.adjust (\v -> v {F.feeType = F.FeeFlow feeFlow}) feeName accM) feeMap pairs - newPoolStat = Map.unionWith (+) (fromMaybe Map.empty (P.issuanceStat thePool)) historyStats - newT = t {fees = newFeeMap, pool = thePool {P.issuanceStat = Just newPoolStat } } + -- newPoolStat = Map.unionWith (+) (fromMaybe Map.empty (P.issuanceStat thePool)) historyStats + -- newT = t {fees = newFeeMap, pool = thePool {P.issuanceStat = Just newPoolStat } } `debug` ("init with new pool stats"++ show newPoolStat) + newT = t {fees = newFeeMap } -- `debug` ("init with new pool stats"++ show newPoolStat) + depositInflow :: W.CollectionRule -> Date -> CF.TsRow -> Map.Map AccountName A.Account -> Map.Map AccountName A.Account diff --git a/src/Deal/DealAction.hs b/src/Deal/DealAction.hs index 14d2eb10..c759eeec 100644 --- a/src/Deal/DealAction.hs +++ b/src/Deal/DealAction.hs @@ -5,7 +5,8 @@ module Deal.DealAction (performActionWrap,performAction,calcDueFee ,testTrigger,RunContext(..),updateLiqProvider - ,calcDueInt,projAssetUnion,priceAssetUnion) + ,calcDueInt,projAssetUnion,priceAssetUnion + ,priceAssetUnionList) where import qualified Accounts as A @@ -34,6 +35,7 @@ import Deal.DealDate import Stmt import Lib import Util +import DateUtil import Types import Revolving import Triggers @@ -305,6 +307,13 @@ priceAssetUnion (ACM.LO m) d pm aps = P.priceAsset m d pm aps priceAssetUnion (ACM.IL m) d pm aps = P.priceAsset m d pm aps priceAssetUnion (ACM.LS m) d pm aps = P.priceAsset m d pm aps +priceAssetUnionList :: [ACM.AssetUnion] -> Date -> PricingMethod -> AP.ApplyAssumptionType -> Maybe [RateAssumption] -> [PriceResult] +priceAssetUnionList assetList d pm (AP.PoolLevel assetPerf) mRates = + let + assetPrices = [ priceAssetUnion asset d pm assetPerf mRates | asset <- assetList ] + in + assetPrices -- `debug` ("AP"++show assetPrices) + -- | this would used in `static` revolving ,which assumes the revolving pool will decrease splitAssetUnion :: [Rate] -> ACM.AssetUnion -> [ACM.AssetUnion] @@ -343,9 +352,20 @@ projAssetUnion (ACM.LO ast) d assumps mRates = P.projCashflow ast d assumps mRat projAssetUnion (ACM.IL ast) d assumps mRates = P.projCashflow ast d assumps mRates projAssetUnion (ACM.LS ast) d assumps mRates = P.projCashflow ast d assumps mRates +projAssetUnionList :: [ACM.AssetUnion] -> Date -> AP.ApplyAssumptionType -> Maybe [RateAssumption] -> (CF.CashFlowFrame, Map.Map CutoffFields Balance) +projAssetUnionList assets d (AP.PoolLevel assetPerf) mRate = + let + results = [ projAssetUnion asset d assetPerf mRate | asset <- assets ] + cfs = fst <$> results + bals = snd <$> results + in + (foldl1 CF.mergePoolCf cfs, Map.unionsWith (+) bals) + +projAssetUnionList assets d _ mRate = error " not implemented on asset level assumption for revolving pool" + data RunContext a = RunContext{ runPoolFlow:: CF.CashFlowFrame - ,revolvingAssump:: Maybe (RevolvingPool ,AP.AssetPerf) + ,revolvingAssump:: Maybe (RevolvingPool ,AP.ApplyAssumptionType) ,revolvingInterestRateAssump:: Maybe [RateAssumption] } @@ -403,35 +423,46 @@ performActionWrap d = (t { accounts = newAccMap }, newRc, logs ) where _assets = lookupAssetAvailable assetForSale d - assets = updateOriginDate2 d <$> _assets + assets = updateOriginDate2 d <$> _assets -- `debug` ("Asset on revolv"++ show _assets) - valuationOnAvailableAssets = sum [ getPriceValue (priceAssetUnion ast d pricingMethod perfAssumps mRates) | ast <- assets ] -- `debug` ("Revolving >> after shift "++ show assets) + valuationOnAvailableAssets = sum $ getPriceValue <$> priceAssetUnionList assets d pricingMethod perfAssumps mRates accBal = A.accBalance $ accsMap Map.! accName -- `debug` ("Av") limitAmt = case ml of Just (DS ds) -> queryDeal t (patchDateToStats d ds) Just (DueCapAmt amt) -> amt Nothing -> accBal - availBal = min limitAmt accBal + availBal = min limitAmt accBal -- `debug` ("Value on r -asset "++ show valuationOnAvailableAssets) purchaseAmt = case assetForSale of - (StaticAsset _) -> min availBal valuationOnAvailableAssets -- `debug` ("Valuation on rpool"++show valuationOnAvailableAssets) - ConstantAsset _ -> availBal - AssetCurve _ -> min availBal valuationOnAvailableAssets + (StaticAsset _) -> min availBal valuationOnAvailableAssets -- `debug` ("Valuation on rpool"++show valuationOnAvailableAssets) + ConstantAsset _ -> availBal + AssetCurve _ -> min availBal valuationOnAvailableAssets - purchaseRatio = purchaseAmt / valuationOnAvailableAssets + purchaseRatio = divideBB purchaseAmt valuationOnAvailableAssets -- `debug` ("Purchase Amt"++show purchaseAmt) purchaseRatios = toRational <$> [purchaseRatio,1-purchaseRatio] - (assetBought,poolAfterBought) = buyRevolvingPool d purchaseRatios assetForSale + (assetBought,poolAfterBought) = buyRevolvingPool d purchaseRatios assetForSale -- `debug` ("purchase ratio"++ show purchaseRatios) newAccMap = Map.adjust (A.draw purchaseAmt d PurchaseAsset) accName accsMap -- newBoughtPcf = (CF.shiftCfToStartDate d) <$> [ projAssetUnion ast d perfAssumps | ast <- assetBought ] - newBoughtPcf = fst <$> [ projAssetUnion (updateOriginDate2 d ast) d perfAssumps mRates | ast <- assetBought ] - poolCurrentTr = CF.buildBegTsRow d tr - currentPoolFlow = CF.cfInsertHead poolCurrentTr pcf + (CashFlowFrame newBoughtTxn) = fst $ projAssetUnionList [updateOriginDate2 d ast | ast <- assetBought ] d perfAssumps mRates -- `debug` ("Asset bought"++ show assetBought) + -- poolCurrentTr = CF.buildBegTsRow d tr + -- currentPoolFlow = CF.cfInsertHead poolCurrentTr pcf -- `debug` ("Inserting new tr"++ show poolCurrentTr) + -- currentPoolFlow = CF.patchBeginBalance d pcf --newPcf = foldl CF.mergePoolCf pcf newBoughtPcf `debug` ("reolvoing cf"++show d++"\n"++show newBoughtPcf++"\n"++"pool cf 1st"++show (CF.cfAt pcf 0)) - newPcf = foldl CF.mergePoolCf currentPoolFlow newBoughtPcf -- `debug` ("reolvoing cf"++show d++"\n"++show newBoughtPcf++"\n"++"pool cf 1st"++show (CF.cfAt pcf 0)) + -- newPcf = CF.CashFlowFrame $ CF.mergePoolCf currentPoolFlow newBoughtPcf -- `debug` ("reolvoing after insert"++ show currentPoolFlow) + newPcf = CF.CashFlowFrame $ CF.combineTss [] (tr:trs) newBoughtTxn -- `debug` ("reolvoing first txn\n"++ show (head newBoughtTxn)) newRc = rc {runPoolFlow = newPcf - ,revolvingAssump = Just (poolAfterBought,perfAssumps)} -- `debug` ("new pool flow"++show newPcf) + ,revolvingAssump = Just (poolAfterBought, perfAssumps)} -- `debug` ("new pool flow\n"++show newPcf++"\n") + +performActionWrap d + (t + ,rc@RunContext{runPoolFlow=pcf@(CF.CashFlowFrame (tr:trs)) + ,revolvingAssump=Nothing + ,revolvingInterestRateAssump = mRates} + ,logs) + (W.BuyAsset ml pricingMethod accName) + = error $ "Missing revolving Assumption(asset assumption & asset to buy)" ++ show (name t) performActionWrap d (t, rc, logs) (W.WatchVal ms dss) = (t, rc, newLogs ++ logs) @@ -773,7 +804,7 @@ performAction d t@TestDeal{liqProvider = Just _liqProvider} (W.LiqAccrue n) performAction d t@TestDeal{rateSwap = Just rtSwap } (W.SwapAccrue sName) = t { rateSwap = Just newRtSwap } where - refBal = case (HE.rsNotional (rtSwap Map.! sName)) of + refBal = case HE.rsNotional (rtSwap Map.! sName) of (HE.Fixed b) -> b (HE.Base ds) -> queryDeal t (patchDateToStats d ds) (HE.Schedule ts) -> fromRational $ getValByDate ts Inc d @@ -812,4 +843,4 @@ performAction d t@TestDeal{ triggers = Just trgM } (W.RunTrigger loc tName) where newMap = Map.adjust (updateTrigger t d) tName (trgM Map.! loc) -performAction d t action = error $ "failed to match action"++show action +performAction d t action = error $ "failed to match action"++show action++"Deal"++show (name t) diff --git a/src/Deal/DealBase.hs b/src/Deal/DealBase.hs index a58025b3..4705d442 100644 --- a/src/Deal/DealBase.hs +++ b/src/Deal/DealBase.hs @@ -45,26 +45,24 @@ class SPV a where getFeeByName :: a -> Maybe [String] -> Map.Map String F.Fee getAccountByName :: a -> Maybe [String] -> Map.Map String A.Account -data TestDeal a = TestDeal { - name :: String - ,status :: DealStatus - ,dates :: DateDesp - ,accounts :: Map.Map AccountName A.Account - ,fees :: Map.Map FeeName F.Fee - ,bonds :: Map.Map BondName L.Bond - ,pool :: P.Pool a - ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq - ,collects :: [W.CollectionRule] - ,call :: Maybe [C.CallOption] - ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) - ,rateSwap :: Maybe (Map.Map String HE.RateSwap) - ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) - ,custom:: Maybe (Map.Map String CustomDataType) - ,triggers :: Maybe (Map.Map DealCycle - (Map.Map String Trigger)) - ,overrides :: Maybe [OverrideType] - ,ledgers :: Maybe (Map.Map String LD.Ledger) -} deriving (Show,Generic) +data TestDeal a = TestDeal { name :: String + ,status :: DealStatus + ,dates :: DateDesp + ,accounts :: Map.Map AccountName A.Account + ,fees :: Map.Map FeeName F.Fee + ,bonds :: Map.Map BondName L.Bond + ,pool :: P.Pool a + ,waterfall :: Map.Map W.ActionWhen W.DistributionSeq + ,collects :: [W.CollectionRule] + ,call :: Maybe [C.CallOption] + ,liqProvider :: Maybe (Map.Map String CE.LiqFacility) + ,rateSwap :: Maybe (Map.Map String HE.RateSwap) + ,currencySwap :: Maybe (Map.Map String HE.CurrencySwap) + ,custom:: Maybe (Map.Map String CustomDataType) + ,triggers :: Maybe (Map.Map DealCycle (Map.Map String Trigger)) + ,overrides :: Maybe [OverrideType] + ,ledgers :: Maybe (Map.Map String LD.Ledger) + } deriving (Show,Generic) instance SPV (TestDeal a) where getBondByName t bns diff --git a/src/Deal/DealQuery.hs b/src/Deal/DealQuery.hs index 5ba6d460..a7d50f95 100644 --- a/src/Deal/DealQuery.hs +++ b/src/Deal/DealQuery.hs @@ -25,6 +25,7 @@ import qualified Triggers as Trg import qualified CreditEnhancement as CE import Stmt import Util +import DateUtil import Lib import Debug.Trace @@ -184,8 +185,12 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM OriginalPoolBalance -> case P.issuanceStat (pool t) of - Just m -> Map.findWithDefault (-1) IssuanceBalance m -- `debug` (">>>>"++show(m)) - Nothing -> foldl (\acc x -> acc + P.getOriginBal x) 0.0 (P.assets (pool t)) + -- use issuance balance from map if the map exists + Just m -> + case Map.lookup IssuanceBalance m of + Just v -> v + Nothing -> error "No issuance balance found in the pool, pls specify it in the pool stats map `issuanceStat`" + Nothing -> error ("No stat found in the pool, pls specify it in the pool stats map `issuanceStat` Deal:" ++ show (name t)) CurrentPoolBorrowerNum -> fromRational $ toRational $ foldl (\acc x -> acc + P.getBorrowerNum x) 0 (P.assets (pool t)) -- `debug` ("Qurey loan level asset balance") @@ -245,15 +250,19 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM sliceBy II fromDay asOfDay trs else sliceBy EI fromDay asOfDay trs + _ -> [] CumulativePoolDefaultedBalance -> let futureDefaults = case P.futureCf (pool t) of Just (CF.CashFlowFrame _historyTxn) -> sum $ CF.tsDefaultBal <$> _historyTxn Nothing -> 0.0 -- `debug` ("Geting future defaults"++show futureDefaults) - currentDefaults = queryDeal t CurrentPoolDefaultedBalance + + historyDefaults = case P.issuanceStat (pool t) of + Just m -> Map.findWithDefault 0.0 HistoryDefaults m + Nothing -> 0.0 in - futureDefaults + currentDefaults + futureDefaults + historyDefaults -- `debug` ("history defaults"++ show historyDefaults) CumulativePoolRecoveriesBalance -> let diff --git a/src/Expense.hs b/src/Expense.hs index 99165e7f..cd7896a6 100644 --- a/src/Expense.hs +++ b/src/Expense.hs @@ -22,6 +22,7 @@ import GHC.Generics import Data.Fixed import Types import Util +import DateUtil import qualified Stmt as S import Debug.Trace diff --git a/src/Hastructure.code-workspace b/src/Hastructure.code-workspace new file mode 100644 index 00000000..ba3807e2 --- /dev/null +++ b/src/Hastructure.code-workspace @@ -0,0 +1,13 @@ +{ + "folders": [ + { + "path": ".." + }, + { + "path": "../../absbox-doc" + } + ], + "settings": { + "esbonio.sphinx.confDir": "" + } +} \ No newline at end of file diff --git a/src/Hedge.hs b/src/Hedge.hs index 92d807e5..515889bd 100644 --- a/src/Hedge.hs +++ b/src/Hedge.hs @@ -24,6 +24,7 @@ import Data.Maybe import Types import Util import Stmt +import DateUtil import Debug.Trace debug = flip trace diff --git a/src/InterestRate.hs b/src/InterestRate.hs index c725d96f..695911ef 100644 --- a/src/InterestRate.hs +++ b/src/InterestRate.hs @@ -15,6 +15,7 @@ import Data.Aeson.TH import Data.Maybe import Data.Fixed import GHC.Generics +import DateUtil import Types ( RoundingBy, diff --git a/src/Liability.hs b/src/Liability.hs index 218bd424..87d8975b 100644 --- a/src/Liability.hs +++ b/src/Liability.hs @@ -22,6 +22,7 @@ import Lib (Period(..),Ts(..) ,TsPoint(..) ,toDate,daysBetween ,getIntervalFactors,daysBetweenI) import Util +import DateUtil import Types import Analytics import Data.Ratio diff --git a/src/Reports.hs b/src/Reports.hs index 17c321ef..bd3692c4 100644 --- a/src/Reports.hs +++ b/src/Reports.hs @@ -43,16 +43,18 @@ import Stmt patchFinancialReports :: P.Asset a => TestDeal a -> Date -> [ResultComponent] -> [ResultComponent] patchFinancialReports t d [] = [] patchFinancialReports t d logs - = case (find (\(FinancialReport _ _ _ _) -> True) (reverse logs)) of - Nothing -> [] + = case (find pickReportLog (reverse logs)) of + Nothing -> logs Just (FinancialReport sd ed bs cash) -> let bsReport = buildBalanceSheet t d cashReport = buildCashReport t ed d newlog = FinancialReport ed d bsReport cashReport in - logs++[newlog] - + logs++[newlog] + where + pickReportLog FinancialReport {} = True + pickReportLog _ = False getItemBalance :: BookItem -> Balance getItemBalance (Item _ bal) = bal diff --git a/src/Stmt.hs b/src/Stmt.hs index 693b80ed..c39f6e6f 100644 --- a/src/Stmt.hs +++ b/src/Stmt.hs @@ -191,7 +191,7 @@ getFlow comment = Inflow else Noneflow - TransferBy {} -> Noneflow + TransferBy {} -> Interflow _ -> error ("Missing in GetFlow >> "++ show comment) instance Ord Txn where diff --git a/src/Types.hs b/src/Types.hs index 374c915c..f44a16be 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -44,6 +44,7 @@ import Data.Fixed import Data.Ix import Data.List +-- import Cashflow (CashFlowFrame) type BondName = String type BondNames = [String] @@ -159,14 +160,14 @@ data DateDesp = FixInterval (Map.Map DateType Date) Period Period | CurrentDates (Date,Date) (Maybe Date) Date DateVector DateVector deriving (Show,Eq, Generic) -data ActionOnDate = EarnAccInt Date AccName -- sweep bank account interest +data ActionOnDate = EarnAccInt Date AccName -- ^ sweep bank account interest | ChangeDealStatusTo Date DealStatus -- ^ change deal status | AccrueFee Date FeeName -- ^ accure fee | ResetLiqProvider Date String -- ^ reset credit for liquidity provider | ResetLiqProviderRate Date String -- ^ accure interest/premium amount for liquidity provider | PoolCollection Date String -- ^ collect pool cashflow and deposit to accounts | RunWaterfall Date String -- ^ execute waterfall - | DealClosed Date -- ^ actions to perform at the deal closing day + | DealClosed Date -- ^ actions to perform at the deal closing day, and enter a new deal status | InspectDS Date DealStats -- ^ inspect formula | ResetIRSwapRate Date String -- ^ reset interest rate swap dates | ResetBondRate Date String -- ^ reset bond interest rate per bond's interest rate info @@ -180,7 +181,7 @@ instance TimeSeries ActionOnDate where getDate (PoolCollection d _) = d getDate (EarnAccInt d _) = d getDate (AccrueFee d _) = d - getDate (DealClosed d ) = d + getDate (DealClosed d) = d getDate (ChangeDealStatusTo d _ ) = d getDate (InspectDS d _ ) = d getDate (ResetIRSwapRate d _ ) = d @@ -221,10 +222,11 @@ data OverrideType = CustomActionOnDates [ActionOnDate] data DealStatus = DealAccelerated (Maybe Date) -- ^ Deal is accelerated status with optinal accerlerated date | DealDefaulted (Maybe Date) -- ^ Deal is defaulted status with optinal default date | Amortizing -- ^ Deal is amortizing - | Revolving - | Ended -- ^ Deal was marked as closed - | PreClosing -- ^ Deal was not closed - | Called -- ^ Deal was called + | Revolving -- ^ Deal is revolving + | RampUp -- ^ Deal is being ramping up + | Ended -- ^ Deal is marked as closed + | PreClosing DealStatus -- ^ Deal is not closed + | Called -- ^ Deal is called deriving (Show,Ord,Eq,Read, Generic) data DealCycle = EndCollection -- ^ | collection period collection action , waterfall action @@ -586,6 +588,7 @@ data ResultComponent = CallAt Date -- ^ the d | InspectRate Date DealStats Micro | InspectBool Date DealStats Bool | FinancialReport StartDate EndDate BalanceSheetReport CashflowReport + -- | SnapshotCashflow Date String CashFlowFrame deriving (Show, Generic) data Threshold = Below diff --git a/src/Util.hs b/src/Util.hs index 10084a18..8fbb2fa0 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -2,12 +2,11 @@ {-# LANGUAGE ScopedTypeVariables #-} module Util - (mulBR,mulBIR,mulBI,mulBInt,mulBInteger,lastN,yearCountFraction,genSerialDates - ,getValByDate,getValByDates,projDatesByPattern - ,genSerialDatesTill,genSerialDatesTill2,subDates,sliceDates,SliceType(..) + (mulBR,mulBIR,mulBI,mulBInt,mulBInteger,lastN + ,getValByDate,getValByDates ,calcInt,calcIntRate,calcIntRateCurve,divideBB ,multiplyTs,zipTs,getTsVals,divideBI,mulIR, daysInterval - ,replace,paddingDefault, capWith, splitByDate, getTsDates + ,replace,paddingDefault, capWith, getTsDates ,shiftTsByAmt,calcWeigthBalanceByDates, monthsAfter ,getPriceValue,maximum',minimum',roundingBy,roundingByM ,floorWith,slice,toPeriodRateByInterval @@ -23,9 +22,10 @@ import Data.Ix import Data.Maybe import qualified Data.Map as M import qualified Data.Set as S - +import DateUtil import Lib import Types +import DateUtil import Text.Printf import Control.Exception @@ -67,224 +67,6 @@ zipLeftover (x:xs) (y:ys) = zipLeftover xs ys lastN :: Int -> [a] -> [a] lastN n xs = zipLeftover (drop n xs) xs --- http://www.deltaquants.com/day-count-conventions -yearCountFraction :: DayCount -> Date -> Date -> Rational --TODO https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm -yearCountFraction dc sd ed - = case dc of - DC_ACT_ACT -> if sameYear then - _diffDays % daysOfYear syear - else - (sDaysTillYearEnd % (daysOfYear syear)) + (eDaysAfterYearBeg % (daysOfYear eyear)) + (pred _diffYears) - -- `debug` ("<>"++show sDaysTillYearEnd++"<>"++show(daysOfYear syear) ++"<>"++show (daysOfYear eyear)++"<>"++ show eyear) - - DC_ACT_365F -> _diffDays % 365 -- `debug` ("DIFF Days"++show(_diffDays)) - - DC_ACT_360 -> _diffDays % 360 - - DC_ACT_365A -> if has_leap_day then - _diffDays % 366 - else - _diffDays % 365 - - DC_ACT_365L -> if T.isLeapYear eyear then - _diffDays % 366 - else - _diffDays % 365 - - DC_NL_365 -> if has_leap_day then - (pred _diffDays) % 365 - else - _diffDays % 365 - - DC_30E_360 -> let - _sday = f31to30 sday - _eday = f31to30 eday - num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears - in - num / 360 -- `debug` ("NUM->"++show num++"E S month"++show emonth++show smonth) - - DC_30Ep_360 -> let - _sday = f31to30 sday - (_eyear,_emonth,_eday) = T.toGregorian $ - if eday==31 then - T.addDays 1 ed - else - ed - __gapMonth = (toInteger $ _emonth - smonth) % 1 - __diffYears = (toInteger $ _eyear - syear) % 1 - num = toRational (_eday - _sday) + 30*__gapMonth + 360*__diffYears - in - num / 360 - DC_30_360_ISDA -> let - _sday = f31to30 sday - _eday = if _sday>=30 && eday==31 then - 30 - else - eday - num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears - in - num / 360 - -- 30/360 Bond basis , this was call 30E/360 ISDA by kalotay - DC_30_360_German -> let - _sday = if sday==31 || (endOfFeb syear smonth sday) then - 30 -- `debug` ("German eof start if>> "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) - else - sday - -- `debug` ("German eof start else "++ show (endOfFeb syear smonth sday)++show syear ++show smonth++show sday) - _eday = if eday==31 || (endOfFeb eyear emonth eday) then - 30 - else - eday - -- `debug` ("German eof end "++ show (endOfFeb eyear emonth eday)++show eyear++show emonth++show eday) - num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears -- `debug` ("German"++show(_sday)++"<>"++show _eday) - in - num / 360 - DC_30_360_US -> let - _sday = if (endOfFeb syear smonth sday) || sday==31 then - 30 - else - sday - _eday = if (eday==31 && sday >= 30)||(endOfFeb eyear emonth eday) && (endOfFeb syear smonth sday) then - 30 - else - eday - num = toRational (_eday - _sday) + 30*_gapMonth + 360*_diffYears - in - num / 360 - -- https://www.iso20022.org/15022/uhb/mt565-16-field-22f.htm - - where - daysOfYear y = if T.isLeapYear y then 366 else 365 - f31to30 d = if d==31 then - 30 - else - d - endOfFeb y m d = if T.isLeapYear y then - (m==2) && d == 29 - else - (m==2) && d == 28 - sameYear = syear == eyear - has_leap_day - = case (sameYear,sLeap,eLeap) of - (True,False,False) -> False - (True,True,_) -> inRange (sd,ed) (T.fromGregorian syear 2 29) - _ -> let - _leapDays = [ T.fromGregorian _y 2 29 | _y <- range (syear,eyear) , (T.isLeapYear _y) ] - in - any (inRange (sd,ed)) _leapDays - - _diffYears = (eyear - syear) % 1 -- Ratio Integer - _gapDay = toInteger (eday - sday) % 1 - _gapMonth = toInteger (emonth - smonth) % 1 - sDaysTillYearEnd = succ $ T.diffDays (T.fromGregorian syear 12 31) sd - eDaysAfterYearBeg = T.diffDays ed (T.fromGregorian eyear 1 1) - _diffDays = toInteger $ T.diffDays ed sd - sLeap = T.isLeapYear syear - eLeap = T.isLeapYear eyear - (syear,smonth,sday) = T.toGregorian sd - (eyear,emonth,eday) = T.toGregorian ed - -genSerialDates :: DatePattern -> Date -> Int -> Dates -genSerialDates dp sd num - = take num $ filter (>= sd) $ - case dp of - MonthEnd -> - [T.fromGregorian yearRange (fst __md) (snd __md) | yearRange <- [_y..(_y+yrs)] - ,__md <- monthEnds yearRange ] - where - yrs = fromIntegral $ div num 12 + 1 - QuarterEnd -> - [T.fromGregorian yearRange __m __d | yearRange <- [_y..(_y+yrs)] - ,(__m,__d) <- quarterEnds] - where - yrs = fromIntegral $ div num 4 + 1 - YearEnd -> - [T.fromGregorian yearRange 12 31 | yearRange <- [_y..(_y+(toInteger num))]] - YearFirst -> - [T.fromGregorian yearRange 1 1 | yearRange <- [_y..(_y+(toInteger num))]] - MonthFirst -> - [T.fromGregorian yearRange monthRange 1 | yearRange <- [_y..(_y+yrs)] - , monthRange <- [1..12]] - where - yrs = fromIntegral $ div num 12 + 1 - QuarterFirst -> - [T.fromGregorian yearRange __m 1 | yearRange <- [_y..(_y+yrs)] - ,__m <- [3,6,9,12]] - where - yrs = fromIntegral $ div num 4 + 1 - MonthDayOfYear m d -> - [T.fromGregorian yearRange m d | yearRange <- [_y..(_y+(toInteger num))]] - DayOfMonth d -> - [T.fromGregorian yearRange monthRange d | yearRange <- [_y..(_y+yrs)] - , monthRange <- [1..12]] - where - yrs = fromIntegral $ div num 12 + 1 - CustomDate ds -> ds - EveryNMonth d n -> - d:[ T.addGregorianDurationClip (T.CalendarDiffDays ((toInteger _n)*(toInteger n)) 0) d | _n <- [1..num] ] - - where - quarterEnds = [(3,31),(6,30),(9,30),(12,31)] - monthEnds y = - if T.isLeapYear y then - [(1,31),(2,29),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] - else - [(1,31),(2,28),(3,31),(4,30),(5,31),(6,30),(7,31),(8,31),(9,30),(10,31),(11,30),(12,31)] - (_y,_m,_d) = T.toGregorian sd - -genSerialDatesTill:: Date -> DatePattern -> Date -> Dates -genSerialDatesTill sd ptn ed - = filter (<= ed) $ genSerialDates ptn sd (fromInteger (succ num)) --`debug` ("Num"++show num) - where - (sy,sm,sday) = T.toGregorian sd - (ey,em,eday) = T.toGregorian ed - T.CalendarDiffDays cdM cdD = T.diffGregorianDurationRollOver ed sd - num = case ptn of - MonthEnd -> cdM - QuarterEnd -> div cdM 3 - YearEnd -> div cdM 12 - MonthFirst -> cdM - QuarterFirst-> div cdM 3 - YearFirst-> div cdM 12 - MonthDayOfYear _m _d -> div cdM 12 -- T.MonthOfYear T.DayOfMonth - DayOfMonth _d -> cdM -- T.DayOfMonth - CustomDate ds -> 2 + toInteger (length ds) - EveryNMonth _d _n -> div cdM (toInteger _n) - _ -> error $ "failed to match" ++ show ptn - -- DayOfWeek Int -> -- T.DayOfWeek - -genSerialDatesTill2 :: RangeType -> Date -> DatePattern -> Date -> Dates -genSerialDatesTill2 rt sd dp ed - = case (rt, head _r==sd, last _r==ed) of - (II,True,True) -> _r - (II,True,False) -> _r ++ [ed] - (II,False,True)-> sd:_r - (II,False,False)-> sd:_r ++ [ed] - (EI,True,True) -> tail _r - (EI,True,False) -> tail _r ++ [ed] - (EI,False,True) -> _r - (EI,False,False) -> _r ++ [ed] - (IE,True,True) -> init _r - (IE,True,False) -> _r - (IE,False,True) -> sd:init _r - (IE,False,False) -> sd:_r - (EE,True,True) -> init $ tail _r - (EE,True,False) -> tail _r - (EE,False,True) -> init _r - (EE,False,False) -> _r - (NO_IE,_,_) -> _r - where - _r = case dp of - AllDatePattern dps -> concat [ genSerialDatesTill sd _dp ed | _dp <- dps ] - StartsExclusive d _dp -> filter (> d) $ genSerialDatesTill2 rt sd _dp ed - Exclude _d _dps -> - let - a = S.fromList $ genSerialDatesTill2 rt sd _d ed - b = S.fromList $ genSerialDatesTill2 rt sd (AllDatePattern _dps) ed - in - sort $ S.toList $ S.difference a b - OffsetBy _dp _n -> [ T.addDays (toInteger _n) _d | _d <- genSerialDatesTill2 rt sd _dp ed ] - _ -> genSerialDatesTill sd dp ed -- maybe sd/ed in _r tsPointVal :: TsPoint a -> a @@ -378,33 +160,6 @@ getTsDates (FloatCurve tps) = map getDate tps getTsDates (PricingCurve tps) = map getDate tps getTsDates (BalanceCurve tps) = map getDate tps -subDates :: RangeType -> Date -> Date -> [Date] -> [Date] -subDates rt sd ed ds - = case rt of - II -> filter (\x -> x >= sd && x <= ed ) ds - EI -> filter (\x -> x > sd && x <= ed ) ds - IE -> filter (\x -> x >= sd && x < ed ) ds - EE -> filter (\x -> x > sd && x < ed ) ds - NO_IE -> error "Need to specify II/EI/EE/IE when subset dates vector " - -data SliceType = SliceAfter Date - | SliceOnAfter Date - | SliceAfterKeepPrevious Date - | SliceOnAfterKeepPrevious Date - -sliceDates :: SliceType -> [Date] -> [Date] -sliceDates st ds = - case st of - SliceAfter d -> filter (> d) ds - SliceOnAfter d -> filter (>= d) ds - SliceAfterKeepPrevious d -> - case findIndex (> d) ds of - Just idx -> snd $ splitAt (pred idx) ds - Nothing -> [] - SliceOnAfterKeepPrevious d -> - case findIndex (>= d) ds of - Just idx -> snd $ splitAt (pred idx) ds - Nothing -> [] calcIntRate :: Date -> Date -> IRate -> DayCount -> IRate calcIntRate start_date end_date int_rate day_count = @@ -431,21 +186,7 @@ multiplyTs :: CutoffType -> Ts -> Ts -> Ts multiplyTs ct (FloatCurve ts1) ts2 = FloatCurve [(TsPoint d (v * (getValByDate ts2 ct d))) | (TsPoint d v) <- ts1 ] -projDatesByPattern :: DatePattern -> Date -> Date -> Dates --TODO to be replace by generateDateSeries -projDatesByPattern dp sd ed - = let - (T.CalendarDiffDays cdm cdd) = T.diffGregorianDurationClip ed sd - num = case dp of - MonthEnd -> cdm + 1 - QuarterEnd -> (div cdm 3) + 1 -- `debug` ("cdm"++show cdm) - YearEnd -> (div cdm 12) + 1 - MonthFirst -> cdm + 1 - QuarterFirst -> (div cdm 3) + 1 - YearFirst -> (div cdm 12) + 1 - MonthDayOfYear _ _ -> (div cdm 12) + 1 - DayOfMonth _ -> cdm + 1 - in - genSerialDates dp sd (fromInteger num) + -- | swap a value in list with index supplied replace :: [a] -> Int -> a -> [a] @@ -472,24 +213,7 @@ floorWith floor xs = [ max x floor | x <- xs] daysInterval :: [Date] -> [Integer] daysInterval ds = zipWith daysBetween (init ds) (tail ds) -splitByDate :: TimeSeries a => [a] -> Date -> SplitType -> ([a],[a]) -splitByDate xs d st - = case st of - EqToLeft -> span (\x -> getDate x <= d) xs - EqToRight -> span (\x -> getDate x < d) xs - EqToLeftKeepOne -> - case findIndex (\x -> getDate x >= d ) xs of - Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) - Nothing -> (xs,[]) - -- EqToRightKeepOne -> - -- case findIndex (\x -> (getDate x) >= d ) xs of - -- Just idx -> splitAt (pred idx) xs -- `debug` ("split with "++show (pred idx)++">>"++show (length xs)) - -- Nothing -> (xs,[]) - - -- EqToLeftKeepOnes -> - -- case findIndices (\x -> (getDate x) <= d) xs of - -- [] -> (xs,[]) - -- inds -> + debugLine :: Show a => [a] -> String debugLine xs = "" diff --git a/swagger.json b/swagger.json index 759e9179..bd4fdbf5 100644 --- a/swagger.json +++ b/swagger.json @@ -968,6 +968,72 @@ "contents" ] }, + { + "type": "object", + "properties": { + "contents": { + "items": [ + { + "$ref": "#/components/schemas/Day" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-2, + "type": "number" + }, + { + "multipleOf": 1.0e-6, + "type": "number" + }, + { + "maximum": 9223372036854775807, + "type": "integer", + "minimum": -9223372036854775808 + }, + { + "multipleOf": 1.0e-2, + "type": "number" + } + ], + "maxItems": 11, + "type": "array", + "minItems": 11 + }, + "tag": { + "type": "string", + "enum": [ + "MortgageFlow" + ] + } + }, + "required": [ + "tag", + "contents" + ] + }, { "type": "object", "properties": { @@ -1029,7 +1095,7 @@ "tag": { "type": "string", "enum": [ - "MortgageFlow" + "MortgageDelinqFlow" ] } }, @@ -2921,20 +2987,7 @@ "$ref": "#/components/schemas/RevolvingPool" }, { - "items": [ - { - "$ref": "#/components/schemas/AssetPerfAssumption" - }, - { - "$ref": "#/components/schemas/AssetDelinqPerfAssumption" - }, - { - "$ref": "#/components/schemas/AssetDefaultedPerfAssumption" - } - ], - "maxItems": 3, - "type": "array", - "minItems": 3 + "$ref": "#/components/schemas/ApplyAssumptionType" } ], "maxItems": 2, @@ -9983,6 +10036,20 @@ "tag" ] }, + { + "type": "object", + "properties": { + "tag": { + "type": "string", + "enum": [ + "RampUp" + ] + } + }, + "required": [ + "tag" + ] + }, { "type": "object", "properties": { @@ -10000,6 +10067,9 @@ { "type": "object", "properties": { + "contents": { + "$ref": "#/components/schemas/DealStatus" + }, "tag": { "type": "string", "enum": [ @@ -10008,7 +10078,8 @@ } }, "required": [ - "tag" + "tag", + "contents" ] }, { @@ -11627,7 +11698,7 @@ } }, "info": { - "version": "0.21.2", + "version": "0.21.7", "title": "Hastructure API", "license": { "name": "BSD 3" diff --git a/test/MainTest.hs b/test/MainTest.hs index 49878f4f..f4720999 100644 --- a/test/MainTest.hs +++ b/test/MainTest.hs @@ -43,6 +43,7 @@ tests = testGroup "Tests" [AT.mortgageTests ,CFT.testMergePoolCf ,CFT.combineTest ,CFT.testHaircut + ,CFT.testMergeTsRowsFromTwoEntities ,BT.pricingTests ,BT.bndUtilTest ,LT.curveTests diff --git a/test/UT/AccountTest.hs b/test/UT/AccountTest.hs index 2f0c3abd..ec896158 100644 --- a/test/UT/AccountTest.hs +++ b/test/UT/AccountTest.hs @@ -7,6 +7,7 @@ import Accounts import Lib import Stmt import Util +import DateUtil import Types import Deal import Deal.DealBase @@ -70,11 +71,11 @@ reserveAccTest = acc2 = Account 150 "A2" Nothing (Just (FixReserve 210)) Nothing accMap = Map.fromList [("A1",acc1),("A2",acc2)] testCFs = CF.CashFlowFrame - [CF.MortgageFlow (toDate "20220601") 150 20 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (toDate "20220701") 130 20 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (toDate "20220801") 110 20 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (toDate "20220901") 90 20 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (toDate "20221001") 70 20 10 0 0 0 0 0 0 Nothing Nothing] + [CF.MortgageFlow (toDate "20220601") 150 20 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (toDate "20220701") 130 20 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (toDate "20220801") 110 20 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (toDate "20220901") 90 20 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (toDate "20221001") 70 20 10 0 0 0 0 0 Nothing Nothing] ttd = (setFutureCF td2 testCFs) {accounts = accMap} in testGroup "Test On Reserve Acc" diff --git a/test/UT/AssetTest.hs b/test/UT/AssetTest.hs index 6923630e..a673ab7f 100644 --- a/test/UT/AssetTest.hs +++ b/test/UT/AssetTest.hs @@ -322,35 +322,35 @@ armTest = (CF.sizeCashFlowFrame arm1_cf) ,testCase "ARM case 1/ first cash" $ assertEqual "first cash row" - (Just (CF.MortgageFlow (L.toDate "20240501") 227.66 12.34 0.6 0 0 0 0 0 0.03 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20240501") 227.66 12.34 0.6 0 0 0 0 0.03 Nothing Nothing )) (CF.cfAt arm1_cf 0) ,testCase "ARM case 1/ frist reset" $ assertEqual "first rate" - (Just (CF.MortgageFlow (L.toDate "20240601") 215.41 12.25 0.85 0 0 0 0 0 0.045 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20240601") 215.41 12.25 0.85 0 0 0 0 0.045 Nothing Nothing )) (CF.cfAt arm1_cf 1) ,testCase "ARM case 1/periodic reset " $ assertEqual "first rate" - (Just (CF.MortgageFlow (L.toDate "20240801") 190.85 12.26 0.93 0 0 0 0 0 0.055 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20240801") 190.85 12.26 0.93 0 0 0 0 0.055 Nothing Nothing )) (CF.cfAt arm1_cf 3) ,testCase "ARM case 1/remains same before next reset" $ assertEqual "period before first reset" - (Just (CF.MortgageFlow (L.toDate "20240901") 178.53 12.32 0.87 0 0 0 0 0 0.055 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20240901") 178.53 12.32 0.87 0 0 0 0 0.055 Nothing Nothing )) (CF.cfAt arm1_cf 4) ,testCase "ARM case 1" $ assertEqual "reset with periodic cap" - (Just (CF.MortgageFlow (L.toDate "20241201") 141.47 12.38 0.96 0 0 0 0 0 0.075 Nothing Nothing)) + (Just (CF.MortgageFlow (L.toDate "20241201") 141.47 12.38 0.96 0 0 0 0 0.075 Nothing Nothing)) (CF.cfAt arm1_cf 7) ,testCase "ARM case 1" $ assertEqual "Period 9" - (Just (CF.MortgageFlow (L.toDate "20250101") 129.01 12.46 0.88 0 0 0 0 0 0.075 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20250101") 129.01 12.46 0.88 0 0 0 0 0.075 Nothing Nothing )) (CF.cfAt arm1_cf 8) ,testCase "ARM case 1" $ assertEqual "Period 10" - (Just (CF.MortgageFlow (L.toDate "20250201") 116.49 12.52 0.85 0 0 0 0 0 0.08 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20250201") 116.49 12.52 0.85 0 0 0 0 0.08 Nothing Nothing )) (CF.cfAt arm1_cf 9) ,testCase "ARM case 1" $ assertEqual "life cap" - (Just (CF.MortgageFlow (L.toDate "20250401") 91.24 12.65 0.77 0 0 0 0 0 0.09 Nothing Nothing )) + (Just (CF.MortgageFlow (L.toDate "20250401") 91.24 12.65 0.77 0 0 0 0 0.09 Nothing Nothing )) (CF.cfAt arm1_cf 11) ] @@ -391,58 +391,58 @@ ppyTest = testGroup "Prepay Penalty tests" [ testCase "ppy case 1" $ assertEqual " using rate0" - (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0 0.08 Nothing (Just 2.58))) + (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just 2.58))) (CF.cfAt ppy_cf_1 0) ,testCase "ppy case 1" $ assertEqual " using rate1" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just 0.21 ))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0.21 ))) (CF.cfAt ppy_cf_1 3) ,testCase "ppy case 2" $ assertEqual " using fix amount" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just 100 ))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 100 ))) (CF.cfAt ppy_cf_2 3) ,testCase "ppy case 2 1_0" $ assertEqual " using fix amount in period" - (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0 0.08 Nothing (Just 100 ))) + (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just 100 ))) (CF.cfAt ppy_cf_2_1 0) ,testCase "ppy case 2 1" $ assertEqual " using fix amount out of period" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just 0 ))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0 ))) (CF.cfAt ppy_cf_2_1 3) ,testCase "ppy case 3" $ assertEqual " using life time pct" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just 0.21 ))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0.21 ))) (CF.cfAt ppy_cf_3 3) ,testCase "ppy case 3 1_0" $ assertEqual " using pct in period" - (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0 0.08 Nothing (Just 0.25 ))) + (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just 0.25 ))) (CF.cfAt ppy_cf_3_1 0) ,testCase "ppy case 3 1" $ assertEqual " using pct out of period" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just 0 ))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just 0 ))) (CF.cfAt ppy_cf_3_1 3) ,testCase "ppy case 4" $ assertEqual " using slide at period 0" - (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0 0.08 Nothing (Just 2.58 ))) + (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just 2.58 ))) (CF.cfAt ppy_cf_4 0) ,testCase "ppy case 4 1" $ assertEqual " using slide at period 1" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just (0.07*21.92)))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just (0.07*21.92)))) (CF.cfAt ppy_cf_4 3) ,testCase "ppy case 5" $ assertEqual " using rate 0 before 2 periods" - (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0 0.08 Nothing (Just (25.83*0.5) ))) + (Just (CF.MortgageFlow (L.toDate "20210201") 9589.55 384.62 66.48 25.83 0 0 0 0.08 Nothing (Just (25.83*0.5) ))) (CF.cfAt ppy_cf_5 0) ,testCase "ppy case 5 1" $ assertEqual " using rate 1 after 2 periods" - (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0 0.08 Nothing (Just (0.2*21.92)))) + (Just (CF.MortgageFlow (L.toDate "20210501") 8357.98 389.45 58.31 21.92 0 0 0 0.08 Nothing (Just (0.2*21.92)))) (CF.cfAt ppy_cf_5 3) ] delinqScheduleCFTest = let - cfs = [CF.MortgageFlow (L.toDate "20230901") 1000 0 0 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20231001") 500 500 0 0 0 0 0 0 0.08 Nothing Nothing + cfs = [CF.MortgageDelinqFlow (L.toDate "20230901") 1000 0 0 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20231001") 500 500 0 0 0 0 0 0 0.08 Nothing Nothing ] pool = P.Pool ([]::[AB.Mortgage]) (Just (CF.CashFlowFrame cfs)) @@ -465,26 +465,30 @@ delinqScheduleCFTest = testCase "case 01" $ assertEqual "size of cashflow" 7 - (CF.sizeCashFlowFrame poolCf) + (CF.sizeCashFlowFrame poolCf) -- `debug` ("\n>>>>> Pool cf from test schedule delinq\n >>>>"++ show poolCf) + ,testCase "case 01_Dates" $ + assertEqual "Dates of cashflow" + (L.toDate <$> ["20230901","20231001","20231031","20231130","20231231","20240131","20240229"]) + (CF.getDatesCashFlowFrame poolCf) ,testCase "case 02" $ assertEqual "first row of cf" - (Just (CF.MortgageFlow (L.toDate "20230901") 995.66 0 0 0 4.34 0 0 0 0.08 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20230901") 995.66 0 0 0 4.34 0 0 0 0.08 Nothing Nothing)) (CF.cfAt poolCf 0) ,testCase "case 03" $ assertEqual "second row of cf" - (Just (CF.MortgageFlow (L.toDate "20231001") 493.66 497.82 0 0 4.18 0 0 0 0.08 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20231001") 493.66 497.82 0 0 4.18 0 0 0 0.08 Nothing Nothing)) (CF.cfAt poolCf 1) ,testCase "case 04" $ assertEqual "first extended cf, nothing" - (Just (CF.MortgageFlow (L.toDate "20231031") 493.66 0.0 0 0 0 0 0 0 0.00 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20231031") 493.66 0.0 0 0 0 0 0 0 0.00 Nothing Nothing)) (CF.cfAt poolCf 2) ,testCase "case 05" $ assertEqual "first default from delinq" - (Just (CF.MortgageFlow (L.toDate "20240131") 496.69 0.0 0 0 0 1.3 0 1.3 0.000488 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20240131") 499.61 0.0 0 0 0 1.3 0 1.3 0.000952 Nothing Nothing)) (CF.cfAt poolCf 5) ,testCase "case 06" $ assertEqual "first loss/recovery from default & first back to perf" - (Just (CF.MortgageFlow (L.toDate "20240229") 499.66 2.97 0 0 0 1.25 0 1.25 0.000475 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20240229") 496.64 2.97 0 0 0 1.25 0 1.25 0.000480 Nothing Nothing)) (CF.cfAt poolCf 6) -- ,testCase "case 07" $ -- assertEqual "first loss/recovery from default & first back to perf" @@ -492,7 +496,7 @@ delinqScheduleCFTest = -- (CF.cfAt poolCf 7) ,testCase "case with prepay assump" $ assertEqual "01" - (Just (CF.MortgageFlow (L.toDate "20230901") 988.64 0 0 7.02 4.34 0.0 0.0 0.0 0.08 Nothing Nothing)) + (Just (CF.MortgageDelinqFlow (L.toDate "20230901") 988.64 0 0 7.02 4.34 0.0 0.0 0.0 0.08 Nothing Nothing)) (CF.cfAt poolCf2 0) ] @@ -517,17 +521,29 @@ delinqMortgageTest = testCase "" $ assertEqual "Length of cf" 5 - (length txns) + (length txns) -- `debug` ("Delinq CF"++show txns) ,testCase "first row" $ assertEqual "delinq = 1" - (CF.MortgageFlow (L.toDate "20211101") 159.84 79.12 1.59 0 1.04 0.0 0.0 0.0 0.08 Nothing Nothing) + (CF.MortgageDelinqFlow (L.toDate "20211101") 159.84 79.12 1.59 0 1.04 0.0 0.0 0.0 0.08 Nothing Nothing) (txns!!0) + ,testCase "second row" $ + assertEqual "with first default/loss/recovery" + (CF.MortgageDelinqFlow (L.toDate "20211201") 79.85 79.32 1.06 0 0.67 0.0 0.0 0.0 0.08 Nothing Nothing) + (txns!!1) ,testCase "last row" $ assertEqual "with first default/loss/recovery" - (CF.MortgageFlow (L.toDate "20220101") 0.0 79.51 0.53 0 0.34 0.31 0.0 0.31 0.08 Nothing Nothing) + (CF.MortgageDelinqFlow (L.toDate "20220101") 1.17 79.75 0.53 0 0.34 0.31 0.0 0.31 0.08 Nothing Nothing) (txns!!2) ,testCase "extend 1st flow" $ assertEqual "check default" - (CF.MortgageFlow (L.toDate "20220201") 0.36 0.36 0.0 0.0 0.0 0.20 0.0 0.2 0.08 Nothing Nothing) + (CF.MortgageDelinqFlow (L.toDate "20220201") 0.70 0.47 0.0 0.0 0.0 0.20 0.0 0.2 0.08 Nothing Nothing) (txns!!3) + -- ,testCase "extend 2st flow" $ + -- assertEqual "check default" + -- (CF.MortgageDelinqFlow (L.toDate "20220201") 1.08 0.36 0.0 0.0 0.0 0.11 0.0 0.11 0.08 Nothing Nothing) + -- (txns!!4) + -- ,testCase "extend 3st flow" $ + -- assertEqual "check default" + -- (CF.MortgageDelinqFlow (L.toDate "20220201") 1.08 0.36 0.0 0.0 0.0 0.0 0.0 0.0 0.08 Nothing Nothing) + -- (txns!!5) ] diff --git a/test/UT/CashflowTest.hs b/test/UT/CashflowTest.hs index 35f2e729..4273e4e9 100644 --- a/test/UT/CashflowTest.hs +++ b/test/UT/CashflowTest.hs @@ -1,4 +1,5 @@ -module UT.CashflowTest(cfTests,tsSplitTests,testMergePoolCf,combineTest,testHaircut) +module UT.CashflowTest(cfTests,tsSplitTests,testMergePoolCf,combineTest,testHaircut + ,testMergeTsRowsFromTwoEntities) where import Test.Tasty @@ -11,13 +12,14 @@ import qualified Assumptions as A import qualified Cashflow as CF import Types import Util +import DateUtil import Debug.Trace debug = flip trace -trs = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 0 Nothing Nothing - , CF.MortgageFlow (L.toDate "20220201") 90 10 10 0 0 0 0 0 0 Nothing Nothing - , CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 0 Nothing Nothing - , CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 0 Nothing Nothing] +trs = [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing + , CF.MortgageFlow (L.toDate "20220201") 90 10 10 0 0 0 0 0 Nothing Nothing + , CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 Nothing Nothing + , CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 Nothing Nothing] cf = CF.CashFlowFrame trs @@ -36,37 +38,37 @@ cfTests = testGroup "Cashflow Utils" assertEqual "only one ts" 1 (length aggTs1) ,testCase "Cashflow Aggregation agg correct amount" $ assertEqual "which bal is 100" - (CF.MortgageFlow (L.toDate "20220110") 100 10 10 0 0 0 0 0 0 Nothing Nothing) + (CF.MortgageFlow (L.toDate "20220110") 100 10 10 0 0 0 0 0 Nothing Nothing) (head aggTs1) ,testCase "Cashflow Aggregation Sum up" $ assertEqual "Test Sum up" 1 (length aggTs2) ,testCase "Cashflow Aggregation agg correct amount" $ assertEqual "which bal is 90" - (CF.MortgageFlow (L.toDate "20220210") 90 20 20 0 0 0 0 0 0 Nothing Nothing) + (CF.MortgageFlow (L.toDate "20220210") 90 20 20 0 0 0 0 0 Nothing Nothing) (head aggTs2) ,testCase "Cashflow Aggregation with two dates" $ assertEqual "Test Sum up" 2 (length aggTs3) ,testCase "Cashflow Aggregation agg correct amount" $ assertEqual "which bal is 90" - [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20220208") 90 10 10 0 0 0 0 0 0 Nothing Nothing] + [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20220208") 90 10 10 0 0 0 0 0 Nothing Nothing] aggTs3 ,testCase "Cashflow Aggregation with two flows at second cutoff" $ assertEqual "include two cf in one cutoff date" - [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20220218") 80 20 20 0 0 0 0 0 0 Nothing Nothing] + [CF.MortgageFlow (L.toDate "20220101") 100 10 10 0 0 0 0 0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20220218") 80 20 20 0 0 0 0 0 Nothing Nothing] aggTs4 ,testCase "Get Latest Cashflow 1" $ assertEqual "Found one" - (Just $ CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 0 Nothing Nothing) + (Just $ CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0 0 0 Nothing Nothing) --(Just $ CF.MortgageFlow (L.toDate "20220211") 80 10 10 0 0 0) findLatestCf1 ,testCase "Get Latest Cashflow 2" $ assertEqual "Found one" - (Just (CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 0 Nothing Nothing)) + (Just (CF.MortgageFlow (L.toDate "20220301") 70 10 10 0 0 0 0 0 Nothing Nothing)) findLatestCf2 ,testCase "Get Latest Cashflow 3" $ assertEqual "Nothing found" @@ -138,10 +140,10 @@ tsSplitTests = combineTest = let - txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn3 = CF.MortgageFlow (L.toDate "20230301") 50 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn4 = CF.MortgageFlow (L.toDate "20230401") 40 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing + txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0.0 Nothing Nothing + txn3 = CF.MortgageFlow (L.toDate "20230301") 50 10 10 0 0 0 0 0.0 Nothing Nothing + txn4 = CF.MortgageFlow (L.toDate "20230401") 40 10 10 0 0 0 0 0.0 Nothing Nothing cf1 = CF.CashFlowFrame [txn1,txn2] cf2 = CF.CashFlowFrame [txn3,txn4] in @@ -149,70 +151,115 @@ combineTest = [ testCase "No overlap combine" $ assertEqual "No overlap combine" (CF.CashFlowFrame - [CF.MortgageFlow (L.toDate "20230101") 160 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230201") 150 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230301") 140 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230401") 130 10 10 0 0 0 0 0 0.0 Nothing Nothing]) + [CF.MortgageFlow (L.toDate "20230101") 160 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230201") 150 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230301") 140 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230401") 130 10 10 0 0 0 0 0.0 Nothing Nothing]) (CF.combine cf1 cf2) ,testCase "Overlap combine" $ let - txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn3 = CF.MortgageFlow (L.toDate "20230301") 80 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing + txn2 = CF.MortgageFlow (L.toDate "20230201") 90 10 10 0 0 0 0 0.0 Nothing Nothing + txn3 = CF.MortgageFlow (L.toDate "20230301") 80 10 10 0 0 0 0 0.0 Nothing Nothing cf1 = CF.CashFlowFrame [txn1,txn2] cf2 = CF.CashFlowFrame [txn2,txn3] in assertEqual "Overlap combine" (CF.CashFlowFrame $ - [CF.MortgageFlow (L.toDate "20230101") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0 0.0 Nothing Nothing]) + [CF.MortgageFlow (L.toDate "20230101") 200 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0.0 Nothing Nothing]) (CF.combine cf1 cf2) ,testCase "Intersection" $ let - txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn2 = CF.MortgageFlow (L.toDate "20230201") 80 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn3 = CF.MortgageFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn4 = CF.MortgageFlow (L.toDate "20230401") 70 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0.0 Nothing Nothing + txn2 = CF.MortgageFlow (L.toDate "20230201") 80 10 10 0 0 0 0 0.0 Nothing Nothing + txn3 = CF.MortgageFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0.0 Nothing Nothing + txn4 = CF.MortgageFlow (L.toDate "20230401") 70 10 10 0 0 0 0 0.0 Nothing Nothing cf1 = CF.CashFlowFrame [txn1,txn3] cf2 = CF.CashFlowFrame [txn2,txn4] in assertEqual "Intersection CF" (CF.CashFlowFrame $ - [CF.MortgageFlow (L.toDate "20230101") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230201") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0 0.0 Nothing Nothing - ,CF.MortgageFlow (L.toDate "20230401") 160 10 10 0 0 0 0 0 0.0 Nothing Nothing]) + [CF.MortgageFlow (L.toDate "20230101") 190 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230201") 180 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageFlow (L.toDate "20230401") 160 10 10 0 0 0 0 0.0 Nothing Nothing]) (CF.combine cf1 cf2) ] +testMergeTsRowsFromTwoEntities = + let + txn1 = CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn4 = CF.MortgageDelinqFlow (L.toDate "20230401") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing + + txn2 = CF.MortgageDelinqFlow (L.toDate "20230201") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn3 = CF.MortgageDelinqFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing + in + testGroup "Merge Two CF from two entities" + [testCase "txn1 + txn 2" $ + assertEqual "Merge Two CF from two entities" + [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing] + (CF.combineTss [] [txn1] [txn2]) + ,testCase "txn1 + txn 2/3" $ + assertEqual "Merge Two CF from two entities" + [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing] + (CF.combineTss [] [txn1] [txn2,txn3]) + ,testCase "txn1/4 + txn 2/3" $ + assertEqual "Merge Two CF from two entities" + [CF.MortgageDelinqFlow (L.toDate "20230101") 210 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing ] + (CF.combineTss [] [txn1,txn4] [txn2,txn3]) + ,testCase "txn1/2 + txn 1/2" $ + assertEqual "Merge Two CF from two entities with same dates" + [CF.MortgageDelinqFlow (L.toDate "20230101") 200 20 20 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0 0.0 Nothing Nothing] + (CF.combineTss [] [txn1,txn2] [txn1,txn2]) + ,testCase "txn1/2/3 + txn 1/2" $ + assertEqual "Merge Two CF from two entities with same dates" + [CF.MortgageDelinqFlow (L.toDate "20230101") 200 20 20 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230201") 180 20 20 0 0 0 0 0 0.0 Nothing Nothing + ,CF.MortgageDelinqFlow (L.toDate "20230301") 170 10 10 0 0 0 0 0 0.0 Nothing Nothing + ] + (CF.combineTss [] [txn1,txn2,txn3] [txn1,txn2]) + + + ] + + + testMergePoolCf = let - txn1 = CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn4 = CF.MortgageFlow (L.toDate "20230401") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn1 = CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn4 = CF.MortgageDelinqFlow (L.toDate "20230401") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn2 = CF.MortgageFlow (L.toDate "20230201") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing - txn3 = CF.MortgageFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn2 = CF.MortgageDelinqFlow (L.toDate "20230201") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing + txn3 = CF.MortgageDelinqFlow (L.toDate "20230301") 90 10 10 0 0 0 0 0 0.0 Nothing Nothing cf1 = CF.CashFlowFrame [txn1,txn4] cf2 = CF.CashFlowFrame [txn2,txn3] in - testGroup "Merge Cashflow Test" -- merge cashflow into existing one without update previous balance + testGroup "Merge Cashflow Test from two entities" -- merge cashflow into existing one without update previous balance [ testCase "" $ assertEqual "Merge Cashflow Test 1" - (CF.CashFlowFrame [(CF.MortgageFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing) - ,(CF.MortgageFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing) - ,(CF.MortgageFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing) - ,(CF.MortgageFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing)]) + (CF.CashFlowFrame [(CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 0 0 0 0 0 0.0 Nothing Nothing) + ,(CF.MortgageDelinqFlow (L.toDate "20230201") 200 10 10 0 0 0 0 0 0.0 Nothing Nothing) + ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 10 10 0 0 0 0 0 0.0 Nothing Nothing) + ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 10 10 0 0 0 0 0 0.0 Nothing Nothing)]) (CF.mergePoolCf cf1 cf2) ] testHaircut = let - cflow = CF.CashFlowFrame [(CF.MortgageFlow (L.toDate "20230101") 100 20 10 20 0 0 5 0 0.0 Nothing (Just 10)) - ,(CF.MortgageFlow (L.toDate "20230201") 200 30 20 30 0 0 10 0 0.0 Nothing (Just 15)) - ,(CF.MortgageFlow (L.toDate "20230301") 190 40 30 40 0 0 15 0 0.0 Nothing (Just 20)) - ,(CF.MortgageFlow (L.toDate "20230401") 180 50 40 50 0 0 20 0 0.0 Nothing (Just 30))] + cflow = CF.CashFlowFrame [(CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 5 0 0.0 Nothing (Just 10)) + ,(CF.MortgageDelinqFlow (L.toDate "20230201") 200 30 20 30 0 0 10 0 0.0 Nothing (Just 15)) + ,(CF.MortgageDelinqFlow (L.toDate "20230301") 190 40 30 40 0 0 15 0 0.0 Nothing (Just 20)) + ,(CF.MortgageDelinqFlow (L.toDate "20230401") 180 50 40 50 0 0 20 0 0.0 Nothing (Just 30))] in testGroup "Test on Haircut" [ testCase "Haircut of Nothing" $ @@ -221,27 +268,27 @@ testHaircut = (P.applyHaircut Nothing cflow) ,testCase "Haircut on principal" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 10 10 20 0 0 5 0 0.0 Nothing (Just 10))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 10 20 0 0 5 0 0.0 Nothing (Just 10))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrincipal,0.5)]}) cflow) 0) ,testCase "Haircut on interest" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 20 7 20 0 0 5 0 0.0 Nothing (Just 10))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 7 20 0 0 5 0 0.0 Nothing (Just 10))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedInterest,0.3)]}) cflow) 0) ,testCase "Haircut on prepayment" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 20 10 12 0 0 5 0 0.0 Nothing (Just 10))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 12 0 0 5 0 0.0 Nothing (Just 10))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepayment,0.4)]}) cflow) 0) ,testCase "Haircut on recoveries" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 20 10 20 0 0 4.5 0 0.0 Nothing (Just 10))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 4.5 0 0.0 Nothing (Just 10))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedRecoveries,0.1)]}) cflow) 0) ,testCase "Haircut on prepay penalty" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 20 10 20 0 0 5 0 0.0 Nothing (Just 8))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 20 10 20 0 0 5 0 0.0 Nothing (Just 8))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepaymentPenalty,0.2)]}) cflow) 0) ,testCase "Haircut on mix" $ assertEqual "" - (Just (CF.MortgageFlow (L.toDate "20230101") 100 10 7 20 0 0 5 0 0.0 Nothing (Just 8))) + (Just (CF.MortgageDelinqFlow (L.toDate "20230101") 100 10 7 20 0 0 5 0 0.0 Nothing (Just 8))) (CF.cfAt (P.applyHaircut (Just A.ExtraStress{A.poolHairCut = Just [(CollectedPrepaymentPenalty,0.2) ,(CollectedPrincipal,0.5) ,(CollectedInterest,0.3)]}) cflow) 0) diff --git a/test/UT/DealTest.hs b/test/UT/DealTest.hs index 4b9c2989..32aba3dc 100644 --- a/test/UT/DealTest.hs +++ b/test/UT/DealTest.hs @@ -191,12 +191,12 @@ triggerTests = testGroup "Trigger Tests" [ let setup = 0 poolflows = CF.CashFlowFrame $ - [CF.MortgageFlow (toDate "20220201") 800 100 20 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (toDate "20220301") 700 100 20 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (toDate "20220401") 600 100 20 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (toDate "20220501") 500 100 20 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (toDate "20220601") 400 100 20 0 0 0 0 0 0.08 Nothing Nothing - ,CF.MortgageFlow (toDate "20220701") 300 100 20 0 0 0 0 0 0.08 Nothing Nothing + [CF.MortgageDelinqFlow (toDate "20220201") 800 100 20 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (toDate "20220301") 700 100 20 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (toDate "20220401") 600 100 20 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (toDate "20220501") 500 100 20 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (toDate "20220601") 400 100 20 0 0 0 0 0 0.08 Nothing Nothing + ,CF.MortgageDelinqFlow (toDate "20220701") 300 100 20 0 0 0 0 0 0.08 Nothing Nothing ] ads = [PoolCollection (toDate "20220201") "" ,RunWaterfall (toDate "20220225") "" diff --git a/test/UT/QueryTest.hs b/test/UT/QueryTest.hs index c8a8126b..0f508546 100644 --- a/test/UT/QueryTest.hs +++ b/test/UT/QueryTest.hs @@ -18,10 +18,10 @@ import Types queryTest = let - a = CashFlowFrame $ [ MortgageFlow (toDate "20220101") 100 20 15 0 0 0 0 0 0.01 Nothing Nothing - , MortgageFlow (toDate "20220201") 100 20 15 0 0 0 0 0 0.01 Nothing Nothing - , MortgageFlow (toDate "20220301") 100 20 15 0 0 0 0 0 0.01 Nothing Nothing - , MortgageFlow (toDate "20220401") 100 20 15 0 0 0 0 0 0.01 Nothing Nothing + a = CashFlowFrame $ [ MortgageFlow (toDate "20220101") 100 20 15 0 0 0 0 0.01 Nothing Nothing + , MortgageFlow (toDate "20220201") 100 20 15 0 0 0 0 0.01 Nothing Nothing + , MortgageFlow (toDate "20220301") 100 20 15 0 0 0 0 0.01 Nothing Nothing + , MortgageFlow (toDate "20220401") 100 20 15 0 0 0 0 0.01 Nothing Nothing ] opool = (pool DT.td2) t = DT.td2 { pool = opool { futureCf = Just a } } diff --git a/test/UT/UtilTest.hs b/test/UT/UtilTest.hs index 2e5a276b..7c725402 100644 --- a/test/UT/UtilTest.hs +++ b/test/UT/UtilTest.hs @@ -9,6 +9,7 @@ import Test.Tasty.HUnit import qualified Data.Time as T import qualified Cashflow as CF import Util +import DateUtil import Lib import Types import Data.Fixed diff --git a/wreq.png b/wreq.png new file mode 100644 index 0000000000000000000000000000000000000000..3f42e44ae15d7d2ba5de5b87e03546916dd0b186 GIT binary patch literal 4467 zcmXw71z1yG*dHm~4k_u75)hRX1_LIJ6cmYp{Amd#B?SpVS{g$w-ifo zp|riH1BaYnyb8XSq(C6dVt3&%ljrD-Tz^B>rSo6YLY6Qpaw?L`ifoGF4=6s+Ik{3K znj0$1;c(A!1DdNwJh^2!^RCjO-XSGlZH%ew+D#=Fm{ElID;t=`Wg+fP;m$H{e)Z5K z{GY_L(TZfgXvMz8o7L50!M^!;N5AP~yZx~x|2vd$cwdoDOQrWlXx=$xK;cS1&HtXF zzWCad_6-b>mYL9iBL+@dZ<&yu4i(9b?i(5^#xlNY2`ekRR_*HQ8uz#*s=2k5d~tEH z5{o6z=%UE!874lXGezAiyv9Z|G&EH3;R78Ghbt{Bg9QhxUR4W;BNEMr2!z6>rmHM5 zEVd4Vz(GY$IyyEc`%Nc-o7&OQ@u>oL{814t9g0w^ zpM{M2@k4{{^5w$1x+@C{3#Fx{>RMV9S5=;e_V(&KSa5N1fuYUA!%$ye-^$wBOZoUq z8C{X}^@<-pe6VqM??tAkr_0F5gr=pXz0tdO?_QUi2 zyz0Mhkf#E(w-*){7thRj=ZG>l?@axoa+NVJFYn^^uU=gW3JQ{O9uRt3Z^^^kyv^aM zAt52r(vx#LIX5?cecknB8?OcyAanDky}mnsVsMc4zqYurs;a6_lfw$8rlw+IV(Lal z%>TBxjZ91;8vOpet*L=ZLTUf|l@OVj$QTqHJiD}XNlon=zYoe=8vFjecyURI;I(Vi zF)=Y>5)$Esh5TM~0V3Ac)|g8ks^`Y0rWDDDR^+2ck4nqS$w2vv@1`(axe{Gaz(-C= zxw>=WY~>`EMK@Amt>fw{DQ)#7qO(&M)bQZ=SW}E`ZliX(ZN4Mrv90Y}y;_vS=JdD3 z)Ks?O;$l8UMGjCEnHx7+u+D=_oSd)srve!h5)#aJ?@DMqad&Tvq-AH~;)*SQSn(Ez zyUZ%84@V%V9J(_L+0&!0Nl9sWddkiH{+*nZRN#F!{o*`0j#mw}t)CQ?)U}YBnTeR4 zot1YTm64N|FAfcb5NkbnRiAIE-*?#E(R}!j9fQI2uM)~T`ume1Nf{aJ8$?{}`||Re z4i7gpB&4J;72nRX*VotEzkd&Xr_Q}ayhN~(FH#awzj&n?8IvR~6At50TJvlj99xA&Jz=L6!-dU!qGDAu{{3LY$ z{{7E5941%UuL(OtDJ2iSE-Wl04|V88-vtp}Ux>~t)Nyl@3O?SbwR3mZ2g&r_S?-6O zW11@ah(w}OPxehaCnp4}2(lm|A_B%SyuE5@Wu?c=%-nqw-_hYetAau})w)j#FfuaE z{eA8|-_DFvlUd~;M*p;Bp^3C}bww)suJhGf-kAx$B#E7D@JmTfW~QK^FtWE_DBvb+ zuMSR5>ILp^3WHE-=;(^Uq$C?76@6bC8k~1m39YtOPJgDp78{D8h>uh&?)dxr&o3@& zg9a`f7#IkteetPp-cwP^92<>9BA2_fZn$_ElEx>CCEZBNx9#k{}EW zbRIp*8c_1{^E)^^EG#Rd{`>c@p%@#IGpDERB?axyMlTT zOv)$47m?nqhGAT{@4)5Y)Ju|VWxW%-j4LtPa~Nlc{bT^ZL)hKC>EMpHZNTsj;} ziG!3J92|CbcJOa!N9CQ~X&SMwUkhAK+@E-Bm||vTmJ}Ns+lf^T++%_qo$gN)96U~s zcFjM&@2^pH`}>pKy06rz$mBs_>AJh$&a%-5vno=Rs|H0{?$#>f4a;Nl5SQbI?yjzu z=I~2|HzS7F620LH>qG!OAz|TN-8BO3dq73P!or!iJ@Ou)@3Zf3PHF}Psbpto%lQAZ z1F6-ycG?!tRTp$9$IZjjY+J>|%pA6};~liqujAzA_OtAMiH)6IL}jH+YHBKcRyOG1Y2}#f6%LNavp*ssq1BG~x8>!u+zgktm++3R9d>ePMK8+3!^5rp z{a;|F=Gmtv#QS1wAkU|Z<((xyYs1a$?NmS$N(}O~VK5R)E2}EkF}ci~oF^;Y=ZXD5 zs>a8;?%utddGkrS=UlaxrG^G6NkLni_D8nb_m$Pvf(8Z#Y0j4zxcMNu1S#v_-OGBp zN@+lHkPjiW76kUF3lwgV#{9<`jDogM$74mH-=S?tNliq(ain3*AHB3}v!3Z{|6;5#cN z`Qp@43JRG50s@%}vFz91goTj++W2G;NY+t%J^y8R_{z!QcDHZFb!!m_*1jvf$)J+* zaJ?G8oa;BWf@>PFE{Tt)hZKDJ#2~00*N5a#hOBRFJe&C*hFW9fy%X2njl}q5NL#%u zDG`P6Nl4JbBLKBQLIE2{N=h=Zu|;UUVtCw(Rvc~g-}Z9bSGg2&F#8H}_R*H4;2-XE z#b^J|w2rN<0O0Q|AFrieEj>MYz_v%&5$mSlLlY~j_|{f9GE*i@QPjAMt*NQW>B*D8 zO<9-M+1Z?1hbO4DKjIWUFQL%spPL_N<`?o<0SP$UV zb@Gd;Ga~ZnD1cinq;dMUktjTZH{^h%xw(03Yil{}ld%)XpN@?U-;b6S{xsd2oAZNA z%*DpnIJvk?-`x{pf!GZ6baz7_?9!H@meM-L#w?o?_2B@W6AgZhfO1B^_(<5vaX`LL zPxHFFyLVeV;w^<(_@$)i<+9>941NPF>el3<(S7~>VW7-R%=-Cv;^X4z}=gwsFVPNJaqV@ zg-%vh792h_I*I_wg<%%dW`g|N+k3aX?BwF%QL?r5)V9h@h>2=>ra2rqQ7uVm>@C+( zb(WY21#Slaz`((?(_?4Aj@Y0>&&7{lu-H^`Qj)*VRgM-ite4lvs^>R1^&!A1#(^xg z9E=c&x}a$UAs2TXt@@9RnHi>XHSyw(iM(p>78f1ND{V-;=z4p5z1N1NL=qi0=!K>M znp8(hgzu%x?A2L*8n7t6RTpxq#KFlqV4!w7v~&ya_BA;*6%HH+=%H69qA6d#C}G62 z^6-v;70fLx?g}I)A%xxnGmJV0PMM)@J5r;tU}C~@QTfTUXH}iSys80kz*i3*=@oZQ zsc&z@g7#pEfxE2X zs5~+=lfgp+&H~xk*#}dv-H&dW?Q04?rfi(1-F^9{!w%R(5!>o9d9OueXHQS?W1Zc` zYy`%b*c7Y`DwhmQ?ZVR1x4yIRRdsY;o_Cjmm!($+S% zvYIT|4qU0a4f=Xx`ddCwteBs+{eaxWgoPLEs|iJdE-o(1fLsLc2sBm;482e%uyg2-P*e?9m(I9vZq5nfdILzh%1km__CLzgy>SoD zvK_)`bRrzi!^7jfIiZ-X_Tml)7Z+owzL`-=9VHr$>yP+UcB)QM+gWvN}Vq>GLoXsQkr$4cVdDY z3WXxslz~6TBtSBQLv)7Q{gV#QBb~fVZVSs=Jk@cKMh&T}k zVMCUdmZ-ylqcnD+x|55GvAAl$5B3@?R$U;u0Jvl3mcgF(eEO78@HnB~vR6`#YX_%O z0A`4L>aUXbCi*Zaq~d8pO-+sF+f;(kIW>3)p?Z|L8i0L?a{B)hf9Q=bz8d&7{5i>V Yj9sm_WpXQciUPT-r4Rq4Ve|5T07MI{?EnA( literal 0 HcmV?d00001