Financial Mathematics 1 - Homework 2
Instructor: Dr. Le Nhat Tan
1 Group Members
- Nguyen Minh Quan - MAMAIU19036
- Tran Viet Hang - MAMAIU18079
- Le Nguyen Dang Khoa - MAMAIU19008
For further discussion, please contact us via email: quannguyenuw@gmail.com.
2 Slide Problems
2.1 Problem 1 (Slide 50)
A start-up forecasts that, with an initial investment of $1000, it will generate net cash flows of $1320 1 year from now, $1452 2 years from now. These net cash flows are not required to reinvest in the start-up. The mean annual growth rate of other similar investments is 10%. What are the net present value and the internal rate of return? Should an investor takes part in this start-up?
Solution. The cashflow of the start-up is given below.
The present value of the given start-up is \[\textrm{PV}=\frac{C_1}{1+r}+\frac{C_2}{(1+r)^2}=\frac{1,320}{1+10\%}+\frac{1,452}{(1+10\%)^2}=2400,\] implying a net present value of \[\textrm{NPV}=\textrm{PV}-C_0=2400-1000=1400.\] Let \(r_{\textrm{IRR}}\) be the internal rate of return of the start-up, then \[1000=C_0=\frac{C_1}{1+r_{\textrm{IRR}}}+\frac{C_2}{(1+r_{\textrm{IRR}})^2}=\frac{1320}{1+r_{\textrm{IRR}}}+\frac{1452}{(1+r_{\textrm{IRR}})^2}\] and solving the above equation yields \(\textrm{r}_{\textrm{IRR}}\approx103.39\%.\)
For both approaches, the start-up generates better income than the alternative investment and hence is favorable.
2.2 Problem 2 (Slide 55)
Consider two investment proposals A and B competing for funding. The expected cash flow streams produced by A and B are as follows:
| Year | A | B |
|---|---|---|
| 0 | -2000 | -2000 |
| 1 | 2000 | 400 |
| 2 | 625 | 2400 |
The mean annual growth rate of other similar investments is 5%. According to the net present value criterion, which proposal is better to invest?
Solution. The present values for two proposal are, respectively, \[\textrm{PV}_A=\frac{C_{1,A}}{1+r}+\frac{C_{2,A}}{(1+r)^2}=\frac{2000}{1+5\%}+\frac{625}{(1+5\%)^2}\approx2471.655\] and \[\textrm{PV}_B=\frac{C_{1,A}}{1+r}+\frac{C_{2,A}}{(1+r)^2}=\frac{400}{1+5\%}+\frac{2400}{(1+5\%)^2}\approx2557.823,\] implying the net present values as \[\textrm{NPV}_A=\textrm{PV}_A-C_{0,A}=2471.655-2000=471.655,\] \[\textrm{NPV}_B=\textrm{PV}_B-C_{0,B}=2557.823-2000=557.823.\] From the calculated results, proposal B is better for investing.
2.3 Problem 3 (Slide 57)
Consider two investment proposals A and B competing for funding. The expected cash flow streams produced by A and B are as follows:
| Year | A | B |
|---|---|---|
| 0 | -5000 | -50000 |
| 1 | 7500 | 62500 |
The mean annual growth rate of other similar investments is 15%. According to the net present value criterion, which proposal is better to invest?
Solution. The present values for two proposal are, respectively, \[\textrm{PV}_A=\frac{C_{1,A}}{1+r}=\frac{7500}{1+15\%}\approx6521.739\] and \[\textrm{PV}_B=\frac{C_{1,B}}{1+r}=\frac{62500}{1+15\%}\approx54347.826,\] implying the net present values as \[\textrm{NPV}_A=\textrm{PV}_A-C_{0,A}=6521.739-5000=1521.739,\] \[\textrm{NPV}_B=\textrm{PV}_B-C_{0,B}=54347.826-50000=4347.826.\] From the calculated results, proposal B is better for investing.
3 Cash Flow Evaluation in R
Problem. A girl anticipates her graduation from high school and start saving money to finance her studies. For each study year at a Belgian university, they will need 3500 EUR. Assume the interest rate are changing as 5%, 4%, 3%, 6%, 7%, 6%, 8%, 4%, 2% from year 1 to year 9. What is the savings amount K needed?
Solution. Calculations by R for this problem is given below.
# Evaluate Discount Factors
interest <- c(0.05, 0.04, 0.03, 0.06, 0.07, 0.06, 0.08, 0.04, 0.02)
annual_discount_factors <- (1 + interest) ^ ( - 1)
discount_factors <- c(1 , cumprod(annual_discount_factors))
discount_factors## [1] 1.0000000 0.9523810 0.9157509 0.8890786 0.8387534 0.7838816 0.7395110
## [8] 0.6847324 0.6583965 0.6454868# Find Present Value of Payment
payments <- c(rep(0, 5), rep(3500, 5))
PV_payment <- sum(discount_factors * payments)
PV_payment## [1] 12292.03# Calculate Savings
deposits <- c(0, rep(1, 4), rep(0, 5))
PV_deposit <- sum(discount_factors * deposits)
K <- PV_payment/PV_deposit
K## [1] 3418.285Hence the annual saving needed is $ 3418.2850387.
4 Human Mortality Database
4.1 The Dataset
country_code = c('AUS', 'AUT', 'BEL', 'BGR', 'BLR', 'CAN', 'CHE', 'CHL',
'CZE', 'DEU', 'DNK', 'ESP', 'EST', 'FIN', 'FRA', 'GBR',
'GRC', 'HKG', 'HRV', 'HUN', 'IRL', 'ISL', 'ISR', 'ITA',
'JPN', 'KOR', 'LTU', 'LUX', 'LVA', 'NLD', 'NOR', 'NZL',
'POL', 'PRT', 'RUS', 'SVK', 'SVN', 'SWE', 'TWN', 'UKR',
'USA')
# Scrape Female Data
life_table = NULL
for (i in 1:length(country_code)) {
link = paste('https://raw.githubusercontent.com/QuanNguyenIU/Human-Mortality/main/',
country_code[i], '_LT_F.txt', sep = '')
df = read.table(link, header = TRUE) %>% select (year = Year, age = Age, qx, lx, dx)
df[df == '110+'] = '110'
df$gender = 'F'
df$country = country_code[i]
if (i == 1) {
life_table = df
} else {
life_table = rbind(life_table, df)
}
}
# Scrape Male Data
for (i in 1:length(country_code)) {
link = paste('https://raw.githubusercontent.com/QuanNguyenIU/Human-Mortality/main/',
country_code[i], '_LT_M.txt', sep = '')
df = read.table(link, header = TRUE) %>% select (year = Year, age = Age, qx, lx, dx)
df[df == '110+'] = '110'
df$gender = 'M'
df$country = country_code[i]
life_table = rbind(life_table, df)
}
# Preprocessing
life_table = transform(life_table, age = as.numeric(age), qx = as.numeric(qx),
lx = as.numeric(lx), dx = as.numeric(dx)) %>% drop_na()
life_table$px = 1 - life_table$qx
# Exporting to .csv
write.csv(life_table,"hmd_life_table.csv", row.names = FALSE)# Overview
glimpse(life_table)## Rows: 820,290
## Columns: 8
## $ year <int> 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 19…
## $ age <dbl> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, …
## $ qx <dbl> 0.05750, 0.01199, 0.00576, 0.00288, 0.00325, 0.00251, 0.00248,…
## $ lx <dbl> 100000, 94250, 93120, 92583, 92316, 92016, 91785, 91557, 91391…
## $ dx <dbl> 5750, 1130, 537, 267, 300, 231, 228, 166, 126, 125, 114, 105, …
## $ gender <chr> "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F…
## $ country <chr> "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS",…
## $ px <dbl> 0.94250, 0.98801, 0.99424, 0.99712, 0.99675, 0.99749, 0.99752,…4.2 Finland, The Happiest Country
FIN_1999 = life_table %>% filter(country == 'FIN', year == '1999')
ggplot(FIN_1999, aes(x = age, y = qx, color = gender)) + geom_line() +
labs(x = "Age", y = "Mortality Rate", title = "Mortality Rates, Finland 1999")
ggplot(FIN_1999, aes(x = age, y = log(qx), color = gender)) + geom_line() +
labs(x = "Age", y = "Mortality Rate",
title = "Log Mortality Rates, Finland 1999")
kpx = cumprod((FIN_1999 %>% filter(age %in% (18:100), gender == 'F'))$px)
FIN_1999_sp = data.frame(x = 1:length(kpx), kpx, le = rev(cumsum(rev(kpx))),
gender = 'F')
kpx = cumprod((FIN_1999 %>% filter(age %in% (18:100), gender == 'M'))$px)
FIN_1999_sp = rbind(FIN_1999_sp, data.frame(x = 1:length(kpx), kpx,
le = rev(cumsum(rev(kpx))),
gender = 'M'))
ggplot(FIN_1999_sp, aes(x, y = kpx, color = gender)) + geom_line() +
labs(x = "Minimum Survival Years", y = "Probability",
title = "Survival Rates for 18-Year-Old People, Finland 1999")
ggplot(FIN_1999_sp, aes(x, y = le, color = gender)) + geom_line() +
labs(x = "Age", y = "Future Lifetime",
title = "Future Lifetime by Age, Finland 1999")
FIN = life_table %>% filter(country == 'FIN')
ggplot(FIN, aes(x = age, y = qx, color = year)) + geom_line(aes(group = year)) +
facet_wrap(~gender) + labs(x ="Age", y = "Mortality Rates",
title = "Historical Mortality Rates, Finland")
FIN_le = FIN %>% group_by(gender, year) %>%
mutate(kpx = cumprod(px), le = sum(kpx)) %>% filter(age==0) %>%
select(country, year, gender, le)
ggplot(FIN_le, aes(x = year, y = le, color = gender)) + geom_line() +
labs(x = "Year", y = "Life Expectancy",
title = "Historical Life Expectancy, Finland")
4.3 Global Observation
all_le = life_table %>% group_by(year, country, gender) %>%
mutate(kpx = cumprod(px), le = sum(kpx)) %>%
filter(age == 0,year >= min(FIN_le$year)) %>% ungroup() %>%
group_by(year,gender) %>% summarize(le = mean(le)) %>%
mutate(country = "all")
ggplot(rbind(FIN_le, all_le),
aes(x = year, y = le, color = gender, linetype = country)) +
geom_line() + labs(x = "Year", y = "Life Expectancy",
title = "Historical Life Expectancy, Finland versus Global")
all_le = life_table %>% group_by(year, country, gender) %>%
mutate(kpx = cumprod(px), le = sum(kpx)) %>% filter(age==0) %>% ungroup()
ggplot(all_le, aes(x = year, y = le, color = country)) +
geom_point(size = 0.5) + facet_wrap(~gender) +
labs(x = "Year", y = "Life Expectancy",
title = "Historical Life Expectancy By Countries")
empty = element_blank()
ggplot(all_le %>% filter(year %in% (1900:1960)),
aes(x = year, y = le, color = gender)) + geom_line() +
facet_wrap(~country) + theme(axis.ticks.x = empty, axis.text.x = empty,
axis.ticks.y = empty, axis.text.y = empty) +
labs(x = "Year", y = "Life Expectancy",
title = "Historical Life Expectancy By Countries, 1900 - 1960")
countries = c('AUS', 'BEL', 'CAN', 'CHE', 'DNK',
'ESP', 'FIN', 'FRA', 'GBR', 'ISL',
'ITA', 'NLD', 'NOR', 'SWE', 'USA')
ggplot(all_le %>% filter(year %in% (1900:1960), country %in% countries),
aes(x = year, y = le, color = gender)) + geom_line() +
facet_wrap(~country) + theme(axis.ticks.x = empty, axis.text.x = empty) +
labs(x = "Year", y = "Life Expectancy",
title = "Historical Life Expectancy By Selected Countries, 1900 - 1960")