{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Util
    (mulBR,mulBIR,mulBI,mulBInt,mulBInteger,lastN
    ,getValByDate,getValByDates,scaleUpToOne
    ,divideBB,getIntervalFactorsDc
    ,multiplyTs,zipTs,getTsVals,getTsSize,divideBI,mulIR, daysInterval
    ,replace,paddingDefault, capWith, getTsDates
    ,shiftTsByAmt,calcWeightBalanceByDates
    ,maximum',minimum',roundingBy,roundingByM
    ,floorWith,slice,toPeriodRateByInterval, dropLastN, zipBalTs
    ,lastOf,findBox,safeDivide', safeDiv
    ,safeDivide,lstToMapByFn,paySequentially,payProRata,mapWithinMap
    ,payInMap,adjustM,lookupAndApply,lookupAndUpdate,lookupAndApplies
    ,lookupInMap,selectInMap,scaleByFstElement
    ,lookupTuple6 ,lookupTuple7,diffNum
    -- for debug
    ,debugOnDate,paySeqM,splitByLengths
    )
    where
import qualified Data.Time as T
import qualified Data.Map as Map
import Data.List
import Data.Fixed
import Data.Ratio ((%))
import Data.Ix
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
import Lib
import Types
import DateUtil

import Numeric.Limits (infinity)
import Text.Printf
import Control.Exception

import Data.Time (addDays)
import Debug.Trace
debug :: c -> [Char] -> c
debug = ([Char] -> c -> c) -> c -> [Char] -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> c -> c
forall a. [Char] -> a -> a
trace

mulBR :: Balance -> Rate -> Balance
mulBR :: Balance -> Rational -> Balance
mulBR Balance
b Rational
r = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational (Rational -> Balance) -> Rational -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r 

mulBIR :: Balance -> IRate -> Balance
mulBIR :: Balance -> IRate -> Balance
mulBIR Balance
b IRate
r = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational (Rational -> Balance) -> Rational -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* IRate -> Rational
forall a. Real a => a -> Rational
toRational IRate
r

mulIR :: Int -> Rational -> Rational
mulIR :: Int -> Rational -> Rational
mulIR Int
i Rational
r = Int -> Rational
forall a. Real a => a -> Rational
toRational Int
i Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r 

mulIntegerR :: Integer -> Rational -> Rational
mulIntegerR :: Integer -> Rational -> Rational
mulIntegerR Integer
i Rational
r = Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
i Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
r

mulBInt :: Balance -> Int -> Rational 
mulBInt :: Balance -> Int -> Rational
mulBInt Balance
b Int
i = Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int -> Rational
forall a. Real a => a -> Rational
toRational Int
i

mulBInteger :: Balance -> Integer -> Rational 
mulBInteger :: Balance -> Integer -> Rational
mulBInteger Balance
b Integer
i = Balance -> Int -> Rational
mulBInt Balance
b (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)

mulBI :: Balance -> IRate -> Amount
mulBI :: Balance -> IRate -> Balance
mulBI Balance
bal IRate
r = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational  (Rational -> Balance) -> Rational -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
bal Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* IRate -> Rational
forall a. Real a => a -> Rational
toRational IRate
r

divideBI :: Balance -> Int -> Balance
divideBI :: Balance -> Int -> Balance
divideBI Balance
b Int
i = Rational -> Balance
forall a. Fractional a => Rational -> a
fromRational (Rational -> Balance) -> Rational -> Balance
forall a b. (a -> b) -> a -> b
$ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
i

divideBB :: Balance -> Balance -> Rational
divideBB :: Balance -> Balance -> Rational
divideBB Balance
b1 Balance
b2 = Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
b2

safeDivide :: RealFloat a => a -> a -> a
safeDivide :: forall a. RealFloat a => a -> a -> a
safeDivide a
_ a
0 = a
forall a. RealFloat a => a
Numeric.Limits.infinity
safeDivide a
x a
y = a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
y


safeDiv :: Rational -> Rational -> Maybe Rational 
safeDiv :: Rational -> Rational -> Maybe Rational
safeDiv Rational
_ Rational
0 = Maybe Rational
forall a. Maybe a
Nothing 
safeDiv Rational
x Rational
y = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
y

zipLeftover :: [a] -> [a] -> [a]
zipLeftover :: forall a. [a] -> [a] -> [a]
zipLeftover []     []     = []
zipLeftover [a]
xs     []     = [a]
xs
zipLeftover []     [a]
ys     = [a]
ys
zipLeftover (a
x:[a]
xs) (a
y:[a]
ys) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
zipLeftover [a]
xs [a]
ys

lastN :: Int -> [a] -> [a]
lastN :: forall a. Int -> [a] -> [a]
lastN Int
n [a]
xs = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
zipLeftover (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) [a]
xs

tsPointVal :: TsPoint a -> a 
tsPointVal :: forall a. TsPoint a -> a
tsPointVal (TsPoint Date
d a
v) = a
v

getValByDate :: Ts -> CutoffType -> Date -> Rational

getValByDate :: Ts -> CutoffType -> Date -> Rational
getValByDate (LeftBalanceCurve [TsPoint Balance]
dps) CutoffType
ct Date
d
  = case (TsPoint Balance -> Bool)
-> [TsPoint Balance] -> Maybe (TsPoint Balance)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Balance
_) -> (CutoffType -> Date -> Date -> Bool
forall {a}. Ord a => CutoffType -> a -> a -> Bool
cmpFun CutoffType
ct) Date
_d Date
d) ([TsPoint Balance] -> [TsPoint Balance]
forall a. [a] -> [a]
reverse [TsPoint Balance]
dps) of 
      Just (TsPoint Date
_d Balance
v) -> Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
v
      Maybe (TsPoint Balance)
Nothing -> Rational
0
    where 
      cmpFun :: CutoffType -> a -> a -> Bool
