expose WA formula

src/Accounts.hs

@@ -126,7 +126,7 @@ deposit :: Amount -> Date -> TxnComment -> Account -> Account
 deposit amount d source acc@(Account bal _ _ _ maybeStmt)  =
     acc {accBalance = newBal, accStmt = newStmt}
   where
-    newBal = bal + amount
+    newBal = bal + amount -- `debug` ("Date:"++show d++ "deposit"++show amount++"from"++show bal)
     newStmt = appendStmt maybeStmt (AccTxn d newBal amount source)
 
 -- | draw cash from account with a comment

src/Cashflow.hs

@@ -964,7 +964,7 @@ patchCumulative (cPrin,cPrepay,cDelinq,cDefault,cRecovery,cLoss)
                where
                  newSt = (0,0,0,0,0,0)
 
-patchCumulative a b c = error ("faile to patch cumulative stats for "++show a ++">>"++show b++">>"++show c)
+patchCumulative a b c = error ("failed to patch cumulative stats for "++show a ++">>"++show b++">>"++show c)
 
 
 

src/Deal/DealAction.hs

@@ -65,6 +65,8 @@ import Cashflow (CashFlowFrame(CashFlowFrame))
 import Control.Lens hiding (element)
 import Control.Lens.TH
 import GHC.Real (infinity)
+import Deal.DealQuery (patchDatesToStats)
+import Data.OpenApi (HasPatch(patch))
 
 debug = flip trace
 
