-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathmain.hs
159 lines (148 loc) · 7.82 KB
/
main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
{-# LANGUAGE OverloadedStrings #-}
import DataLoader
import PolicyHolders
import Mortalities
import Morbidities
import Premium
import Lapse
import Claim
import Reserve
import Utils
-- Timer
import Control.Exception
import Formatting
import Formatting.Clock
import System.Clock
main :: IO ()
main = do start <- getTime Monotonic
p <- DataLoader.loadPolicyHolder
loopList p
end <- getTime Monotonic
fprint (timeSpecs % "\n") start end
return ()
loopList [] = putStr "end\n"
loopList (x:xs) = do l <- DataLoader.loadLapseTable
let policyHolder = x
let policyTermMonth = policyTermM policyHolder
m <- readMortTable policyHolder
mb <- readMorbTable policyHolder
let mortalityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) m
-- putStr $ show mortalityTable
let monthlyTable = ageMortToMonthMort mortalityTable
-- putStr $ show $ length monthlyTable
--Morbidity table
let morbidityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) mb
-- putStr $ show mortalityTable
let monthlyTable_Morb = ageMorbToMonthMorb morbidityTable
-- putStr $ show $ length monthlyTable
let lapseTable = take (policyTermMonth `div` 12) l
-- putStr $ show lapseTable
let lapseFlow = lapseFlowPerPolicy (lapseMode policyHolder) lapseTable
-- putStr $ show lapseFlow
let policyFlow = expectedPoliciesInForceWithMorbLapse 1 monthlyTable monthlyTable_Morb lapseFlow
--putStr $ show policyFlow
--putStr $ "\n"
let premPerPolicy = premiumPerPolicyFlow policyTermMonth (premium policyHolder)
--putStr $ show premPerPolicy
--putStr $ "\n"
let premiumFlow = expectedPremiumFlow policyFlow premPerPolicy
-- putStr $ show premiumFlow
-- putStr $ "\n"
let claim = expectedClaim policyFlow monthlyTable (sumAssd policyHolder) monthlyTable_Morb 100 lapseFlow 0.0
--putStr $ show claim
--putStr $ "\n"
let mortClaim = expectedClaimOfMort policyFlow monthlyTable (sumAssd policyHolder)
let morbClaim = expectedClaimOfMorb policyFlow monthlyTable_Morb 100
let reserve = reserveDiscount premiumFlow mortClaim morbClaim 0.00426532
putStr $ "Reserve in month \n"
putStr $ show reserve
return ()
--putStr "-----------------------------"
loopList xs
--A demo of a 5 year term
singleTest :: IO ()
singleTest = do p <- DataLoader.loadPolicyHolder
l <- DataLoader.loadLapseTable
let policyHolder = head p
let policyTermMonth = policyTermM policyHolder
m <- readMortTable policyHolder
mb <- readMorbTable policyHolder
let mortalityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) m
-- putStr $ show mortalityTable
let monthlyTable = ageMortToMonthMort mortalityTable
-- putStr $ show $ length monthlyTable
let morbidityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) mb
-- putStr $ show mortalityTable
let monthlyTable_Morb = ageMorbToMonthMorb morbidityTable
--putStr $ show monthlyTable_Morb
--putStr $ "\n"
let lapseTable = take (policyTermMonth `div` 12) l
-- putStr $ show lapseTable
let lapseFlow = lapseFlowPerPolicy (lapseMode policyHolder) lapseTable
-- putStr $ show lapseFlow
let policyFlow = expectedPoliciesInForceWithMorbLapse 1 monthlyTable monthlyTable_Morb lapseFlow
--putStr $ show policyFlow
let premPerPolicy = premiumPerPolicyFlow policyTermMonth (premium policyHolder)
--putStr $ show premPerPolicy
--putStr $ "\n"
let premiumFlow = expectedPremiumFlow policyFlow premPerPolicy
-- putStr $ show premiumFlow
-- putStr $ "\n"
let claim = expectedClaim policyFlow monthlyTable (sumAssd policyHolder) monthlyTable_Morb 100 lapseFlow 0.0
--putStr $ show claim
--putStr $ "\n"
let mortClaim = expectedClaimOfMort policyFlow monthlyTable (sumAssd policyHolder)
--putStr $ show mortClaim
--putStr $ "\n"
let morbClaim = expectedClaimOfMorb policyFlow monthlyTable_Morb 100
--putStr $ show morbClaim
let reserve = reserveDiscount premiumFlow mortClaim morbClaim 0.00426532
putStr $ show reserve
return()
endowmentTest :: IO ()
endowmentTest = do p <- DataLoader.loadPolicyHolder
l <- DataLoader.loadLapseTable
let policyHolder = head p
let policyTermMonth = policyTermM policyHolder
m <- readMortTable policyHolder
mb <- readMorbTable policyHolder
let mortalityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) m
-- putStr $ show mortalityTable
let monthlyTable = ageMortToMonthMort mortalityTable
-- putStr $ show $ length monthlyTable
let morbidityTable = sublist (ageEntry policyHolder) (policyTermMonth `div` 12) mb
-- putStr $ show mortalityTable
let monthlyTable_Morb = replicate policyTermMonth 0
--putStr $ show monthlyTable_Morb
--putStr $ "\n"
let lapseTable = take (policyTermMonth `div` 12) l
-- putStr $ show lapseTable
let lapseFlow = lapseFlowPerPolicy (lapseMode policyHolder) lapseTable
-- putStr $ show lapseFlow
let policyFlow = expectedPoliciesInForceWithMorbLapse 1 monthlyTable monthlyTable_Morb lapseFlow
--putStr $ show policyFlow
let premPerPolicy = premiumPerPolicyFlow policyTermMonth (premium policyHolder)
--putStr $ show premPerPolicy
--putStr $ "\n"
let premiumFlow = expectedPremiumFlow policyFlow premPerPolicy
-- putStr $ show premiumFlow
-- putStr $ "\n"
let claim = expectedClaim policyFlow monthlyTable (sumAssd policyHolder) monthlyTable_Morb 100 lapseFlow 0.0
--putStr $ show claim
--putStr $ "\n"
let mortClaim = expectedClaimOfMort policyFlow monthlyTable (sumAssd policyHolder)
--putStr $ show mortClaim
--putStr $ "\n"
let morbClaim = expectedClaimOfMorb policyFlow monthlyTable_Morb 100
--putStr $ show morbClaim
let reserve = reserveDiscount premiumFlow mortClaim morbClaim 0.00426532
putStr $ show reserve
return()
readMortTable policyHolder =
case sex policyHolder of
'M' -> DataLoader.loadMortalityMTables
'F' -> DataLoader.loadMortalityFTables
readMorbTable policyHolder =
case sex policyHolder of
'M' -> DataLoader.loadMorbidityMTables
'F' -> DataLoader.loadMorbidityFTables