cmpFun CutoffType
Inc = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
      cmpFun CutoffType
Exc = a -> a -> Bool
forall a. Ord a => a -> a -> Bool
(<)

getValByDate (BalanceCurve [TsPoint Balance]
dps) CutoffType
Exc Date
d
  = case (TsPoint Balance -> Bool)
-> [TsPoint Balance] -> Maybe (TsPoint Balance)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Balance
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint Balance] -> [TsPoint Balance]
forall a. [a] -> [a]
reverse [TsPoint Balance]
dps)  of 
      Just (TsPoint Date
_d Balance
v) -> Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
v
      Maybe (TsPoint Balance)
Nothing -> Rational
0

getValByDate (BalanceCurve [TsPoint Balance]
dps) CutoffType
Inc Date
d
  = case (TsPoint Balance -> Bool)
-> [TsPoint Balance] -> Maybe (TsPoint Balance)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Balance
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d) ([TsPoint Balance] -> [TsPoint Balance]
forall a. [a] -> [a]
reverse [TsPoint Balance]
dps)  of 
      Just (TsPoint Date
_d Balance
v) -> Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
v
      Maybe (TsPoint Balance)
Nothing -> Rational
0

getValByDate (FloatCurve [TsPoint Rational]
dps) CutoffType
Exc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint Rational] -> [TsPoint Rational]
forall a. [a] -> [a]
reverse [TsPoint Rational]
dps)  of 
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (FloatCurve [TsPoint Rational]
dps) CutoffType
Inc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d) ([TsPoint Rational] -> [TsPoint Rational]
forall a. [a] -> [a]
reverse [TsPoint Rational]
dps)  of 
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (IRateCurve [TsPoint IRate]
dps) CutoffType
Exc Date
d
  = case (TsPoint IRate -> Bool) -> [TsPoint IRate] -> Maybe (TsPoint IRate)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d IRate
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint IRate] -> [TsPoint IRate]
forall a. [a] -> [a]
reverse [TsPoint IRate]
dps)  of
      Just (TsPoint Date
_d IRate
v) -> IRate -> Rational
forall a. Real a => a -> Rational
toRational IRate
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint IRate)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (IRateCurve [TsPoint IRate]
dps) CutoffType
Inc Date
d
  = case (TsPoint IRate -> Bool) -> [TsPoint IRate] -> Maybe (TsPoint IRate)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d IRate
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d) ([TsPoint IRate] -> [TsPoint IRate]
forall a. [a] -> [a]
reverse [TsPoint IRate]
dps)  of
      Just (TsPoint Date
_d IRate
v) -> IRate -> Rational
forall a. Real a => a -> Rational
toRational IRate
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint IRate)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (RatioCurve [TsPoint Rational]
dps) CutoffType
Exc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint Rational] -> [TsPoint Rational]
forall a. [a] -> [a]
reverse [TsPoint Rational]
dps)  of
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (RatioCurve [TsPoint Rational]
dps) CutoffType
Inc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
_d) ([TsPoint Rational] -> [TsPoint Rational]
forall a. [a] -> [a]
reverse [TsPoint Rational]
dps)  of
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> Rational
0              -- `debug` ("Getting 0 ")

getValByDate (ThresholdCurve [TsPoint Rational]
dps) CutoffType
Inc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
_d) [TsPoint Rational]
dps  of
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> TsPoint Rational -> Rational
forall a. TsPoint a -> a
tsPointVal (TsPoint Rational -> Rational) -> TsPoint Rational -> Rational
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
last [TsPoint Rational]
dps --`debug` ("Not found in gvbd")

getValByDate (ThresholdCurve [TsPoint Rational]
dps) CutoffType
Exc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
< Date
_d) [TsPoint Rational]
dps  of
      Just (TsPoint Date
_d Rational
v) -> Rational -> Rational
forall a. Real a => a -> Rational
toRational Rational
v  -- `debug` ("Getting rate "++show(_d)++show(v))
      Maybe (TsPoint Rational)
Nothing -> TsPoint Rational -> Rational
forall a. TsPoint a -> a
tsPointVal (TsPoint Rational -> Rational) -> TsPoint Rational -> Rational
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
last [TsPoint Rational]
dps --`debug` ("Not found in gvbd")

getValByDate (FactorCurveClosed [TsPoint Rational]
dps Date
ed) CutoffType
Exc Date
d
  = case (TsPoint Rational -> Bool)
-> [TsPoint Rational] -> Maybe (TsPoint Rational)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(TsPoint Date
_d Rational
_) -> Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
_d) ([TsPoint Rational] -> [TsPoint Rational]
forall a. [a] -> [a]
reverse [TsPoint Rational]
dps)  of 
      Just found :: TsPoint Rational
found@(TsPoint Date
_found_d Rational
_found_v) -> 
        if Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
ed then 
          Rational
1.0
        else 
          Rational
_found_v
      Maybe (TsPoint Rational)
Nothing -> Rational
1.0

getValByDate (PricingCurve [TsPoint Rational]
dps) CutoffType
_ Date
d
  = case (Date
dDate -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>=Date
lday,Date
dDate -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<=Date
fday) of 
      (Bool
True,Bool
_) -> TsPoint Rational -> Rational
forall a. TsPoint a -> a
tsPointVal (TsPoint Rational -> Rational) -> TsPoint Rational -> Rational
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
last [TsPoint Rational]
dps
      (Bool
_,Bool
True) -> TsPoint Rational -> Rational
forall a. TsPoint a -> a
tsPointVal (TsPoint Rational -> Rational) -> TsPoint Rational -> Rational
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
head [TsPoint Rational]
dps
      (Bool, Bool)
_  -> let 
              rindex :: Int
