R Notebook
Le Anh
15/06/2024
- Explain result of CAPM
- Explain result of Fama_French
- Note: The histogram of the residuals in the CAPM model resembles a bell shape but is not perfectly symmetrical.
- Note: The histogram of the residuals in the Fama_French model resembles a bell shape but is quite symmetrical.
- Analysis for data 2
- Explain result of CAPM
- Explain result of CAPM
- Save residuals
- Note:The histogram of the residuals in the CAPM model resembles a bell shape but is not perfectly symmetrical
This is an R Markdown Notebook. When you execute codewithin the notebook, the results appear beneath the code.
Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.
library("MASS")sapply(data1, sd)## Warning in var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm =
## na.rm): NAs introduced by coercion## date ge mktrf smb hml rf
## NA 68.3810988 4.4950628 3.0485605 2.9798015 0.2126436
## sp500
## 780.4721140Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.
When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).
The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.
library(ggplot2)
library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericlibrary(scales)
library(lubridate)##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(stargazer)##
## Please cite as:## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.## R package version 5.2.3. https://CRAN.R-project.org/package=stargazerlibrary(forecast)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(tseries)
library(gridExtra)
library(fpp2)## ── Attaching packages ────────────────────────────────────────────── fpp2 2.5 ──## ✔ fma 2.5 ✔ expsmooth 2.3## library(zoo)Transform data
df1$Date <- as.Date(paste(df1$date, 1), "%Ym%m %d")Check type of data
str(df1)## 'data.frame': 431 obs. of 8 variables:
## $ date : chr "1985m1" "1985m2" "1985m3" "1985m4" ...
## $ ge : num 7.61 7.58 7.1 7.1 7.28 ...
## $ mktrf: num 7.99 1.22 -0.84 -0.96 5.09 1.27 -0.74 -1.02 -4.54 4.02 ...
## $ smb : num 3.27 0.76 -1.15 0.14 -2.25 0.5 2.85 -0.34 -1.58 -1.57 ...
## $ hml : num -5.43 -0.12 4.1 3.73 -0.86 0.46 -1.63 2.28 1.32 0.78 ...
## $ rf : num 0.65 0.58 0.62 0.72 0.66 0.55 0.62 0.55 0.6 0.65 ...
## $ sp500: num 180 181 181 180 190 ...
## $ Date : Date, format: "1985-01-01" "1985-02-01" ...- Plot for price
ggplot(data = df1) +
geom_line(aes(x = Date, y = ge),
color = "blue",
size = 0.6) +
labs(x = "Date",
y = "ge Price") +
scale_x_date(date_breaks = "6 years", labels = date_format("%Y %b")) +
theme_minimal()+
theme_bw()+
theme(panel.grid =element_blank())+
theme(axis.title.x = element_text(size =12))+
theme(axis.title.y = element_text(size =12))+
theme(axis.text.x = element_text(size =12))+
theme(axis.text.y = element_text(size =12))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Note: It can be seen that during this period, the highest prices were around 1999-2000, followed by 2017-2018, and then 2007-2008. The lowest prices were in the years before 1989, and after increasing, they hit the bottom again in 2009, 2019, and 2022. It can be observed that the price change cycle is approximately every 10 years.
2.Calculate return for data1
df1$Return <- NA
for(i in c(2:nrow(df1))){
df1$Return[i] <- (df1$ge[i]-df1$ge[i-1])/df1$ge[i-1]*100
}Plot Returns
ggplot(data = df1) +
geom_line(aes(x = Date, y = Return),
color = "green",
size = 0.6) +
labs(x = "Date",
y = "ge Return") +
scale_x_date(date_breaks = "6 years", labels = date_format("%Y %b")) +
theme_minimal()+
theme_bw()+
theme(panel.grid =element_blank())+
theme(axis.title.x = element_text(size =12))+
theme(axis.title.y = element_text(size =12))+
theme(axis.text.x = element_text(size =12))+
theme(axis.text.y = element_text(size =12))## Warning: Removed 1 row containing missing values (`geom_line()`).
#Note: From the chart, it can be seen that Return fluctuated continuously throughout the analysis period, reaching their highest in 2022 and their lowest in 2009.
Calculate histogram of returns
Ge_Return <- df1$Return
h <- hist(Ge_Return)
#h
#h$breaks
# h$counts
h$density## [1] 0.0013953488 0.0018604651 0.0013953488 0.0102325581 0.0200000000
## [6] 0.0581395349 0.0576744186 0.0279069767 0.0144186047 0.0051162791
## [11] 0.0004651163 0.0004651163 0.0004651163 0.0004651163# h$midsNote: It can be seen that most of the Ge_return are concentrated between -5 and 5. The histogram also shows that the data on Ge_return during this period is not perfectly symmetrical.
summary(df1)## date ge mktrf smb
## Length:431 Min. : 6.971 Min. :-23.2400 Min. :-16.72000
## Class :character 1st Qu.: 30.417 1st Qu.: -1.8950 1st Qu.: -1.83500
## Mode :character Median :103.645 Median : 1.1900 Median : 0.08000
## Mean :102.180 Mean : 0.7508 Mean : 0.04074
## 3rd Qu.:164.220 3rd Qu.: 3.5450 3rd Qu.: 1.66000
## Max. :250.581 Max. : 13.6500 Max. : 21.13000
##
## hml rf sp500 Date
## Min. :-14.11000 Min. :0.0000 Min. : 179.6 Min. :1985-01-01
## 1st Qu.: -1.59500 1st Qu.:0.0400 1st Qu.: 457.4 1st Qu.:1993-12-16
## Median : -0.02000 Median :0.2500 Median :1126.2 Median :2002-12-01
## Mean : 0.08253 Mean :0.2645 Mean :1178.6 Mean :2002-11-30
## 3rd Qu.: 1.67000 3rd Qu.:0.4300 3rd Qu.:1453.5 3rd Qu.:2011-11-16
## Max. : 12.60000 Max. :0.7900 Max. :3621.6 Max. :2020-11-01
##
## Return
## Min. :-29.8434
## 1st Qu.: -3.4984
## Median : 0.3929
## Mean : 0.8642
## 3rd Qu.: 4.8240
## Max. : 37.1968
## NA's :1df1$excess_Return <- df1$Return - df1$rfModel_1 <- lm(excess_Return ~
mktrf
, data=df1
, na.action=na.exclude)
coeftest(Model_1)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.251561 0.289111 -0.8701 0.3847
## mktrf 1.161114 0.063665 18.2380 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1stargazer(Model_1, type="text")##
## ===============================================
## Dependent variable:
## ---------------------------
## excess_Return
## -----------------------------------------------
## mktrf 1.161***
## (0.064)
##
## Constant -0.252
## (0.289)
##
## -----------------------------------------------
## Observations 430
## R2 0.437
## Adjusted R2 0.436
## Residual Std. Error 5.916 (df = 428)
## F Statistic 332.623*** (df = 1; 428)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Explain result of CAPM
- The test results in the CAPM model show that the intercept coefficient is not statistically significant, but the slope coefficient is statistically significant at the 1% level.
- According to the CAPM model, the parameter associated to the excess market in the financial market is the stock’s beta. This parameter gives a measure of the riskiness of the stock, and it must be compared against 1. If the resulting parameter is higher than 1, then the stock is said to be aggressive, that is riskier than the market portfolio. If lower than 1 then the stock is said to be passive as it is less risky than the market portfolio. If the parameter is equal to one then the stock is said to be neutral, which means as risky as the market portfolio. => In my model, the slope is 1.161 that is higher 1 stock is said to be aggressive, that is riskier than the market portfolio. -The statistic suggests that, once we take into account the number of parameters in the model, the latter is able to explain 43.7% of the total variation in y, that is ge’s returns.
Regress the basic model (no robust se)
Model_2 <- lm(excess_Return ~
mktrf + smb + hml
, data=df1
, na.action=na.exclude)
coeftest(Model_2)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.337544 0.281688 -1.1983 0.231470
## mktrf 1.240365 0.064101 19.3503 < 2.2e-16 ***
## smb -0.243056 0.095551 -2.5437 0.011320 *
## hml 0.376445 0.096648 3.8950 0.000114 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1stargazer(Model_2, type="text")##
## ===============================================
## Dependent variable:
## ---------------------------
## excess_Return
## -----------------------------------------------
## mktrf 1.240***
## (0.064)
##
## smb -0.243**
## (0.096)
##
## hml 0.376***
## (0.097)
##
## Constant -0.338
## (0.282)
##
## -----------------------------------------------
## Observations 430
## R2 0.470
## Adjusted R2 0.467
## Residual Std. Error 5.754 (df = 426)
## F Statistic 126.082*** (df = 3; 426)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Explain result of Fama_French
- The test results in the Fama_French model show that the intercept coefficient is not statistically significant, but the slope coefficient is statistically significant at the 1% level. -In my model, the slope is 1.24 that is higher 1 stock is said to be aggressive, that is riskier than the market portfolio -The statistic suggests that, once we take into account the number of parameters in the model, the latter is able to explain 47% of the total variation in y, that is ge’s returns.
##### Save residuals #####
df1$e_1 <- residuals(Model_1)
df1$e_2 <- residuals(Model_2)
###############################resid1 <- df1$e_1
h1 <- hist(resid1)
h1## $breaks
## [1] -30 -25 -20 -15 -10 -5 0 5 10 15 20 25
##
## $counts
## [1] 2 0 5 6 42 163 140 56 12 0 4
##
## $density
## [1] 0.0009302326 0.0000000000 0.0023255814 0.0027906977 0.0195348837
## [6] 0.0758139535 0.0651162791 0.0260465116 0.0055813953 0.0000000000
## [11] 0.0018604651
##
## $mids
## [1] -27.5 -22.5 -17.5 -12.5 -7.5 -2.5 2.5 7.5 12.5 17.5 22.5
##
## $xname
## [1] "resid1"
##
## $equidist
## [1] TRUE
##
## attr(,"class")
## [1] "histogram"Note: The histogram of the residuals in the CAPM model resembles a bell shape but is not perfectly symmetrical.
resid2 <- df1$e_2
h2 <- hist(resid2)
h2## $breaks
## [1] -30 -25 -20 -15 -10 -5 0 5 10 15 20 25 30
##
## $counts
## [1] 2 0 4 6 42 169 145 46 12 0 3 1
##
## $density
## [1] 0.0009302326 0.0000000000 0.0018604651 0.0027906977 0.0195348837
## [6] 0.0786046512 0.0674418605 0.0213953488 0.0055813953 0.0000000000
## [11] 0.0013953488 0.0004651163
##
## $mids
## [1] -27.5 -22.5 -17.5 -12.5 -7.5 -2.5 2.5 7.5 12.5 17.5 22.5 27.5
##
## $xname
## [1] "resid2"
##
## $equidist
## [1] TRUE
##
## attr(,"class")
## [1] "histogram"Note: The histogram of the residuals in the Fama_French model resembles a bell shape but is quite symmetrical.
Analysis for data 2
library(readxl)
ipdRXLFVTxSXUVyxVd8UBQ_183ed5da0b6d4c0b839bb3d273596ee1_Disney_Data <- read_excel("C:/Users/Admin/OneDrive - National Economics University/NCKH2024/Coursera/ipdRXLFVTxSXUVyxVd8UBQ_183ed5da0b6d4c0b839bb3d273596ee1_Disney-Data.xlsx")
data2=ipdRXLFVTxSXUVyxVd8UBQ_183ed5da0b6d4c0b839bb3d273596ee1_Disney_Data
names(data2)## [1] "date" "disney" "mktrf" "smb" "hml" "rf" "sp500"summary(data2)## date disney mktrf smb
## Length:431 Min. : 1.081 Min. :-23.2400 Min. :-16.72000
## Class :character 1st Qu.: 10.513 1st Qu.: -1.8950 1st Qu.: -1.83500
## Mode :character Median : 21.242 Median : 1.1900 Median : 0.08000
## Mean : 35.200 Mean : 0.7508 Mean : 0.04074
## 3rd Qu.: 37.769 3rd Qu.: 3.5450 3rd Qu.: 1.66000
## Max. :150.677 Max. : 13.6500 Max. : 21.13000
## hml rf sp500
## Min. :-14.11000 Min. :0.0000 Min. : 179.6
## 1st Qu.: -1.59500 1st Qu.:0.0400 1st Qu.: 457.4
## Median : -0.02000 Median :0.2500 Median :1126.2
## Mean : 0.08253 Mean :0.2645 Mean :1178.6
## 3rd Qu.: 1.67000 3rd Qu.:0.4300 3rd Qu.:1453.5
## Max. : 12.60000 Max. :0.7900 Max. :3621.6df2 <- as.data.frame(data2)
summary(df2)## date disney mktrf smb
## Length:431 Min. : 1.081 Min. :-23.2400 Min. :-16.72000
## Class :character 1st Qu.: 10.513 1st Qu.: -1.8950 1st Qu.: -1.83500
## Mode :character Median : 21.242 Median : 1.1900 Median : 0.08000
## Mean : 35.200 Mean : 0.7508 Mean : 0.04074
## 3rd Qu.: 37.769 3rd Qu.: 3.5450 3rd Qu.: 1.66000
## Max. :150.677 Max. : 13.6500 Max. : 21.13000
## hml rf sp500
## Min. :-14.11000 Min. :0.0000 Min. : 179.6
## 1st Qu.: -1.59500 1st Qu.:0.0400 1st Qu.: 457.4
## Median : -0.02000 Median :0.2500 Median :1126.2
## Mean : 0.08253 Mean :0.2645 Mean :1178.6
## 3rd Qu.: 1.67000 3rd Qu.:0.4300 3rd Qu.:1453.5
## Max. : 12.60000 Max. :0.7900 Max. :3621.6df2$Date <- as.Date(paste(df2$date, 1), "%Ym%m %d")## Plot price for data 2##
ggplot(data = df2) +
geom_line(aes(x = Date, y = disney),
color = "red",
size = 0.6) +
labs(x = "Date",
y = "disney Price") +
scale_x_date(date_breaks = "6 years", labels = date_format("%Y %b")) +
theme_minimal()+
theme_bw()+
theme(panel.grid =element_blank())+
theme(axis.title.x = element_text(size =12))+
theme(axis.title.y = element_text(size =12))+
theme(axis.text.x = element_text(size =12))+
theme(axis.text.y = element_text(size =12))
## Note:## From the chart, it can be seen that Disney’s price increases
over time. Although there are occasional decreases, the overall trend is
still upward.
df2$Return <- NA
for(i in c(2:nrow(df2))){
df2$Return[i] <- (df2$disney[i]-df2$disney[i-1])/df2$disney[i-1]*100
}Plot Returns of disney in data2
ggplot(data = df2) +
geom_line(aes(x = Date, y = Return),
color = "blue",
size = 0.6) +
labs(x = "Date",
y = "ge Return") +
scale_x_date(date_breaks = "6 years", labels = date_format("%Y %b")) +
theme_minimal()+
theme_bw()+
theme(panel.grid =element_blank())+
theme(axis.title.x = element_text(size =12))+
theme(axis.title.y = element_text(size =12))+
theme(axis.text.x = element_text(size =12))+
theme(axis.text.y = element_text(size =12))## Warning: Removed 1 row containing missing values (`geom_line()`).
##Note:## It can be seen that Disney’s return always fluctuates over time, but the average of these fluctuations is zero. The highest return was in 1987, and the lowest was in 1988.
##Calculus histogram of returmn for data2##
disney_Return <- df2$Return
h <- hist(disney_Return)
#h
#h$breaks
# h$counts
h$density## [1] 0.0009302326 0.0004651163 0.0027906977 0.0074418605 0.0227906977
## [6] 0.0479069767 0.0586046512 0.0344186047 0.0167441860 0.0051162791
## [11] 0.0023255814 0.0000000000 0.0004651163# h$mids##Note:## From the histogram of Disney’s return, it can be seen that it has an approximately normal distribution.
summary(df2)## date disney mktrf smb
## Length:431 Min. : 1.081 Min. :-23.2400 Min. :-16.72000
## Class :character 1st Qu.: 10.513 1st Qu.: -1.8950 1st Qu.: -1.83500
## Mode :character Median : 21.242 Median : 1.1900 Median : 0.08000
## Mean : 35.200 Mean : 0.7508 Mean : 0.04074
## 3rd Qu.: 37.769 3rd Qu.: 3.5450 3rd Qu.: 1.66000
## Max. :150.677 Max. : 13.6500 Max. : 21.13000
##
## hml rf sp500 Date
## Min. :-14.11000 Min. :0.0000 Min. : 179.6 Min. :1985-01-01
## 1st Qu.: -1.59500 1st Qu.:0.0400 1st Qu.: 457.4 1st Qu.:1993-12-16
## Median : -0.02000 Median :0.2500 Median :1126.2 Median :2002-12-01
## Mean : 0.08253 Mean :0.2645 Mean :1178.6 Mean :2002-11-30
## 3rd Qu.: 1.67000 3rd Qu.:0.4300 3rd Qu.:1453.5 3rd Qu.:2011-11-16
## Max. : 12.60000 Max. :0.7900 Max. :3621.6 Max. :2020-11-01
##
## Return
## Min. :-28.636
## 1st Qu.: -2.895
## Median : 1.276
## Mean : 1.444
## 3rd Qu.: 5.743
## Max. : 31.257
## NA's :1df2$excess_Return <- df2$Return - df1$rfModel_1 <- lm(excess_Return ~
mktrf
, data=df2
, na.action=na.exclude)
coeftest(Model_1)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.341055 0.278809 1.2233 0.2219
## mktrf 1.143219 0.061396 18.6204 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1stargazer(Model_1, type="text")##
## ===============================================
## Dependent variable:
## ---------------------------
## excess_Return
## -----------------------------------------------
## mktrf 1.143***
## (0.061)
##
## Constant 0.341
## (0.279)
##
## -----------------------------------------------
## Observations 430
## R2 0.448
## Adjusted R2 0.446
## Residual Std. Error 5.705 (df = 428)
## F Statistic 346.721*** (df = 1; 428)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Explain result of CAPM
- The test results in the CAPM model show that the intercept coefficient is not statistically significant, but the slope coefficient is statistically significant at the 1% level.
- In my model, the slope is 1.143 that is higher 1 stock is said to be aggressive, that is riskier than the market portfolio. -The statistic suggests that, once we take into account the number of parameters in the model, the latter is able to explain 44.8% of the total variation in y, that is ge’s returns.
Regress the basic model (no robust se)
Model_2 <- lm(excess_Return ~
mktrf + smb + hml
, data=df2
, na.action=na.exclude)
coeftest(Model_2)##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.302480 0.278301 1.0869 0.27770
## mktrf 1.174800 0.063330 18.5505 < 2e-16 ***
## smb -0.071756 0.094402 -0.7601 0.44761
## hml 0.186475 0.095486 1.9529 0.05148 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1stargazer(Model_2, type="text")##
## ===============================================
## Dependent variable:
## ---------------------------
## excess_Return
## -----------------------------------------------
## mktrf 1.175***
## (0.063)
##
## smb -0.072
## (0.094)
##
## hml 0.186*
## (0.095)
##
## Constant 0.302
## (0.278)
##
## -----------------------------------------------
## Observations 430
## R2 0.454
## Adjusted R2 0.450
## Residual Std. Error 5.684 (df = 426)
## F Statistic 118.154*** (df = 3; 426)
## ===============================================
## Note: *p<0.1; **p<0.05; ***p<0.01Explain result of CAPM
- The test results in the Fama -Fremch model show that the intercept coefficient is not statistically significant, but the slope coefficient is statistically significant at the 1% level.
- In my model, the slope is 1.175 that is higher 1 stock is said to be aggressive, that is riskier than the market portfolio. -The statistic suggests that, once we take into account the number of parameters in the model, the latter is able to explain 45.4% of the total variation in y, that is ge’s returns.
Save residuals
df2$e_1 <- residuals(Model_1)
df2$e_2 <- residuals(Model_2)resid1 <- df2$e_1
h1 <- hist(resid1)
h1## $breaks
## [1] -20 -15 -10 -5 0 5 10 15 20 25 30
##
## $counts
## [1] 4 7 55 161 144 35 18 4 1 1
##
## $density
## [1] 0.0018604651 0.0032558140 0.0255813953 0.0748837209 0.0669767442
## [6] 0.0162790698 0.0083720930 0.0018604651 0.0004651163 0.0004651163
##
## $mids
## [1] -17.5 -12.5 -7.5 -2.5 2.5 7.5 12.5 17.5 22.5 27.5
##
## $xname
## [1] "resid1"
##
## $equidist
## [1] TRUE
##
## attr(,"class")
## [1] "histogram"Note:The histogram of the residuals in the CAPM model resembles a bell shape but is not perfectly symmetrical
resid2 <- df2$e_2
h2 <- hist(resid2)
h2## $breaks
## [1] -20 -15 -10 -5 0 5 10 15 20 25 30
##
## $counts
## [1] 3 9 53 162 141 40 17 3 1 1
##
## $density
## [1] 0.0013953488 0.0041860465 0.0246511628 0.0753488372 0.0655813953
## [6] 0.0186046512 0.0079069767 0.0013953488 0.0004651163 0.0004651163
##
## $mids
## [1] -17.5 -12.5 -7.5 -2.5 2.5 7.5 12.5 17.5 22.5 27.5
##
## $xname
## [1] "resid2"
##
## $equidist
## [1] TRUE
##
## attr(,"class")
## [1] "histogram"##Note From the histogram of the residuals in the Fama-French regression model of Disney’s return, it can be seen that they have an approximately normal distribution##
##Conclusion: Overall, from the regression results of the four models, it can be seen that all the slope coefficients are greater than 1, indicating that the stock is aggressive##