HW3. Portfolio Theory
library(readxl)
library(sandwich)
library(ggplot2)
library(tidyr)
library(gt)
library(gtsummary)
library(viridis)## Загрузка требуемого пакета: viridisLitelibrary(caret)## Загрузка требуемого пакета: latticelibrary(lmtest)## Загрузка требуемого пакета: zoo##
## Присоединяю пакет: 'zoo'## Следующие объекты скрыты от 'package:base':
##
## as.Date, as.Date.numericdata <- read_excel("Dataset_HA-3.xlsx")
dim(data)## [1] 1549 236#разделение выборки на тестовую и обучающую
learning_data <- as.data.frame(data[-c(1547,1548,1549),])
testing_data <- as.data.frame(data[c(1547,1548,1549),])CAPM
Была построена модель CAPM с использованием одного фактора: MRP на выборке 230 компаний.
i <- NULL
K <- matrix(0, nrow = 230, ncol = 2)
Stars <- matrix(0, nrow = 230, ncol = 2)
R2 <- NULL
q <- qt(0.975, 1547) #степени свободы - n-k: 1549-2=1547 (двусторонний тест)
for(i in 1:230) {
CAPM_train <- lm(data = learning_data, learning_data[,i+6]~mrp)
vcovHAC(CAPM_train)[1,1]
S <- summary(CAPM_train)
K[i,] <- S$coefficients[,1]
Stars[i,1] <- abs(S$coefficients[1,1]/sqrt(vcovHAC(CAPM_train)[1,1])) > q #таблица значимости на 5% константы
Stars[i,2] <- abs(S$coefficients[2,1]/sqrt(vcovHAC(CAPM_train)[2,2])) > q #таблица значимости на 5% коэффициента
R2[i] <- S$r.squared #коэффициент детерминации по CAPM по 230 компаниям
}Были построены графики, по которым видно, что у 24 компаний выборки константа не значима, у 2 компаний коэффициент перед MRP не значим.
#визуализация
#количество компаний с незначимыми коэффициентами
Stars1 <- as.data.frame(Stars)
colnames(Stars1) <- c("Intercept", "Coefficient")
Stars2 <- Stars1 %>% pivot_longer(cols = "Intercept":"Coefficient", names_to = "Variable", values_to = "Significance")
Stars3 <- as.data.frame(table(Stars2$Variable, Stars2$Significance))
#0 - не значимая, 1 - значимая
ggplot(data = Stars3, aes(x = Var1, Freq, fill = Var2)) + geom_col(position = "dodge") + scale_fill_manual(values = c("darkblue", "slateblue")) + theme_classic() + xlab("") + ylab("Количество") + geom_text(aes(label = Freq), position = position_dodge(width = 1), vjust = -0.5)
По построенным “Ящикам с усами” видно, что медианное значение скорректированного коэффициента детерминации составляет около 11%. Это показывает, что посредством построения CAPM мы смогли объяснить в среднем 14% вариации зависимой переменной.
#распределение различных параметров:
results <- data.frame(K, R2)
colnames(results) <- c("Intercept", "Coefficient", "R2")
as.data.frame(results) %>% tbl_summary()| Characteristic | N = 2301 |
|---|---|
| Intercept | 0.0001 (-0.0001, 0.0004) |
| Coefficient | 0.71 (0.52, 0.96) |
| R2 | 0.12 (0.08, 0.18) |
| 1 Median (IQR) | |
results1 <- results %>% pivot_longer(cols = "Intercept":"R2", names_to = "Variable", values_to = "Value")
ggplot(data = results1, aes(x = Variable, y = Value, fill = Variable)) + geom_boxplot() + facet_wrap(~Variable, scale = "free") + theme_classic() + scale_fill_viridis_d() + theme(legend.position = "bottom")
Описательные статистики по модели CAPM:
#описательные статистики
summary(results)## Intercept Coefficient R2
## Min. :-2.224e-02 Min. :0.0000829 Min. :0.00000
## 1st Qu.:-1.370e-04 1st Qu.:0.5218407 1st Qu.:0.07607
## Median : 1.312e-04 Median :0.7125709 Median :0.11981
## Mean : 8.323e-05 Mean :0.7585275 Mean :0.14018
## 3rd Qu.: 4.269e-04 3rd Qu.:0.9580719 3rd Qu.:0.18265
## Max. : 2.586e-03 Max. :1.6156851 Max. :0.42711Fama-French regression
Для того, чтобы построить регрессию Фама-Френч, нужно добавить ещё два фактора: SMB и HML. Проведем те же самые вычисления, которые проводили для построения модели CAPM.
i <- NULL
K_FF <- matrix(0, nrow = 230, ncol = 4)
Stars_FF <- matrix(0, nrow = 230, ncol = 4)
R2_FF <- NULL
for(i in 1:230) {
CAPM_train <- lm(data = learning_data, learning_data[,i+6]~mrp+smb+hml)
Summary_FF <- summary(CAPM_train)
K_FF[i,] <- Summary_FF$coefficients[,1]
Stars_FF[i,1] <- abs(Summary_FF$coefficients[1,1]/sqrt(vcovHAC(CAPM_train)[1,1])) > q #таблица значимости на 5% константы
Stars_FF[i,2] <- abs(Summary_FF$coefficients[2,1]/sqrt(vcovHAC(CAPM_train)[2,2])) > q #таблица значимости на 5% mrp
Stars_FF[i,3] <- abs(Summary_FF$coefficients[3,1]/sqrt(vcovHAC(CAPM_train)[3,3])) > q #таблица значимости на 5% smb
Stars_FF[i,4] <- abs(Summary_FF$coefficients[4,1]/sqrt(vcovHAC(CAPM_train)[4,4])) > q #таблица значимости на 5% hml
R2_FF[i] <- Summary_FF$r.squared #коэффициент детерминации по CAPM по 230 компаниям
}Построим графики, отображающие количество компаний, у которых те или иные коэффициенты регрессии Фама-Френч являются незначимыми. Так, у большого количества компаний коэффициент перед MRP является значимым (у 228 компаний значим на уровне значимости 5%). У 153 компаний SMB является значимым, у 146 компаний - значим HML, у 124 компаний - значима константа.
#визуализация
#количество компаний с незначимыми коэффициентами
Stars_FF1 <- as.data.frame(Stars_FF)
colnames(Stars_FF1) <- c("Intercept", "MRP", "SMB", "HML")
Stars_FF2 <- Stars_FF1 %>% pivot_longer(cols = "Intercept":"HML", names_to = "Variable", values_to = "Significance")
Stars_FF3 <- as.data.frame(table(Stars_FF2$Variable, Stars_FF2$Significance))
#0 - не значимая, 1 - значимая
ggplot(data = Stars_FF3, aes(x = Var1, Freq, fill = Var2)) + geom_col(position = "dodge") + scale_fill_manual(values = c("darkblue", "slateblue")) + theme_classic() + xlab("") + ylab("Количество") + geom_text(aes(label = Freq), position = position_dodge(width = 1), vjust = -0.5)
Среднее значение коэффициента детерминации по модели Фама-Френч выше, чем было по модели CAPM (16%), но улучшение произошло на 2 процентных пункта.
#распределение различных параметров:
results_FF <- data.frame(K_FF, R2_FF)
colnames(results_FF) <- c("Intercept", "MRP", "SMB", "HML", "R2")
as.data.frame(results_FF) %>% tbl_summary()| Characteristic | N = 2301 |
|---|---|
| Intercept | -0.0002 (-0.0017, 0.0009) |
| MRP | 0.66 (0.53, 0.90) |
| SMB | 0.05 (-0.11, 0.35) |
| HML | -0.06 (-0.17, 0.13) |
| R2 | 0.16 (0.10, 0.22) |
| 1 Median (IQR) | |
results_FF1 <- results_FF %>% pivot_longer(cols = "Intercept":"R2", names_to = "Variable", values_to = "Value")
ggplot(data = results_FF1, aes(x = Variable, y = Value, fill = Variable)) + geom_boxplot() + facet_wrap(~Variable, scale = "free") + theme_classic() + scale_fill_viridis_d() + theme(legend.position = "bottom")
Описательные статистики по модели Fama-French:
#описательные статистики
summary(results_FF)## Intercept MRP SMB HML
## Min. :-0.0164405 Min. :-0.002236 Min. :-1.00333 Min. :-1.00186
## 1st Qu.:-0.0016836 1st Qu.: 0.533592 1st Qu.:-0.11329 1st Qu.:-0.16854
## Median :-0.0001652 Median : 0.661543 Median : 0.05088 Median :-0.05893
## Mean :-0.0005389 Mean : 0.730307 Mean : 0.11918 Mean :-0.03459
## 3rd Qu.: 0.0009007 3rd Qu.: 0.904229 3rd Qu.: 0.35466 3rd Qu.: 0.12960
## Max. : 0.0048007 Max. : 1.553831 Max. : 1.28964 Max. : 0.73220
## R2
## Min. :0.001517
## 1st Qu.:0.101078
## Median :0.162037
## Mean :0.168837
## 3rd Qu.:0.221720
## Max. :0.446184Fama-French-Carhart regression
В последнюю модель был добавлен параметр моментума.
i <- NULL
K_FFС <- matrix(0, nrow = 230, ncol = 5)
Stars_FFС <- matrix(0, nrow = 230, ncol = 5)
R2_FFС <- NULL
for(i in 1:230) {
CAPM_train <- lm(data = learning_data, learning_data[,i+6]~mrp+smb+hml+mom)
Summary_FFC <- summary(CAPM_train)
K_FFС[i,] <- Summary_FFC$coefficients[,1]
Stars_FFС[i,1] <- abs(Summary_FFC$coefficients[1,1]/sqrt(vcovHAC(CAPM_train)[1,1])) > q #таблица значимости на 5% константы
Stars_FFС[i,2] <- abs(Summary_FFC$coefficients[2,1]/sqrt(vcovHAC(CAPM_train)[2,2])) > q #таблица значимости на 5% mrp
Stars_FFС[i,3] <- abs(Summary_FFC$coefficients[3,1]/sqrt(vcovHAC(CAPM_train)[3,3])) > q #таблица значимости на 5% smb
Stars_FFС[i,4] <- abs(Summary_FFC$coefficients[4,1]/sqrt(vcovHAC(CAPM_train)[4,4])) > q #таблица значимости на 5% hml
Stars_FFС[i,5] <- abs(Summary_FFC$coefficients[5,1]/sqrt(vcovHAC(CAPM_train)[5,5])) > q #таблица значимости на 5% mom
R2_FFС[i] <- Summary_FFC$r.squared #коэффициент детерминации по CAPM по 230 компаниям
}При добавлении параметра моментума у большого количества регрессий (182) этот регрессор оказался незначимым. Соответственно, его добавление, скорее всего, дало небольшую объясняющую способность с точки зрения метрики коэффициента детерминации.
#визуализация
#количество компаний с незначимыми коэффициентами
Stars_FFС1 <- as.data.frame(Stars_FFС)
colnames(Stars_FFС1) <- c("Intercept", "MRP", "SMB", "HML", "MOM")
Stars_FFC2 <- Stars_FFС1 %>% pivot_longer(cols = "Intercept":"MOM", names_to = "Variable", values_to = "Significance")
Stars_FFC3 <- as.data.frame(table(Stars_FFC2$Variable, Stars_FFC2$Significance))
#0 - не значимая, 1 - значимая
ggplot(data = Stars_FFC3, aes(x = Var1, Freq, fill = Var2)) + geom_col(position = "dodge") + scale_fill_manual(values = c("darkblue", "slateblue")) + theme_classic() + xlab("") + ylab("Количество") + geom_text(aes(label = Freq), position = position_dodge(width = 1), vjust = -0.5)
При добавлении четвертого фактора - MOM объясняющая способность модели улучшилась незначительно. Так, среднее значение коэффициента детерминации - 17,07%.
#распределение различных параметров:
results_FFC <- data.frame(K_FFС, R2_FFС)
colnames(results_FFC) <- c("Intercept", "MRP", "SMB", "HML", "MOM","R2")
as.data.frame(results_FFC) %>% tbl_summary()| Characteristic | N = 2301 |
|---|---|
| Intercept | 0.0000 (-0.0018, 0.0009) |
| MRP | 0.66 (0.53, 0.90) |
| SMB | 0.05 (-0.11, 0.36) |
| HML | -0.05 (-0.17, 0.14) |
| MOM | 0.00 (-0.06, 0.04) |
| R2 | 0.17 (0.10, 0.22) |
| 1 Median (IQR) | |
results_FFC1 <- results_FFC %>% pivot_longer(cols = "Intercept":"R2", names_to = "Variable", values_to = "Value")
ggplot(data = results_FFC1, aes(x = Variable, y = Value, fill = Variable)) + geom_boxplot() + facet_wrap(~Variable, scale = "free") + theme_classic() + scale_fill_viridis_d() + theme(legend.position = "bottom")
Описательные статистики по модели Fama-French-Carhart:
#описательные статистики
summary(results_FFC)## Intercept MRP SMB HML
## Min. :-1.570e-02 Min. :-0.002413 Min. :-1.00554 Min. :-1.01143
## 1st Qu.:-1.759e-03 1st Qu.: 0.533821 1st Qu.:-0.11132 1st Qu.:-0.17413
## Median :-1.213e-05 Median : 0.661142 Median : 0.04823 Median :-0.05498
## Mean :-5.552e-04 Mean : 0.730354 Mean : 0.11869 Mean :-0.03673
## 3rd Qu.: 9.381e-04 3rd Qu.: 0.903740 3rd Qu.: 0.35937 3rd Qu.: 0.14100
## Max. : 5.475e-03 Max. : 1.554545 Max. : 1.27722 Max. : 0.61674
## MOM R2
## Min. :-0.348746 Min. :0.00166
## 1st Qu.:-0.056384 1st Qu.:0.10110
## Median :-0.002272 Median :0.16518
## Mean :-0.006461 Mean :0.17073
## 3rd Qu.: 0.042593 3rd Qu.:0.22295
## Max. : 0.294293 Max. :0.47315Построение 9-ти моделей по тестовой выборке
#CAPM
В тестовую выборку попали следующие даты: 16.03.2020, 17.03.2020, 18.03.2020. Применив уже построенную модель CAPM были получены следующие скорректированные коэффициенты детерминации - 0.045 (16.03.2020), 0.026 (17.03.2020), 0.062 (18.03.2020). Данные коэффициенты детерминации объясняют маленькую долю дисперсии зависимой переменной. MRP значим во всех трех регрессиях.
#### date - 16.03.2020 ####
test1 <- testing_data[1,]
test1_1 <- test1 %>% pivot_longer(cols = "r1":"r230", names_to = "Companies", values_to = "Returns")
mod1 <- lm(data = test1_1, Returns ~ K[,2])
summary(mod1)##
## Call:
## lm(formula = Returns ~ K[, 2], data = test1_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.22987 -0.02670 0.01322 0.03867 0.17694
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.03947 0.01040 -3.796 0.000189 ***
## K[, 2] -0.04349 0.01267 -3.434 0.000707 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.06035 on 228 degrees of freedom
## Multiple R-squared: 0.04917, Adjusted R-squared: 0.045
## F-statistic: 11.79 on 1 and 228 DF, p-value: 0.0007074coeftest(mod1, vcov = vcovHAC(mod1))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0394724 0.0088831 -4.4435 1.381e-05 ***
## K[, 2] -0.0434924 0.0104782 -4.1508 4.682e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 17.03.2020 ####
test2 <- testing_data[2,]
test2_1 <- test2 %>% pivot_longer(cols = "r1":"r230", names_to = "Companies", values_to = "Returns")
mod2 <- lm(data = test2_1, Returns ~ K[,2])
summary(mod2)##
## Call:
## lm(formula = Returns ~ K[, 2], data = test2_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.234857 -0.029595 -0.004313 0.028387 0.251121
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.028884 0.009614 -3.004 0.00296 **
## K[, 2] 0.031015 0.011710 2.649 0.00865 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0558 on 228 degrees of freedom
## Multiple R-squared: 0.02985, Adjusted R-squared: 0.02559
## F-statistic: 7.015 on 1 and 228 DF, p-value: 0.008647coeftest(mod2, vcov = vcovHAC(mod2))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.028884 0.010728 -2.6924 0.007619 **
## K[, 2] 0.031015 0.011700 2.6508 0.008593 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 18.03.2020 ####
test3 <- testing_data[3,]
test3_1 <- test3 %>% pivot_longer(cols = "r1":"r230", names_to = "Companies", values_to = "Returns")
mod3 <- lm(data = test3_1, Returns ~ K[,2])
summary(mod3)##
## Call:
## lm(formula = Returns ~ K[, 2], data = test3_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.21223 -0.02065 0.00693 0.03032 0.26023
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.024267 0.009165 -2.648 0.00867 **
## K[, 2] -0.044703 0.011163 -4.005 8.41e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.05319 on 228 degrees of freedom
## Multiple R-squared: 0.06572, Adjusted R-squared: 0.06162
## F-statistic: 16.04 on 1 and 228 DF, p-value: 8.406e-05coeftest(mod3, vcov = vcovHAC(mod3))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0242668 0.0076408 -3.1760 0.0017 **
## K[, 2] -0.0447026 0.0087582 -5.1041 7.003e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Fama-French regression
При добавлении факторов SMB и HML имеющийся сет переменных стал объяснять бОльшую долю дисперсии. Так, для 16.03.2020 коэффициент детерминации - 34%, для 17.03.2020 - 23%, 20%. SMB значим во всех трех моделях (для всех дней тестовой выборки), MRP ни в какой день не значим, а HML не значим только 18.03.2020.
K_FF_new <- K_FF
colnames(K_FF_new) <- c("Intercept", "MRP", "SMB", "HML")
#### date - 16.03.2020 ####
mod4 <- lm(data = test1_1, Returns ~ K_FF_new[,c(2,3,4)])
summary(mod4)##
## Call:
## lm(formula = Returns ~ K_FF_new[, c(2, 3, 4)], data = test1_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.190855 -0.024829 0.004818 0.026665 0.191343
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.067462 0.009166 -7.360 3.38e-12 ***
## K_FF_new[, c(2, 3, 4)]MRP 0.007853 0.011915 0.659 0.511
## K_FF_new[, c(2, 3, 4)]SMB -0.071460 0.009877 -7.235 7.18e-12 ***
## K_FF_new[, c(2, 3, 4)]HML 0.064153 0.015773 4.067 6.57e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.05003 on 226 degrees of freedom
## Multiple R-squared: 0.3523, Adjusted R-squared: 0.3437
## F-statistic: 40.98 on 3 and 226 DF, p-value: < 2.2e-16coeftest(mod4, vcov = vcovHAC(mod4))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0674621 0.0100839 -6.6901 1.733e-10 ***
## K_FF_new[, c(2, 3, 4)]MRP 0.0078534 0.0119877 0.6551 0.5131
## K_FF_new[, c(2, 3, 4)]SMB -0.0714603 0.0091745 -7.7890 2.427e-13 ***
## K_FF_new[, c(2, 3, 4)]HML 0.0641532 0.0131408 4.8820 1.985e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 17.03.2020 ####
mod5 <- lm(data = test2_1, Returns ~ K_FF_new[,c(2,3,4)])
summary(mod5)##
## Call:
## lm(formula = Returns ~ K_FF_new[, c(2, 3, 4)], data = test2_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.221633 -0.023221 0.003835 0.025696 0.240067
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.010799 0.009072 -1.190 0.235
## K_FF_new[, c(2, 3, 4)]MRP -0.002465 0.011793 -0.209 0.835
## K_FF_new[, c(2, 3, 4)]SMB 0.039163 0.009776 4.006 8.38e-05 ***
## K_FF_new[, c(2, 3, 4)]HML -0.074403 0.015612 -4.766 3.37e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04952 on 226 degrees of freedom
## Multiple R-squared: 0.2425, Adjusted R-squared: 0.2324
## F-statistic: 24.11 on 3 and 226 DF, p-value: 1.414e-13coeftest(mod5, vcov = vcovHAC(mod5))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0107988 0.0110042 -0.9813 0.3275
## K_FF_new[, c(2, 3, 4)]MRP -0.0024650 0.0126533 -0.1948 0.8457
## K_FF_new[, c(2, 3, 4)]SMB 0.0391632 0.0079901 4.9015 1.815e-06 ***
## K_FF_new[, c(2, 3, 4)]HML -0.0744034 0.0132555 -5.6130 5.796e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 18.03.2020 ####
mod6 <- lm(data = test3_1, Returns ~ K_FF_new[,c(2,3,4)])
summary(mod6)##
## Call:
## lm(formula = Returns ~ K_FF_new[, c(2, 3, 4)], data = test3_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.180867 -0.024305 0.003322 0.027704 0.255560
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.042781 0.009014 -4.746 3.68e-06 ***
## K_FF_new[, c(2, 3, 4)]MRP -0.010938 0.011718 -0.933 0.352
## K_FF_new[, c(2, 3, 4)]SMB -0.056203 0.009714 -5.786 2.39e-08 ***
## K_FF_new[, c(2, 3, 4)]HML 0.020442 0.015512 1.318 0.189
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0492 on 226 degrees of freedom
## Multiple R-squared: 0.2074, Adjusted R-squared: 0.1969
## F-statistic: 19.72 on 3 and 226 DF, p-value: 2.171e-11coeftest(mod6, vcov = vcovHAC(mod6))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0427811 0.0081009 -5.2810 3.015e-07 ***
## K_FF_new[, c(2, 3, 4)]MRP -0.0109383 0.0098134 -1.1146 0.2662
## K_FF_new[, c(2, 3, 4)]SMB -0.0562034 0.0110255 -5.0976 7.267e-07 ***
## K_FF_new[, c(2, 3, 4)]HML 0.0204416 0.0168509 1.2131 0.2264
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#Fama-French-Carhart regression
При добавлении 4-го фактора коэффициент детерминации повысился незначительно. Для 16.03.2020 на 1 процентный пункт до 35%, для 17.03.2020 остался неизменным, для 18.03.2020 также 20%. SMB значим во всех трёх регрессиях, HML не значим 18.03.2020 (как и в случае с моделью Фама-Френч), MRP не значим во всех этих регрессиях, а моментум значим только 16.03.2020 и 18.03.2020.
K_FFC_new <- K_FFС
colnames(K_FFC_new) <- c("Intercept", "MRP", "SMB", "HML", "MOM")
#### date - 16.03.2020 ####
mod7 <- lm(data = test1_1, Returns ~ K_FFC_new[,c(2,3,4,5)])
summary(mod7)##
## Call:
## lm(formula = Returns ~ K_FFC_new[, c(2, 3, 4, 5)], data = test1_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.192170 -0.024986 0.002667 0.023322 0.193879
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.064085 0.009228 -6.945 4.02e-11 ***
## K_FFC_new[, c(2, 3, 4, 5)]MRP 0.003571 0.011987 0.298 0.766024
## K_FFC_new[, c(2, 3, 4, 5)]SMB -0.070669 0.009806 -7.207 8.58e-12 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML 0.060389 0.015746 3.835 0.000163 ***
## K_FFC_new[, c(2, 3, 4, 5)]MOM 0.058822 0.035088 1.676 0.095048 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04964 on 225 degrees of freedom
## Multiple R-squared: 0.3654, Adjusted R-squared: 0.3541
## F-statistic: 32.38 on 4 and 225 DF, p-value: < 2.2e-16coeftest(mod7, vcov = vcovHAC(mod7))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0640855 0.0101426 -6.3184 1.399e-09 ***
## K_FFC_new[, c(2, 3, 4, 5)]MRP 0.0035715 0.0123464 0.2893 0.7726
## K_FFC_new[, c(2, 3, 4, 5)]SMB -0.0706685 0.0092380 -7.6498 5.834e-13 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML 0.0603892 0.0126110 4.7886 3.045e-06 ***
## K_FFC_new[, c(2, 3, 4, 5)]MOM 0.0588217 0.0364194 1.6151 0.1077
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 17.03.2020 ####
mod8 <- lm(data = test2_1, Returns ~ K_FFC_new[,c(2,3,4,5)])
summary(mod8)##
## Call:
## lm(formula = Returns ~ K_FFC_new[, c(2, 3, 4, 5)], data = test2_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.221463 -0.022518 0.003728 0.026047 0.238066
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0121556 0.0092113 -1.320 0.188
## K_FFC_new[, c(2, 3, 4, 5)]MRP -0.0007445 0.0119660 -0.062 0.950
## K_FFC_new[, c(2, 3, 4, 5)]SMB 0.0388450 0.0097885 3.968 9.73e-05 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML -0.0728910 0.0157179 -4.637 5.98e-06 ***
## K_FFC_new[, c(2, 3, 4, 5)]MOM -0.0083315 0.0350261 -0.238 0.812
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04955 on 225 degrees of freedom
## Multiple R-squared: 0.245, Adjusted R-squared: 0.2316
## F-statistic: 18.25 on 4 and 225 DF, p-value: 5.313e-13coeftest(mod8, vcov = vcovHAC(mod8))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0121556 0.0111128 -1.0938 0.2752
## K_FFC_new[, c(2, 3, 4, 5)]MRP -0.0007445 0.0128677 -0.0579 0.9539
## K_FFC_new[, c(2, 3, 4, 5)]SMB 0.0388450 0.0079711 4.8732 2.072e-06 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML -0.0728910 0.0134146 -5.4337 1.430e-07 ***
## K_FFC_new[, c(2, 3, 4, 5)]MOM -0.0083315 0.0379864 -0.2193 0.8266
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#### date - 18.03.2020 ####
mod9 <- lm(data = test3_1, Returns ~ K_FFC_new[,c(2,3,4,5)])
summary(mod9)##
## Call:
## lm(formula = Returns ~ K_FFC_new[, c(2, 3, 4, 5)], data = test3_1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.175135 -0.022723 0.001962 0.026074 0.250738
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.039984 0.009102 -4.393 1.72e-05 ***
## K_FFC_new[, c(2, 3, 4, 5)]MRP -0.014485 0.011824 -1.225 0.2218
## K_FFC_new[, c(2, 3, 4, 5)]SMB -0.055548 0.009672 -5.743 3.00e-08 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML 0.017324 0.015531 1.115 0.2659
## K_FFC_new[, c(2, 3, 4, 5)]MOM 0.059193 0.034610 1.710 0.0886 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04896 on 225 degrees of freedom
## Multiple R-squared: 0.2188, Adjusted R-squared: 0.2049
## F-statistic: 15.75 on 4 and 225 DF, p-value: 2.218e-11coeftest(mod9, vcov = vcovHAC(mod9))##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.0399842 0.0082128 -4.8685 2.117e-06 ***
## K_FFC_new[, c(2, 3, 4, 5)]MRP -0.0144850 0.0102308 -1.4158 0.1582
## K_FFC_new[, c(2, 3, 4, 5)]SMB -0.0555476 0.0111204 -4.9951 1.180e-06 ***
## K_FFC_new[, c(2, 3, 4, 5)]HML 0.0173240 0.0168818 1.0262 0.3059
## K_FFC_new[, c(2, 3, 4, 5)]MOM 0.0591930 0.0408300 1.4497 0.1485
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1