rindex = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$(TsPoint Rational -> Bool) -> [TsPoint Rational] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(TsPoint Date
_dl Rational
_) -> ( Date
_dl Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
> Date
d )) [TsPoint Rational]
dps
              rdp :: TsPoint Rational
rdp@(TsPoint Date
_dr Rational
_rv) = [TsPoint Rational]
dps[TsPoint Rational] -> Int -> TsPoint Rational
forall a. HasCallStack => [a] -> Int -> a
!!Int
rindex 
              ldp :: TsPoint Rational
ldp@(TsPoint Date
_dl Rational
_lv) = [TsPoint Rational]
dps[TsPoint Rational] -> Int -> TsPoint Rational
forall a. HasCallStack => [a] -> Int -> a
!!(Int -> Int
forall a. Enum a => a -> a
pred Int
rindex)
              leftDistance :: Rational
leftDistance = Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Integer -> Rational
forall a b. (a -> b) -> a -> b
$ Date -> Date -> Integer
daysBetween Date
_dl Date
d  -- `debug` ("LEFT"++show d)
              distance :: Rational
distance = Integer -> Rational
forall a. Real a => a -> Rational
toRational (Integer -> Rational) -> Integer -> Rational
forall a b. (a -> b) -> a -> b
$ Date -> Date -> Integer
daysBetween Date
_dl Date
_dr  -- `debug` ("TOTAL Horizion"++show _dl++show _dr)
              vdistance :: Rational
vdistance =  Rational
_rv Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
_lv -- ("DIST")
            in 
              Rational -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
_lv Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational
vdistance Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
leftDistance) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
distance 
 --              `debug` ("PricingCurve get Val: D "++ show _lv++">>"++ show vdistance++">>"++ show leftDistance++">>"++ show distance)
    where 
      fday :: Date
fday = TsPoint Rational -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsPoint Rational -> Date) -> TsPoint Rational -> Date
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
head [TsPoint Rational]
dps
      lday :: Date
lday = TsPoint Rational -> Date
forall ts. TimeSeries ts => ts -> Date
getDate (TsPoint Rational -> Date) -> TsPoint Rational -> Date
forall a b. (a -> b) -> a -> b
$ [TsPoint Rational] -> TsPoint Rational
forall a. HasCallStack => [a] -> a
last [TsPoint Rational]
dps

getValByDate Ts
a CutoffType
b Date
c = [Char] -> Rational
forall a. HasCallStack => [Char] -> a
error ([Char] -> Rational) -> [Char] -> Rational
forall a b. (a -> b) -> a -> b
$ [Char]
"Not match for curve type"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Ts -> [Char]
forall a. Show a => a -> [Char]
show Ts
a[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" > "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++CutoffType -> [Char]
forall a. Show a => a -> [Char]
show CutoffType
b[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" > " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
c


getIndexRateByDates :: RateAssumption  -> [Date] -> [IRate]
getIndexRateByDates :: RateAssumption -> [Date] -> [IRate]
getIndexRateByDates (RateCurve Index
idx Ts
rc) [Date]
ds = Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational (Rational -> IRate) -> [Rational] -> [IRate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ts -> CutoffType -> [Date] -> [Rational]
getValByDates Ts
rc CutoffType
Inc [Date]
ds
getIndexRateByDates (RateFlat Index
idx IRate
r) [Date]
ds = Int -> IRate -> [IRate]
forall a. Int -> a -> [a]
replicate ([Date] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Date]
ds) IRate
r 

getValByDates :: Ts -> CutoffType -> [Date] -> [Rational]
getValByDates :: Ts -> CutoffType -> [Date] -> [Rational]
getValByDates Ts
rc CutoffType
ct = (Date -> Rational) -> [Date] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Ts -> CutoffType -> Date -> Rational
getValByDate Ts
rc CutoffType
ct)

getTsVals :: Ts -> [Rational]
getTsVals :: Ts -> [Rational]
getTsVals (FloatCurve [TsPoint Rational]
ts) = [ Rational
v | (TsPoint Date
d Rational
v) <- [TsPoint Rational]
ts ]
getTsVals (RatioCurve [TsPoint Rational]
ts) = [ Rational
v | (TsPoint Date
d Rational
v) <- [TsPoint Rational]
ts ]
getTsVals (BalanceCurve [TsPoint Balance]
ts) = [ Balance -> Rational
forall a. Real a => a -> Rational
toRational Balance
v | (TsPoint Date
d Balance
v) <- [TsPoint Balance]
ts ]
getTsVals (IRateCurve [TsPoint IRate]
ts) = [ IRate -> Rational
forall a. Real a => a -> Rational
toRational IRate
v | (TsPoint Date
d IRate
v) <- [TsPoint IRate]
ts ]

getTsDates :: Ts -> [Date]
getTsDates :: Ts -> [Date]
getTsDates (IRateCurve [TsPoint IRate]
tps) =  (TsPoint IRate -> Date) -> [TsPoint IRate] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map TsPoint IRate -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [TsPoint IRate]
tps
getTsDates (RatioCurve [TsPoint Rational]
tps) =  (TsPoint Rational -> Date) -> [TsPoint Rational] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map TsPoint Rational -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [TsPoint Rational]
tps
getTsDates (FloatCurve [TsPoint Rational]
tps) =  (TsPoint Rational -> Date) -> [TsPoint Rational] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map TsPoint Rational -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [TsPoint Rational]
tps
getTsDates (PricingCurve [TsPoint Rational]
tps) =  (TsPoint Rational -> Date) -> [TsPoint Rational] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map TsPoint Rational -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [TsPoint Rational]
tps
getTsDates (BalanceCurve [TsPoint Balance]
tps) =  (TsPoint Balance -> Date) -> [TsPoint Balance] -> [Date]
forall a b. (a -> b) -> [a] -> [b]
map TsPoint Balance -> Date
forall ts. TimeSeries ts => ts -> Date
getDate [TsPoint Balance]
tps

getTsSize :: Ts -> Int 
getTsSize :: Ts -> Int
getTsSize Ts
ts = [Rational] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Ts -> [Rational]
getTsVals Ts
ts)

