feat: fix pool-level DefaultByAmt allocation across multiple assets

.gitignore

@@ -0,0 +1 @@
+dist-newstyle/

Hastructure.cabal

@@ -192,6 +192,7 @@ test-suite Hastructure-test
       UT.ExpTest
       UT.InterestRateTest
       UT.LibTest
+      UT.PoolTest
       UT.QueryTest
       UT.RateHedgeTest
       UT.StmtTest

src/Pool.hs

@@ -14,7 +14,7 @@ module Pool (Pool(..),aggPool
 import Lib (Period(..)
            ,Ts(..),periodRateFromAnnualRate,toDate
            ,getIntervalDays,zipWith9,mkTs,periodsBetween
-           ,mkRateTs,daysBetween, )
+           ,mkRateTs,daysBetween, prorataFactors)
 
 import Control.Parallel.Strategies
 import qualified Cashflow as CF -- (Cashflow,Amount,Interests,Principals)
@@ -205,8 +205,13 @@ runPool (Pool as _ _ asof _ _) Nothing mRates
       return [ (x, Map.empty) | x <- cf ]
 -- asset cashflow with credit stress
 ---- By pool level
-runPool (Pool as _ Nothing asof _ _) (Just (A.PoolLevel assumps)) mRates 
-  = sequenceA $ parMap rdeepseq (\x -> projCashflow x asof assumps mRates) as  
+runPool (Pool as _ Nothing asof _ _) (Just (A.PoolLevel assumps)) mRates =
+  sequenceA $ parMap rdeepseq
+    (\(x, assump) -> projCashflow x asof assump mRates) (zip as assetAssumps)
+  where
+    assetAssumps = allocateDefaultByAmt balances assumps
+    balances = getCurrentBal <$> as
+
 ---- By index
 runPool (Pool as _ Nothing  asof _ _) (Just (A.ByIndex idxAssumps)) mRates =
   let
@@ -297,5 +302,29 @@ runPool (Pool as _ Nothing asof _ _) (Just (A.ByObligor obligorRules)) mRates =
 runPool _a _b _c = Left $ "[Run Pool]: Failed to match" ++ show _a ++ show _b ++ show _c
 
 
+allocateDefaultByAmt :: [Balance] -> A.AssetPerf -> [A.AssetPerf]
+allocateDefaultByAmt
+  balances
+  ( A.MortgageAssump
+      (Just (A.DefaultByAmt (total, rates)))
+      prepay
+      recovery
+      extra
+  , delinqAssump
+  , defaultAssump
+  ) =
+    [ (A.MortgageAssump
+        (Just (A.DefaultByAmt (amount, rates)))
+        prepay
+        recovery
+        extra
+      , delinqAssump
+      , defaultAssump
+      )
+      | amount <- prorataFactors balances total
+    ]
+allocateDefaultByAmt balances assumps =
+  replicate (length balances) assumps
+
 
 $(deriveJSON defaultOptions ''Pool)

test/MainTest.hs

@@ -19,7 +19,7 @@ import qualified UT.AnalyticsTest as AnalyticsT
 import qualified UT.InterestRateTest as IRT
 import qualified UT.RateHedgeTest as RHT
 import qualified UT.CeTest as CET
-
+import qualified UT.PoolTest as PT
 
 import qualified DealTest.DealTest as DealTest
 import qualified DealTest.RevolvingTest as RevolvingTest
@@ -117,4 +117,5 @@ tests = testGroup "Tests" [AT.mortgageTests
                            ,DealMultiTest.mPoolbaseTests
                            ,RHT.capRateTests
                            ,CET.liqTest
+                           ,PT.poolTest
                            ]

test/UT/PoolTest.hs

@@ -0,0 +1,70 @@
+module UT.PoolTest (poolTest)
+where
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified AssetClass.AssetBase as AB
+import qualified Assumptions as A
+import qualified Cashflow as CF
+import qualified Lib as L
+import qualified Pool as P
+
+import InterestRate (RateType (Fix))
+import Types (DayCount (DC_ACT_365F))
+
+poolTest :: TestTree
+poolTest =
+  testGroup
+    "Pool test"
+    [ testCase "pool DefaultByAmt is allocated proportional to current balance" $
+        case P.runPool pool (Just defaultAss) Nothing of
+          Left err -> assertFailure err
+          Right proj ->
+            assertEqual
+              "a total default of 40 (25% and 75%) across the asets"
+              [10, 30]
+              (totalDefaults <$> proj)
+    ]
+  where
+    pool =
+      P.Pool
+        { P.assets = [mortgage 100, mortgage 300]
+        , P.futureCf = Nothing
+        , P.futureScheduleCf = Nothing
+        , P.asOfDate = L.toDate "20240101"
+        , P.issuanceStat = Nothing
+        , P.extendPeriods = Nothing
+        }
+
+    defaultAss =
+      A.PoolLevel
+        ( A.MortgageAssump
+            (Just (A.DefaultByAmt (40, [1])))
+            Nothing
+            Nothing
+            Nothing
+        , A.DummyDelinqAssump
+        , A.DummyDefaultAssump
+        )
+
+    mortgage balance =
+      AB.Mortgage
+        ( AB.MortgageOriginalInfo
+            balance
+            (Fix DC_ACT_365F 0.08)
+            12
+            L.Monthly
+            (L.toDate "20240101")
+            AB.Level
+            Nothing
+            Nothing
+        )
+        balance
+        0.08
+        12
+        Nothing
+        AB.Current
+
+    totalDefaults (CF.CashFlowFrame _ txns, _) =
+      sum (CF.mflowDefault <$> txns)