@@ -186,22 +188,9 @@ calcDueFee t@TestDeal{pool = pool} calcDay f@(F.Fee fn (F.AnnualRateFee feeBase
   = f{ F.feeDue=fd+newDue, F.feeDueDate = Just calcDay }  -- `debug` ("Fee DUE new Due "++show newDue++"oldDue"++show fd)
       where 
         accrueStart = _fdDay
-        baseBal = case feeBase of
-                    CurrentPoolBalance mPns ->
-                      let 
-                        txnsByPool = getAllCollectedTxns t mPns
-                        waBalByPool = Map.map (CF.mflowWeightAverageBalance accrueStart calcDay <$>) txnsByPool
-                      in 
-                        sum $ fromMaybe 0  <$> Map.elems waBalByPool
-                    OriginalPoolBalance mPns -> mulBR 
-                                                  (Map.findWithDefault 0.0 IssuanceBalance (getIssuanceStatsConsol t mPns))
-                                                  (yearCountFraction DC_ACT_365F accrueStart calcDay)
-                    OriginalBondBalance -> mulBR (queryDeal t OriginalBondBalance) (yearCountFraction DC_ACT_365F accrueStart calcDay)
-                    CurrentBondBalance -> Map.foldr (\v a-> a + L.weightAverageBalance accrueStart calcDay v ) 0.0 (bonds t)
-                    CurrentBondBalanceOf bns -> Map.foldr (\v a-> a + L.weightAverageBalance accrueStart calcDay v ) 0.0 (getBondsByName t (Just bns))
-                    -- CurrentBondBalance -> Map.foldr (\v a-> a + weightAvgBalance accrueStart calcDay (getTxns (L.bndStmt v)) ) 0.0 (bonds t)
-                    -- CurrentBondBalanceOf bns -> sum $ (\v -> weightAvgBalance accrueStart calcDay (getTxns (L.bndStmt v))) <$>  viewDealBondsByNames t bns
-        r = toRational $ queryDealRate t _r 
+        patchedDs = patchDatesToStats t accrueStart calcDay feeBase
+        baseBal = queryDeal t patchedDs
+        r = toRational $ queryDealRate t _r -- `debug` ("Base "++ show calcDay ++">>"++ show baseBal++"From ds"++show patchedDs++"Fee Name"++fn)
         newDue = mulBR baseBal r -- `debug` ("Fee Name"++fn ++"Date"++ show [accrueStart, calcDay] ++ "base bal"++ show baseBal++"new rate"++show r)
 
 -- ^ % fee base on pool balance/amount
@@ -727,7 +716,7 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFeeBySeq mLimit a
 
     feesPaid = map (\(f,amt) -> F.payFee d amt f) feesAmountToBePaid
     -- update primary account map
-    accPaidOut = min actualPaidOut availAccBal
+    accPaidOut = min actualPaidOut availAccBal 
     dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap
                      ,fees = Map.fromList (zip fns feesPaid) <> feeMap}
 
@@ -760,12 +749,12 @@ performAction d t@TestDeal{fees=feeMap, accounts=accMap} (W.PayFee mLimit an fns
                       Just (DueCapAmt amt) -> min amt feeTotalDueAmt
                       Just (DuePct pct) -> mulBR feeTotalDueAmt pct
     -- total actual pay out
-    actualPaidOut = min amtAvailable dueAmtAfterCap
+    actualPaidOut = min amtAvailable dueAmtAfterCap 
 
     feesAmountToBePaid = zip feesToPay $ prorataFactors feeDueAmts actualPaidOut
     feesPaid = map (\(f,amt) -> F.payFee d amt f) feesAmountToBePaid
     -- update primary account map
-    accPaidOut = min actualPaidOut availAccBal
+    accPaidOut = min actualPaidOut availAccBal -- `debug` ("Actual paid out"++ show actualPaidOut++" acc bal"++ show availAccBal ++">>"++ show (snd <$> feesAmountToBePaid)++">>"++ show fns)
     dealAfterAcc = t {accounts = Map.adjust (A.draw accPaidOut d (SeqPayFee fns)) an accMap
                      ,fees = Map.fromList (zip fns feesPaid) <> feeMap}
 
@@ -986,7 +975,7 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayPrinGroup mLimit
     bndsWithDueMap = Map.map (calcDuePrin t d) bndsToPay
     bndsDueAmtsMap = Map.map (\x -> (x, L.bndDuePrin x)) bndsWithDueMap
     totalDueAmount = sum $ snd <$> Map.elems bndsDueAmtsMap -- `debug` (">date"++show d++" due amt"++show bndsDueAmtsMap)
-    payAmount = min totalDueAmount amtAvailable -- `debug` (">date total dueAmt"++ show totalDueAmount)
+    payAmount = min totalDueAmount amtAvailable  -- `debug` (">date total available"++ show amtAvailable)
 
     -- actualPaids =  paySeqLiabilitiesAmt payAmount bndsDueAmts
     payOutPlan = allocAmtToBonds by payAmount (Map.elems bndsDueAmtsMap) -- `debug` (">date"++ show payAmount)
@@ -1008,7 +997,7 @@ performAction d t@TestDeal{bonds=bndMap,accounts=accMap} (W.PayPrinGroup mLimit
 
 performAction d t@TestDeal{bonds=bndMap} (W.AccrueAndPayIntGroup mLimit an bndName by mSupport)
   = let 
-       dAfterAcc = performAction d t (W.AccrueIntGroup [bndName])
+       dAfterAcc = performAction d t (W.AccrueIntGroup [bndName])-- `debug` ("Acc due int grp"++ show (getDueInt (bndMap Map.! bndName)))
     in 
        performAction d dAfterAcc (W.PayIntGroup mLimit an bndName by mSupport)
 

src/Deal/DealQuery.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Deal.DealQuery (queryDealBool,queryDeal,queryDealInt,queryDealRate
-                       ,patchDateToStats, testPre, calcTargetAmount, testPre2) 
+                       ,patchDateToStats,patchDatesToStats,testPre, calcTargetAmount, testPre2) 
   where
 
 import Deal.DealBase
@@ -93,6 +93,26 @@ patchDateToStats d t
          Round ds rb -> Round (patchDateToStats d ds) rb
          _ -> t -- `debug` ("Failed to patch date to stats"++show t)
 
+patchDatesToStats :: P.Asset a => TestDeal a -> Date -> Date -> DealStats -> DealStats
+patchDatesToStats t d1 d2 ds 
+  = case ds of 
+      CurrentBondBalanceOf bns -> WeightedAvgCurrentBondBalance d1 d2 bns
+      OriginalBondBalanceOf bns -> WeightedAvgOriginalBondBalance d1 d2 bns
+      CurrentPoolBalance mPns -> WeightedAvgCurrentPoolBalance d1 d2 mPns
+      OriginalPoolBalance mPns -> WeightedAvgOriginalPoolBalance d1 d2 mPns
+      CurrentBondBalance -> WeightedAvgCurrentBondBalance d1 d2 (Map.keys $ bonds t)
+      OriginalBondBalance -> WeightedAvgOriginalBondBalance d1 d2 (Map.keys $ bonds t)
+      Excess dss -> Excess $ [ patchDatesToStats t d1 d2 ds | ds <- dss ]
+      Abs ds -> Abs $ patchDatesToStats t d1 d2 ds
+      Avg dss -> Avg $ [ patchDatesToStats t d1 d2 ds | ds <- dss ]
+      Divide ds1 ds2 -> Divide (patchDatesToStats t d1 d2 ds1) (patchDatesToStats t d1 d2 ds2)
+      FloorAndCap f c s -> FloorAndCap (patchDatesToStats t d1 d2 f) (patchDatesToStats t d1 d2 c) (patchDatesToStats t d1 d2 s)
+      Multiply dss -> Multiply $ [ patchDatesToStats t d1 d2 ds | ds <- dss ]
+      FloorWith ds f -> FloorWith (patchDatesToStats t d1 d2 ds) (patchDatesToStats t d1 d2 f)
+      CapWith ds c -> CapWith (patchDatesToStats t d1 d2 ds) (patchDatesToStats t d1 d2 c)
+      Round ds rb -> Round (patchDatesToStats t d1 d2 ds) rb
+      Sum dss -> Sum $ [ patchDatesToStats t d1 d2 ds | ds <- dss ]
+      x -> x
 
 
 queryDealRate :: P.Asset a => TestDeal a -> DealStats -> Micro
@@ -520,6 +540,31 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM
                                         Nothing -> error $ "No "++ rsName ++" Found in rate swap map with key"++ show (Map.keys rm)
                                         Just rc -> H.rcNetCash rc
 
+    WeightedAvgCurrentBondBalance d1 d2 bns ->
+      Map.foldr (\v a-> a + (L.weightAverageBalance d1 d2 v)) -- `debug` (" Avg Bal for bond"++ show (L.weightAverageBalance d1 d2 v)) )
+                0.0 
+                (getBondsByName t (Just bns))
+
+    WeightedAvgCurrentPoolBalance d1 d2 mPns ->
+      let 
+        txnsByPool = getAllCollectedTxns t mPns
+        waBalByPool = Map.map (CF.mflowWeightAverageBalance d1 d2 <$>) txnsByPool
+      in 
+        sum $ fromMaybe 0  <$> Map.elems waBalByPool
+
+    WeightedAvgOriginalBondBalance d1 d2 bns ->
+      let 
+        bnds = viewDealBondsByNames t bns
+        oBals = getOriginBalance <$> bnds
+        bgDates = L.originDate . L.bndOriginInfo <$> bnds -- `debug` ("bals"++show oBals++">>"++ show d1++"-"++show d2)
+      in 
+        sum $ (\(b,sd) -> mulBR b (yearCountFraction DC_ACT_365F (max d1 sd) d2)) <$> (zip oBals bgDates) -- `debug` ("bgDates"++show bgDates)
+
+    WeightedAvgOriginalPoolBalance d1 d2 mPns ->
+      mulBR 
+        (Map.findWithDefault 0.0 IssuanceBalance (getIssuanceStatsConsol t mPns))
+        (yearCountFraction DC_ACT_365F d1 d2)
+
     Sum _s -> sum $ map (queryDeal t) _s
 
     Subtract (ds:dss) -> 
@@ -556,7 +601,7 @@ queryDeal t@TestDeal{accounts=accMap, bonds=bndMap, fees=feeMap, ledgers=ledgerM
     Multiply ss -> product (queryDeal t <$> ss)
     FloorWith s floor -> max (queryDeal t s) (queryDeal t floor)
     FloorWithZero s -> max (queryDeal t s) 0
-    Excess (s1:ss) -> max 0 $ queryDeal t s1 - queryDeal t (Sum ss)
+    Excess (s1:ss) -> max 0 $ queryDeal t s1 - queryDeal t (Sum ss) -- `debug` ("Excess"++show (queryDeal t s1)++"ss"++show ( queryDeal t (Sum ss)))
     CapWith s cap -> min (queryDeal t s) (queryDeal t cap)
     Abs s -> abs $ queryDeal t s
     Round ds rb -> roundingBy rb (queryDeal t ds)

src/Deal/DealValidation.hs

@@ -209,8 +209,20 @@ validateAggRule rules validPids =
     osPid = Set.elems $ Set.difference (Set.fromList (concat (getPids <$> rules))) (Set.fromList validPids)
 
 
+validateFee :: F.Fee -> [ResultComponent]
+-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentBondBalanceOf _) _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalBondBalanceOf _) _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee (CurrentPoolBalance _) _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee (OriginalPoolBalance _) _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee CurrentBondBalance _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee OriginalBondBalance _) _ _ _ _ _ _) = [] 
+-- validateFee (F.Fee fn (F.AnnualRateFee ds _) _ _ _ _ _ _ )
+--   = [ErrorMsg ("Fee Name "++fn++" has an unsupported base "++show ds)]
+validateFee _ = []
+
+
 validateReq :: (IR.UseRate a,P.Asset a) => TestDeal a -> AP.NonPerfAssumption -> (Bool,[ResultComponent])