zipTs :: [Date] -> [Rational] -> Ts 
zipTs :: [Date] -> [Rational] -> Ts
zipTs [Date]
ds [Rational]
rs = [TsPoint Rational] -> Ts
FloatCurve [ Date -> Rational -> TsPoint Rational
forall a. Date -> a -> TsPoint a
TsPoint Date
d Rational
r | (Date
d,Rational
r) <- [Date] -> [Rational] -> [(Date, Rational)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Date]
ds [Rational]
rs ]

zipBalTs :: [Date] -> [Balance] -> Ts
zipBalTs :: [Date] -> [Balance] -> Ts
zipBalTs [Date]
ds [Balance]
rs = [TsPoint Balance] -> Ts
BalanceCurve [ Date -> Balance -> TsPoint Balance
forall a. Date -> a -> TsPoint a
TsPoint Date
d Balance
r | (Date
d,Balance
r) <- [Date] -> [Balance] -> [(Date, Balance)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Date]
ds [Balance]
rs ]

-- ^ multiply 1st Ts with values from 2nd Ts
multiplyTs :: CutoffType -> Ts -> Ts -> Ts
multiplyTs :: CutoffType -> Ts -> Ts -> Ts
multiplyTs CutoffType
ct (FloatCurve [TsPoint Rational]
ts1) Ts
ts2
  = [TsPoint Rational] -> Ts
FloatCurve [(Date -> Rational -> TsPoint Rational
forall a. Date -> a -> TsPoint a
TsPoint Date
d (Rational
v Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Ts -> CutoffType -> Date -> Rational
getValByDate Ts
ts2 CutoffType
ct Date
d))) | (TsPoint Date
d Rational
v) <- [TsPoint Rational]
ts1 ] 

multiplyTs CutoffType
ct (IRateCurve [TsPoint IRate]
ts1) Ts
ts2
  = [TsPoint IRate] -> Ts
IRateCurve [(Date -> IRate -> TsPoint IRate
forall a. Date -> a -> TsPoint a
TsPoint Date
d (IRate
v IRate -> IRate -> IRate
forall a. Num a => a -> a -> a
* (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational (Ts -> CutoffType -> Date -> Rational
getValByDate Ts
ts2 CutoffType
ct Date
d)))) | (TsPoint Date
d IRate
v) <- [TsPoint IRate]
ts1 ] 

multiplyTs CutoffType
c Ts
a Ts
b = [Char] -> Ts
forall a. HasCallStack => [Char] -> a
error  ([Char] -> Ts) -> [Char] -> Ts
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed to match : multiplyTs"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CutoffType -> [Char]
forall a. Show a => a -> [Char]
show CutoffType
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ts -> [Char]
forall a. Show a => a -> [Char]
show Ts
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ts -> [Char]
forall a. Show a => a -> [Char]
show Ts
b


-- | swap a value in list with index supplied
replace :: [a] -> Int -> a -> [a]
replace :: forall a. [a] -> Int -> a -> [a]
replace [a]
xs Int
i a
e 
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Enum a => a -> a
pred ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a]) -> [Char] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char]
"index:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" is greater than size"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
  | Bool
otherwise = case Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs of
                   ([a]
before, a
_:[a]
after) -> [a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
after
                   ([a], [a])
_ -> [a]
xs

-- ^ padding default value to end of list ,make it length with N
paddingDefault :: a -> [a] -> Int -> [a]
paddingDefault :: forall a. a -> [a] -> Int -> [a]
paddingDefault a
x [a]
xs Int
s 
  | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
s = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
s [a]
xs
  | Bool
otherwise = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
x

capWith :: Ord a => a -> [a] -> [a]
capWith :: forall a. Ord a => a -> [a] -> [a]
capWith a
cap [a]
xs = [ a -> a -> a
forall a. Ord a => a -> a -> a
min a
cap a
x | a
x <- [a]
xs ]

floorWith :: Ord a => a -> [a] -> [a]
floorWith :: forall a. Ord a => a -> [a] -> [a]
floorWith a
floor [a]
xs = [ a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
floor | a
x <- [a]
xs]

diffNum :: Num a => [a] -> [a]
diffNum :: forall a. Num a => [a] -> [a]
diffNum [a]
xs = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
xs) ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs)

scaleByFstElement :: forall a. Fractional a => a -> [a] -> [a]
scaleByFstElement :: forall a. Fractional a => a -> [a] -> [a]
scaleByFstElement a
x [] = []
scaleByFstElement a
y (a
b:[a]
xs) = 
  let 
    s :: a
s = a
ya -> a -> a
forall a. Fractional a => a -> a -> a
/a
b 
  in 
    a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[ a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
s | a
x <- [a]
xs ]


debugLine :: Show a => [a] -> String 
debugLine :: forall a. Show a => [a] -> [Char]
debugLine [a]
xs = [Char]
""

lastOf:: [a] -> (a->Bool) -> Maybe a
lastOf :: forall a. [a] -> (a -> Bool) -> Maybe a
lastOf [] a -> Bool
fn = Maybe a
forall a. Maybe a
Nothing
lastOf [a]
xs a -> Bool
fn = 
  let 
    l :: a
l = [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
xs
  in 
    if a -> Bool
fn a
l then 
      a -> Maybe a
forall a. a -> Maybe a
Just a
l 
    else
      [a] -> (a -> Bool) -> Maybe a
forall a. [a] -> (a -> Bool) -> Maybe a
lastOf ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
init [a]
xs) a -> Bool
fn

