forked from yimengyin16/Model_Main
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Model_Master.R
245 lines (181 loc) · 9.99 KB
/
Model_Master.R
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
# Actuarial Valuation in a simple setting
# Yimeng Yin
# 5/27/2015
# This program consists of following files:
# Model_master.R
# Model_Decrements.R
# Model_Import_Plan.R
# Model_InvReturns.R
# Model_Population.R
# Model_IndvLiab.R
# Model_AggLiab.R
# Model_Sim.R
# Functions.R
# Data:
# Package "pp.prototypes"
# Package "decrements"
# winklevossdata.rdata: generated by "Inputs_import_Decrements.R" using "Data/Winklevoss(6).xlsx" and "Data/GAM-1971-Male.xls".
# example_Salary_benefit.RData: generated by "Inputs_Salary_Benefit.R" using "Data/PA-PERS.xlsx". ((no longer used in curretn version)
# Goals:
# 1. Conduct actuarial valuations each year during a time period of 100 years, allowing for stochastic investment returns.
# 2. Conduct the stochastic simulation for 2000 times.
# Assumptions
# Plan Desgin
# Beneficiary: : Retirement Only; No disability, death, surivorship benefits
# Benfit formula: % of FAS per YOS; FAS for last # years
# Retirment age : NO early retirement
# Vesting: : Vested if YOS > #
# Cost Method
# 1) EAN(Entry Age Normal)
# 2) PUC(Projected Unit Credit)
# Actuarial Assumptions
# Decrements: Mortality, termination, disability
# Salary scale
# Assumed interest rate
# Inflation
# Productivity
# Contribution rules:
# 1. Sponsor contributes full ADC, which equals the amount of plan cost(Normal cost + supplemental cost) in all periods.
# 2. Sponsor contributes ADC with a cap, which equals a percentage of total payroll.
# 3. Sponsor contributes a fixed percentage of payroll.
# Outputs
# Actuarial liability
# Normal costs
# Assets
# UAAL
# Funded Ratio
## List of tasks:
# How to deal with negative asset values and contributions
# How to set parameter g in constant percent amortization method. Now infl + prod
print(paramlist$runname)
#*********************************************************************************************************
# 0. Parameters (deprecated) ####
#*********************************************************************************************************
if(devMode) source("Dev_Params.R") else {
# Define Other parameters that depend on the fundamental parameters just imported.
paramlist$range_age <- with(Global_paramlist, min.age:max.age)
paramlist$range_ea <- c(Global_paramlist$min.age:(paramlist$r.max - 1))
paramlist$v <- with(paramlist, 1/(1 + i)) # discount factor, just for convenience
}
#*********************************************************************************************************
# 1.1 Importing Decrement tables and Calculating Probabilities ####
#*********************************************************************************************************
source("Model_Decrements.R")
# Output: Decrement (data.frame)
#*********************************************************************************************************
# 1.2 Import Salary table and initial retirement benefit table ####
#*********************************************************************************************************
## Inputs
# Data frames:
# - data frame for initial actives
# - data frame for initial retirees
# - data frame for salary scale
# Parameters:
# - planname: plan to be selected from the data frames above. From the RunControl file
# - paramList
# Notes:
# 1. User must provide the following data frames
# "salary": a complete salary table containing salary history of current actives and projected salary path for future workers,
# both of which are calculated based on a salary table of current actives from the AV and assumptions on salary growth.
# "benefit": a data frame containing average retirement benefit payment(including both service retirement and deferred retirement)
# of all valid ea and age combos.
# 2. Note that avgben is only used to calculate the current and projected values of benefits and liabilities of retirees at year 1. Future retirees'
# benefits and liabilities are calculated based on their salary history provided in "salary".
# 3. I don't think in "avgben" we need average benefit for all combos of ea and age. All we need is actually average benefits
# by age. Once we have that we can assign an arbitrary ea to it an throw it into the model. Note that the AV of NJ-TPAF only contains
# average benefits for retirees and vested terms by age group. Also note that if service retirees and vested terms follow the same mortality table
# and have the same COLA rule, I don't think we need to distinguish between them.
source("Model_Import_Plan.R")
#*********************************************************************************************************
# 1.3 Actual investment return. ####
#*********************************************************************************************************
source("Model_InvReturns.R")
#*********************************************************************************************************
# 2. Population ####
#*********************************************************************************************************
source("Model_Population.R")
gc()
#*********************************************************************************************************
# 3. Individual actuarial liabilities, normal costs and benenfits ####
#*********************************************************************************************************
source("Model_IndivLiab.R")
gc()
#*********************************************************************************************************
# 4. Aggregate actuarial liabilities, normal costs and benenfits ####
#*********************************************************************************************************
source("Model_AggLiab.R")
gc()
#*********************************************************************************************************
# 5. Simulation ####
#*********************************************************************************************************
source("Model_Sim.R")
#*********************************************************************************************************
# 6. Results ####
#*********************************************************************************************************
options(digits = 4, scipen = 6)
# select variables to be displayed in the kable function. See below for a list of all avaiable variables and explanations.
var.display <- c("year", "AL", "AA", "FR", "NC", "SC", "UAAL",
"AL.act_PR", "AL.ret_PR","AL.term_PR", "AL.Ben_PR",
"NC.act_PR", "NC.term_PR", "MA_PR",
#"AL_PR", "NC_PR", "SC_PR", "C_PR", "ERC_PR",
# "PR", "PR.growth",
# "ExF",
# "UAAL", "EUAAL", "LG", "NC", "SC",
#"ADC", "EEC", "ERC",
"C", "B", "B.v", "B.v_B", "B_PR"
# "I.r" , "I.e"
# "i", "i.r"
#, "dERC_PR"
# "AM", "PR",
# "C_ADC"
)
r1 <- penSim_results %>% mutate(B.v_B = B.v / B * 100) %>% filter(sim == 2, year %in% 1:105) %>% select(one_of(var.display))
kable(r1, digits = 3)
# Running time of major modules
Time_liab # liability
Time_wf # workforce
Time_prep_loop # Preparing for the loop
Time_loop # the big loop
(Time_liab + Time_wf + Time_prep_loop + Time_loop)[3]/60 # # of minutes
# AL: Total Actuarial liability, which includes liabilities for active workers and pensioners.
# NC: Normal Cost
# MA: Market value of assets.
# AA: Actuarial value of assets.
# EAA:Expected actuarial value of assets.(used with asset smoothing method in TPAF)
# UAAL: Unfunded accrued actuarial liability, defined as AL - NC
# EUAAL:Expected UAAL.
# PR: payroll
# LG: Loss/Gain, total loss(positive) or gain(negative), Caculated as LG(t+1) = (UAAL(t) + NC(t))(1+i) - C - Ic - UAAL(t+1),
# AM: Amount to be amortized at period t, it is the sum of loss/gain and shortfall in ADC payment.
# i is assumed interest rate. AMs of each period will be amortized seperately.
# SC: Supplement cost
# ADC: ADC
# C : Actual contribution
# C_ADC: shortfall in paying ADC (C - ADC). Note that negative number means shortall.
# B : Total benefit payment(currently all to retirees)
# Ic: Assumed interest from contribution, equal to i*C if C is made at the beginning of time period. i.r is real rate of return.
# Ia: Assumed interest from AA, equal to i*AA if the entire asset is investible.
# Ib: Assumed interest loss due to benefit payment, equal to i*B if the payment is made at the beginning of period
# I.r : Total ACTUAL interet gain, I = i.r*(AA + C - B), if AA is all investible, C and B are made at the beginning of period.
# Funded Ratio: AA / AL
# C_PR: contribution as % of payroll
#*********************************************************************************************************
# 6. Writing outputs ####
#*********************************************************************************************************
outputs_list <- list(paramlist = paramlist,
Global_paramlist = Global_paramlist,
decrement = decrement,
results = penSim_results,
ind_active = AggLiab$ind_active,
ind_retiree = AggLiab$ind_retiree,
ind_term = AggLiab$ind_term,
demo_summary= pop$demo_summary,
#liab = if(paramlist$save.liab) liab else "Not saved",
#demo = if(paramlist$save.demo) pop else "Not saved",
entrant_dist = entrants_dist)
# Save outputs to specified folder
if(!file.exists(folder_run)) dir.create(folder_run)
# filename_outputs <- paste0("Outputs_", paramlist$runname, "_" , format(Sys.Date(), "%m-%d-%Y"), ".RData")
filename_outputs <- paste0("Outputs_", paramlist$runname, ".RData")
save(outputs_list, file = paste0(folder_run,"/", filename_outputs))
gc()