-validateReq t@TestDeal{accounts = accMap} assump@A.NonPerfAssumption{A.interest = intM, A.issueBondSchedule = mIssuePlan} 
+validateReq t@TestDeal{accounts = accMap, fees = feeMap} assump@A.NonPerfAssumption{A.interest = intM, A.issueBondSchedule = mIssuePlan} 
   = let 
       ratesRequired = extractRequiredRates t
       ratesSupplied = case intM of 
@@ -221,7 +233,8 @@ validateReq t@TestDeal{accounts = accMap} assump@A.NonPerfAssumption{A.interest
                             []
                           else
                             [ErrorMsg ("Failed to find index "++show missingIndex++"in assumption rates"++ show ratesSupplied)]
-
+      -- fee validation 
+      feeErrors = concatMap validateFee $ Map.elems feeMap
       -- issue plan validation
       issuePlanError = case mIssuePlan of 
                         Nothing -> []
@@ -242,7 +255,7 @@ validateReq t@TestDeal{accounts = accMap} assump@A.NonPerfAssumption{A.interest
                               bgNameErrors ++ accNameErrors ++ bndNameErrors
 
       (dealWarnings,dealErrors) = validatePreRun t 
-      finalErrors = missingIndexError ++ dealErrors ++ issuePlanError 
+      finalErrors = missingIndexError ++ dealErrors ++ issuePlanError ++ feeErrors
       finalWarnings = dealWarnings
     in 
       (null finalErrors,finalErrors++finalWarnings)

src/Liability.hs

@@ -338,7 +338,10 @@ backoutDueIntByYield d b@(Bond _ _ (OriginalInfo obal odate _ _) (InterestByYiel
 weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ )  _ _ currentBalance _ _ _ _ _ _ _ Nothing) 
   = mulBR currentBalance (yearCountFraction DC_ACT_365F (max bd sd) ed) 
 weightAverageBalance sd ed b@(Bond _ _ (OriginalInfo ob bd _ _ )  _ _ currentBalance _ _ _ _ _ _ _ (Just stmt))
-  = L.weightAvgBalance' (max bd sd) ed (view S.statementTxns stmt)
+  = L.weightAvgBalance' 
+      (max bd sd) 
+      ed 
+      (view S.statementTxns stmt)
 
 -- TO BE Deprecate, it was implemented in Cashflow Frame
 -- weightAverageBalance :: Date -> Date -> Bond -> Balance
@@ -474,6 +477,9 @@ instance Liable Bond where
   getOriginBalance b@Bond{ bndOriginInfo = bo } = originBalance bo
   getOriginBalance (BondGroup bMap) = sum $ getOriginBalance <$> Map.elems bMap
 
+  getDueInt b@Bond{bndDueInt=di} = di
+  getDueInt (BondGroup bMap) = sum $ getDueInt <$> Map.elems bMap
+
 instance IR.UseRate Bond where 
   isAdjustbleRate :: Bond -> Bool
   isAdjustbleRate Bond{bndInterestInfo = iinfo} = isAdjustble iinfo

src/Stmt.hs

@@ -11,7 +11,7 @@ module Stmt
    ,TxnComment(..),QueryByComment(..)
    ,weightAvgBalanceByDates,weightAvgBalance,weightAvgBalance',sumTxn, consolTxn
    ,getFlow,FlowDirection(..), aggByTxnComment,scaleByFactor
-   ,scaleTxn,isEmptyTxn, statementTxns
+   ,scaleTxn,isEmptyTxn, statementTxns, viewBalanceAsOf
   )
   where
 
@@ -128,16 +128,15 @@ sliceStmt sd ed (Statement txns)
 viewBalanceAsOf :: Date -> [Txn] -> Balance
 viewBalanceAsOf d [] = 0.0 
 viewBalanceAsOf d txns 
-  | d < begDate = getTxnBegBalance fstTxn
-  | d > endDate = getTxnBalance lstTxn
-  | otherwise = getTxnBalance $ fromJust $ getTxnAsOf txns d
+  | d < begDate = getTxnBegBalance fstTxn -- `debug` (" get first txn")
+  | d > endDate = getTxnBalance lstTxn -- `debug` (" get last txn")
+  | otherwise = getTxnBalance $ fromJust $ getTxnAsOf txns d -- `debug` ("Found txn>>>>>"++show d++show (getTxnAsOf txns d))
   where 
     fstTxn = head txns
     lstTxn = last txns
     begDate = getDate fstTxn
     endDate = getDate lstTxn
 
-
 weightAvgBalanceByDates :: [Date] -> [Txn] -> [Balance]
 weightAvgBalanceByDates ds txns 
   = (\(_sd,_ed) -> weightAvgBalance _sd _ed txns) <$> intervals -- `debug` ("interval"++ show intervals++ show txns)
@@ -156,14 +155,15 @@ weightAvgBalance sd ed txns
 
 weightAvgBalance' :: Date -> Date -> [Txn] -> Balance 
 weightAvgBalance' sd ed [] = 0.0 
-weightAvgBalance' sd ed txns 
+weightAvgBalance' sd ed (_txn:_txns)
   = let 
       -- txns = sliceBy EE sd ed txns
+      txns = reverse $ foldl consolTxn [_txn] _txns
       viewDs = sort $ [sd,ed] ++ (getDate <$> (sliceBy EE  sd ed txns))
-      balances = flip viewBalanceAsOf txns <$> viewDs
+      balances = flip viewBalanceAsOf txns <$> viewDs -- `debug` ("get bal snapshot"++ show viewDs++ ">>>"++show txns)
       factors = getIntervalFactors viewDs
     in 
-      sum $ zipWith mulBR balances factors -- `debug` ("Factors"++show factors++"Balances"++show balances)   
+      sum $ zipWith mulBR balances factors --`debug` ("In weight avg bal: Factors"++show factors++"Balances"++show balances ++ "interval "++ show (sd,ed))   
 
 data Statement = Statement [Txn]
               deriving (Show, Generic, Eq, Ord, Read)

src/Types.hs

@@ -531,6 +531,13 @@ data DealStats = CurrentBondBalance
                | TestNot DealStats
                | PoolWaRate (Maybe [PoolId])
                | BondRate BondName
+               -- weighted average balancer over period
+               | WeightedAvgCurrentPoolBalance Date Date (Maybe [PoolId])
+               | WeightedAvgCurrentBondBalance Date Date [BondName]
+               | WeightedAvgOriginalPoolBalance Date Date (Maybe [PoolId])
+               | WeightedAvgOriginalBondBalance Date Date [BondName]
+
+               -- 
                | Factor DealStats Rational
                | Multiply [DealStats]
                | Max [DealStats]
@@ -647,6 +654,7 @@ class Liable lb where
   isPaidOff :: lb -> Bool
   getCurBalance :: lb -> Balance
   getOriginBalance :: lb -> Balance
+  getDueInt :: lb -> Balance
 
   -- optional implement
   -- getTotalDue :: [lb] -> Balance