shiftTsByAmt :: Ts -> Rational -> Ts 
shiftTsByAmt :: Ts -> Rational -> Ts
shiftTsByAmt (IRateCurve [TsPoint IRate]
tps) Rational
delta 
  = [TsPoint IRate] -> Ts
IRateCurve ([TsPoint IRate] -> Ts) -> [TsPoint IRate] -> Ts
forall a b. (a -> b) -> a -> b
$ [ Date -> IRate -> TsPoint IRate
forall a. Date -> a -> TsPoint a
TsPoint Date
d (Rational -> IRate
forall a. Fractional a => Rational -> a
fromRational Rational
deltaIRate -> IRate -> IRate
forall a. Num a => a -> a -> a
+IRate
v) | TsPoint Date
d IRate
v <- [TsPoint IRate]
tps ]

shiftTsByAmt Ts
_ts Rational
delta = Ts
_ts

assert1 :: Bool -> a -> String -> a
assert1 :: forall a. Bool -> a -> [Char] -> a
assert1 Bool
False a
x [Char]
msg = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
msg
assert1 Bool
_     a
x [Char]
_ = a
x


-- ^ get a weighted average balance on year basis with a dayCount required
calcWeightBalanceByDates :: DayCount -> [Balance] -> [Date] -> Balance 
calcWeightBalanceByDates :: DayCount -> [Balance] -> [Date] -> Balance
calcWeightBalanceByDates DayCount
dc [Balance]
bals [Date]
ds 
  = Bool -> Balance -> [Char] -> Balance
forall a. Bool -> a -> [Char] -> a
assert1
      (Int -> Int
forall a. Enum a => a -> a
succ Int
bs_length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ds_length) 
      ([Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Balance] -> Balance) -> [Balance] -> Balance
forall a b. (a -> b) -> a -> b
$ (Balance -> Rational -> Balance)
-> [Balance] -> [Rational] -> [Balance]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Balance -> Rational -> Balance
mulBR [Balance]
bals [Rational]
weights)
      [Char]
"calcWeightBalanceByDates: bs and ds should be same length"
      where 
        bs_length :: Int
bs_length = [Balance] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Balance]
bals 
        ds_length :: Int
ds_length = [Date] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Date]
ds
        weights :: [Rational]
weights = DayCount -> [Date] -> [Rational]
getIntervalFactorsDc DayCount
dc [Date]
ds

testSumToOne :: [Rate] -> Bool
testSumToOne :: [Rational] -> Bool
testSumToOne [Rational]
rs = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
rs Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
1.0

maximum' :: Ord a => [a] -> a
maximum' :: forall a. Ord a => [a] -> a
maximum' = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\a
x a
y ->if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y then a
x else a
y)

minimum' :: Ord a => [a] -> a
minimum' :: forall a. Ord a => [a] -> a
minimum' = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\a
x a
y ->if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
y then a
y else a
x)

roundingBy :: (Num a,Fractional a, RealFrac a) => RoundingBy a -> a -> a
roundingBy :: forall a.
(Num a, Fractional a, RealFrac a) =>
RoundingBy a -> a -> a
roundingBy (RoundFloor a
x) a
n = a
x a -> a -> a
forall a. Num a => a -> a -> a
* Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a
na -> a -> a
forall a. Fractional a => a -> a -> a
/a
x) :: Integer)
roundingBy (RoundCeil a
x) a
n = a
x a -> a -> a
forall a. Num a => a -> a -> a
* Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (a
na -> a -> a
forall a. Fractional a => a -> a -> a
/a
x) :: Integer)

roundingByM :: (Fractional a,RealFrac a) => Maybe (RoundingBy a) -> a -> a 
roundingByM :: forall a.
(Fractional a, RealFrac a) =>
Maybe (RoundingBy a) -> a -> a
roundingByM Maybe (RoundingBy a)
Nothing a
x = a
x 
roundingByM (Just RoundingBy a
rb) a
x = RoundingBy a -> a -> a
forall a.
(Num a, Fractional a, RealFrac a) =>
RoundingBy a -> a -> a
roundingBy RoundingBy a
rb a
x

slice :: Int -> Int -> [a] -> [a]
slice :: forall a. Int -> Int -> [a] -> [a]
slice Int
from Int
to [a]
xs = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
from ) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
from [a]
xs)

dropLastN :: Int -> [a] -> [a]
dropLastN :: forall a. Int -> [a] -> [a]
dropLastN Int
n [a]
xs = Int -> Int -> [a] -> [a]
forall a. Int -> Int -> [a] -> [a]
slice Int
0 ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
xs

-- ^ convert annual rate (in 365 days) to period rate by interval days
toPeriodRateByInterval :: Rate -> Int -> Rate
toPeriodRateByInterval :: Rational -> Int -> Rational
toPeriodRateByInterval Rational
annualRate Int
days
  = Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Rational) -> Double -> Rational
forall a b. (a -> b) -> a -> b
$ Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational
1Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
annualRate) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
days Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
365) -- `debug` ("days>>"++show days++"DIV"++ show ((fromIntegral days) / 365))

scaleUpToOne :: [Rational] -> [Rational]
scaleUpToOne :: [Rational] -> [Rational]
scaleUpToOne [Rational]
rs =
  let 
    s :: Rational
s = Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Rational]
rs
  in 
    (Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*) (Rational -> Rational) -> [Rational] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rational]
rs 


findBox :: (Ord a,Num a) => (CutoffType,CutoffType) -> a -> [(a,a)] -> Maybe (a,a)
findBox :: forall a.
(Ord a, Num a) =>
(CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
findBox (CutoffType, CutoffType)
_ a
x [] = Maybe (a, a)
forall a. Maybe a
Nothing
findBox (CutoffType
Inc,CutoffType
Inc) a
x ((a
l,a
h):[(a, a)]
xs) 
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
h = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
l,a
h)
  | Bool
otherwise = (CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
forall a.
(Ord a, Num a) =>
(CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
findBox (CutoffType
Inc,CutoffType
Inc) a
x [(a, a)]
xs

findBox (CutoffType
Exc,CutoffType
Inc) a
x ((a
l,a
h):[(a, a)]
xs) 
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
l Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
h = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
l,a
h)
  | Bool
otherwise = (CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
forall a.
(Ord a, Num a) =>
(CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
findBox (CutoffType
Exc,CutoffType
Inc) a
x [(a, a)]
xs

findBox (CutoffType
Inc,CutoffType
Exc) a
x ((a
l,a
h):[(a, a)]
xs) 
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
h = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
l,a
h)
  | Bool
otherwise = (CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
forall a.
(Ord a, Num a) =>
(CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
findBox (CutoffType
Inc,CutoffType
Exc) a
x [(a, a)]
xs

findBox (CutoffType
Exc,CutoffType
Exc) a
x ((a
l,a
h):[(a, a)]
xs) 
  | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
l Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
h = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just (a
l,a
h)
  | Bool
otherwise = (CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
forall a.
(Ord a, Num a) =>
(CutoffType, CutoffType) -> a -> [(a, a)] -> Maybe (a, a)
findBox (CutoffType
Exc,CutoffType
Exc) a
x [(a, a)]
xs


safeDivide' :: (Eq a, Fractional a, Real a) => a -> a -> Rational
safeDivide' :: forall a. (Eq a, Fractional a, Real a) => a -> a -> Rational
safeDivide' a
_ a
0 = Rational
10000000000000000000000000000000000000000000000000000
safeDivide' a
x a
y = a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ a -> Rational
forall a. Real a => a -> Rational
toRational a
y


lstToMapByFn :: (a -> String) -> [a] -> M.Map String a 
lstToMapByFn :: forall a. (a -> [Char]) -> [a] -> Map [Char] a
lstToMapByFn a -> [Char]
fn [a]
lst =
  let 
    ks :: [[Char]]
ks = a -> [Char]
fn (a -> [Char]) -> [a] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
lst 
  in 
    [([Char], a)] -> Map [Char] a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], a)] -> Map [Char] a) -> [([Char], a)] -> Map [Char] a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [a] -> [([Char], a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
ks [a]
lst

paySeqM :: Date -> Amount -> (a->Balance) -> (Amount->a->Either String a) -> Either String [a] -> [a] -> Either String ([a],Amount)
paySeqM :: forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> Either [Char] a)
-> Either [Char] [a]
-> [a]
-> Either [Char] ([a], Balance)
paySeqM Date
d Balance
amt a -> Balance
getDueAmt Balance -> a -> Either [Char] a
payFn Either [Char] [a]
paidList []
  = do 
      [a]
pList <- Either [Char] [a]
paidList 
      ([a], Balance) -> Either [Char] ([a], Balance)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
pList, Balance
amt)
paySeqM Date
d Balance
0 a -> Balance
getDueAmt Balance -> a -> Either [Char] a
payFn Either [Char] [a]
paidList [a]
tobePaidList
  = do 
      [a]
pList <- Either [Char] [a]
paidList 
      ([a], Balance) -> Either [Char] ([a], Balance)
forall a. a -> Either [Char] a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
pList[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
tobePaidList, Balance
0)
paySeqM Date
d Balance
amt a -> Balance
getDueAmt Balance -> a -> Either [Char] a
payFn Either [Char] [a]
paidList (a
l:[a]
tobePaidList)
  = do 
      let dueAmt :: Balance
dueAmt = a -> Balance
getDueAmt a
l
      let actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt Balance
dueAmt 
      let remainAmt :: Balance
remainAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
actualPaidOut
      a
paidL <- Balance -> a -> Either [Char] a
payFn Balance
actualPaidOut a
l
      [a]
paidList_ <- Either [Char] [a]
paidList
      Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> Either [Char] a)
-> Either [Char] [a]
-> [a]
-> Either [Char] ([a], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> Either [Char] a)
-> Either [Char] [a]
-> [a]
-> Either [Char] ([a], Balance)
paySeqM Date
d Balance
remainAmt a -> Balance
getDueAmt Balance -> a -> Either [Char] a
payFn ([a] -> Either [Char] [a]
forall a b. b -> Either a b
Right ([a] -> Either [Char] [a]) -> [a] -> Either [Char] [a]
forall a b. (a -> b) -> a -> b
$ a
paidLa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
paidList_) [a]
tobePaidList

paySequentially :: Date -> Amount -> (a->Balance) -> (Amount->a->a) -> [a] -> [a] -> ([a],Amount)
paySequentially :: forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
amt a -> Balance
getDueAmt Balance -> a -> a
payFn [a]
paidList []
  = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
paidList, Balance
amt)
paySequentially Date
d Balance
0 a -> Balance
getDueAmt Balance -> a -> a
payFn [a]
paidList [a]
tobePaidList
  = ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
paidList[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
tobePaidList, Balance
0)
paySequentially Date
d Balance
amt a -> Balance
getDueAmt Balance -> a -> a
payFn [a]
paidList (a
l:[a]
tobePaidList)
  = let 
      dueAmt :: Balance
dueAmt = a -> Balance
getDueAmt a
l
      actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt Balance
dueAmt 
      remainAmt :: Balance
remainAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
actualPaidOut
      paidL :: a
paidL = Balance -> a -> a
payFn Balance
actualPaidOut a
l
    in 
      Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> [a]
-> ([a], Balance)
paySequentially Date
d Balance
remainAmt a -> Balance
getDueAmt Balance -> a -> a
payFn (a
paidLa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
paidList) [a]
tobePaidList

payProRata :: Date -> Amount -> (a->Balance) -> (Amount->a->a) -> [a] -> ([a],Amount)
payProRata :: forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [a]
-> ([a], Balance)
payProRata Date
d Balance
amt a -> Balance
getDueAmt Balance -> a -> a
payFn [a]
tobePaidList
  = let 
      dueAmts :: [Balance]
dueAmts = a -> Balance
getDueAmt (a -> Balance) -> [a] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
tobePaidList
      totalDueAmt :: Balance
totalDueAmt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum  [Balance]
dueAmts
      actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
amt Balance
totalDueAmt
      remainAmt :: Balance
remainAmt = Balance
amt Balance -> Balance -> Balance
forall a. Num a => a -> a -> a
- Balance
actualPaidOut

      allocAmt :: [Balance]
allocAmt = [Balance] -> Balance -> [Balance]
prorataFactors [Balance]
dueAmts Balance
actualPaidOut

      paidList :: [a]
paidList = [ Balance -> a -> a
payFn Balance
amt a
l | (Balance
amt,a
l) <- [Balance] -> [a] -> [(Balance, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Balance]
allocAmt [a]
tobePaidList ]
    in 
      ([a]
paidList, Balance
remainAmt)

payInMap :: Date -> Balance -> (a->Balance) -> (Balance->a->a)-> [String] 
          -> HowToPay -> Map.Map String a -> Map.Map String a
payInMap :: forall a.
Date
-> Balance
-> (a -> Balance)
-> (Balance -> a -> a)
-> [[Char]]
-> HowToPay
-> Map [Char] a
-> Map [Char] a
payInMap Date
d Balance
amt a -> Balance
getDueFn Balance -> a -> a
payFn [[Char]]
objNames HowToPay
how Map [Char] a
inputMap 
  = let 
      objsToPay :: [a]
objsToPay = (Map [Char] a
inputMap Map [Char] a -> [Char] -> a
forall k a. Ord k => Map k a -> k -> a
Map.!) ([Char] -> a) -> [[Char]] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
objNames  
      dueAmts :: [Balance]
dueAmts = a -> Balance
getDueFn (a -> Balance) -> [a] -> [Balance]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
objsToPay
      totalDueAmt :: Balance
totalDueAmt = [Balance] -> Balance
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Balance]
dueAmts
      actualPaidOut :: Balance
actualPaidOut = Balance -> Balance -> Balance
forall a. Ord a => a -> a -> a
min Balance
totalDueAmt Balance
amt
      allocatedPayAmt :: [Balance]
allocatedPayAmt = case HowToPay
how of 
                          HowToPay
ByProRata -> [Balance] -> Balance -> [Balance]
prorataFactors [Balance]
dueAmts Balance
actualPaidOut
                          HowToPay
BySequential -> Balance -> [Balance] -> [Balance]
paySeqLiabilitiesAmt Balance
amt [Balance]
dueAmts
      paidObjs :: [a]
paidObjs = [ Balance -> a -> a
payFn Balance
amt a
l | (Balance
amt,a
l) <- [Balance] -> [a] -> [(Balance, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Balance]
allocatedPayAmt [a]
objsToPay ]
    in 
      ([([Char], a)] -> Map [Char] a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Char], a)] -> Map [Char] a) -> [([Char], a)] -> Map [Char] a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [a] -> [([Char], a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
objNames [a]
paidObjs) Map [Char] a -> Map [Char] a -> Map [Char] a
forall a. Semigroup a => a -> a -> a
<> Map [Char] a
inputMap

mapWithinMap :: Ord k => (a -> a) -> [k] -> Map.Map k a -> Map.Map k a  
mapWithinMap :: forall k a. Ord k => (a -> a) -> [k] -> Map k a -> Map k a
mapWithinMap a -> a
fn [k]
ks Map k a
m = (k -> Map k a -> Map k a) -> Map k a -> [k] -> Map k a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a) -> k -> Map k a -> Map k a
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust a -> a
fn) Map k a
m [k]
ks

adjustM :: (Ord k, Applicative m) => (a -> m a) -> k -> Map.Map k a -> m (Map.Map k a)
adjustM :: forall k (m :: * -> *) a.
(Ord k, Applicative m) =>
(a -> m a) -> k -> Map k a -> m (Map k a)
adjustM a -> m a
f = (Maybe a -> m (Maybe a)) -> k -> Map k a -> m (Map k a)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF ((a -> m a) -> Maybe a -> m (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse a -> m a
f)

-- ^ lookup and apply a function to a single value in a map ,return a value
lookupAndApply :: Ord k => (a -> b) -> String -> k -> Map.Map k a -> Either String b
lookupAndApply :: forall k a b.
Ord k =>
(a -> b) -> [Char] -> k -> Map k a -> Either [Char] b
lookupAndApply a -> b
f [Char]
errMsg k
key Map k a
m =
  case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map k a
m of
    Maybe a
Nothing -> [Char] -> Either [Char] b
forall a b. a -> Either a b
Left [Char]
errMsg
    Just a
a  -> b -> Either [Char] b
forall a b. b -> Either a b
Right (b -> Either [Char] b) -> b -> Either [Char] b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a

-- ^ lookup and apply a function to values in a map ,return a list
lookupAndApplies :: Ord k => (a -> b) -> String -> [k] -> Map.Map k a -> Either String [b]
lookupAndApplies :: forall k a b.
Ord k =>
(a -> b) -> [Char] -> [k] -> Map k a -> Either [Char] [b]
lookupAndApplies a -> b
f [Char]
errMsg [k]
keys Map k a
m 
  = [Either [Char] b] -> Either [Char] [b]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either [Char] b] -> Either [Char] [b])
-> [Either [Char] b] -> Either [Char] [b]
forall a b. (a -> b) -> a -> b
$ (\k
x -> (a -> b) -> [Char] -> k -> Map k a -> Either [Char] b
forall k a b.
Ord k =>
(a -> b) -> [Char] -> k -> Map k a -> Either [Char] b
lookupAndApply a -> b
f [Char]
errMsg k
x Map k a
m) (k -> Either [Char] b) -> [k] -> [Either [Char] b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k]
keys

lookupAndUpdate :: (Show k, Ord k) => (a -> a) -> String -> [k] -> Map.Map k a -> Either String (Map.Map k a) 
lookupAndUpdate :: forall k a.
(Show k, Ord k) =>
(a -> a) -> [Char] -> [k] -> Map k a -> Either [Char] (Map k a)
lookupAndUpdate a -> a
f [Char]
errMsg [k]
keys Map k a
m 
  | Set k -> Set k -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set k
inputKs Set k
mapKs = Map k a -> Either [Char] (Map k a)
forall a b. b -> Either a b
Right (Map k a -> Either [Char] (Map k a))
-> Map k a -> Either [Char] (Map k a)
forall a b. (a -> b) -> a -> b
$ (a -> a) -> [k] -> Map k a -> Map k a
forall k a. Ord k => (a -> a) -> [k] -> Map k a -> Map k a
mapWithinMap a -> a
f [k]
keys Map k a
m
  | Bool
otherwise = [Char] -> Either [Char] (Map k a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (Map k a))
-> [Char] -> Either [Char] (Map k a)
forall a b. (a -> b) -> a -> b
$ [Char]
errMsg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
":Missing keys, valid range "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set k -> [Char]
forall a. Show a => a -> [Char]
show Set k
mapKs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"But got:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set k -> [Char]
forall a. Show a => a -> [Char]
show Set k
inputKs
  where 
      inputKs :: Set k
inputKs = [k] -> Set k
forall a. Ord a => [a] -> Set a
S.fromList [k]
keys
      mapKs :: Set k
mapKs = Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k a
m

lookupInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a)
lookupInMap :: forall k a.
(Show k, Ord k) =>
[Char] -> [k] -> Map k a -> Either [Char] (Map k a)
lookupInMap = (a -> a) -> [Char] -> [k] -> Map k a -> Either [Char] (Map k a)
forall k a.
(Show k, Ord k) =>
(a -> a) -> [Char] -> [k] -> Map k a -> Either [Char] (Map k a)
lookupAndUpdate a -> a
forall a. a -> a
id  

selectInMap :: (Show k, Ord k) => String -> [k] -> Map.Map k a -> Either String (Map.Map k a)
selectInMap :: forall k a.
(Show k, Ord k) =>
[Char] -> [k] -> Map k a -> Either [Char] (Map k a)
selectInMap [Char]
errMsg [k]
keys Map k a
m 
  | Set k -> Set k -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set k
inputKs Set k
mapKs = Map k a -> Either [Char] (Map k a)
forall a b. b -> Either a b
Right (Map k a -> Either [Char] (Map k a))
-> Map k a -> Either [Char] (Map k a)
forall a b. (a -> b) -> a -> b
$ (k -> a -> Bool) -> Map k a -> Map k a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\k
k a
_ -> k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member k
k Set k
inputKs) Map k a
m
  | Bool
otherwise = [Char] -> Either [Char] (Map k a)
forall a b. a -> Either a b
Left ([Char] -> Either [Char] (Map k a))
-> [Char] -> Either [Char] (Map k a)
forall a b. (a -> b) -> a -> b
$ [Char]
errMsg[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
":Missing keys, valid range "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set k -> [Char]
forall a. Show a => a -> [Char]
show Set k
mapKs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"But got:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set k -> [Char]
forall a. Show a => a -> [Char]
show Set k
inputKs
  where 
      inputKs :: Set k
inputKs = [k] -> Set k
forall a. Ord a => [a] -> Set a
S.fromList [k]
keys
      mapKs :: Set k
mapKs = Map k a -> Set k
forall k a. Map k a -> Set k
Map.keysSet Map k a
m

lookupTuple6 :: (Ord k) => (k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple6 :: forall k v.
Ord k =>
(k, k, k, k, k, k)
-> Map k v
-> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple6 (k
k1, k
k2, k
k3, k
k4, k
k5, k
k6) Map k v
m =
  ( k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k1 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k2 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k3 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k4 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k5 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k6 Map k v
m)

lookupTuple7 :: (Ord k) => (k, k, k, k, k, k, k) -> Map.Map k v -> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple7 :: forall k v.
Ord k =>
(k, k, k, k, k, k, k)
-> Map k v
-> (Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v, Maybe v)
lookupTuple7 (k
k1, k
k2, k
k3, k
k4, k
k5, k
k6, k
k7) Map k v
m =
  ( k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k1 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k2 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k3 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k4 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k5 Map k v
m , k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k6 Map k v
m, k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k7 Map k v
m)


splitByLengths :: Num a => [a] -> [Int] -> [[a]]
splitByLengths :: forall a. Num a => [a] -> [Int] -> [[a]]
splitByLengths [a]
xs [Int]
ns = [a] -> [Int] -> [[a]]
forall {a}. [a] -> [Int] -> [[a]]
go [a]
xs [Int]
ns
  where
    go :: [a] -> [Int] -> [[a]]
go [a]
_ [] = []
    go [] [Int]
_ = []
    go [a]
xs (Int
n:[Int]
ns) = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [Int] -> [[a]]
go (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
xs) [Int]
ns

----- DEBUG/PRINT
debugOnDate :: Date -> Date -> Date -> String
debugOnDate :: Date -> Date -> Date -> [Char]
debugOnDate Date
d1 Date
d2 Date
d 
  | (Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
<= Date
d2) Bool -> Bool -> Bool
&& (Date
d Date -> Date -> Bool
forall a. Ord a => a -> a -> Bool
>= Date
d1)  = [Char]
"Date:"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Date -> [Char]
forall a. Show a => a -> [Char]
show Date
d
  | Bool
otherwise = [Char]
""