This is an R Markdown Notebook. When you execute code within 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.

data("Grunfeld", package="plm")
library(AER)
library(tidyr)
library(ggplot2)
library(dplyr)
library(plm)
library(sandwich)
library(lmtest)
library(tidyverse)
library(car)


data <- as.data.frame(Grunfeld)
head(data)
#Loading in the data and packages
data %>%
  select(inv, value, capital) %>%
  summary()
      inv              value            capital       
 Min.   :   0.93   Min.   :  58.12   Min.   :   0.80  
 1st Qu.:  33.56   1st Qu.: 199.97   1st Qu.:  79.17  
 Median :  57.48   Median : 517.95   Median : 205.60  
 Mean   : 145.96   Mean   :1081.68   Mean   : 276.02  
 3rd Qu.: 138.04   3rd Qu.:1679.85   3rd Qu.: 358.10  
 Max.   :1486.70   Max.   :6241.70   Max.   :2226.30  
#Quick summary of the data
ggplot(data, aes(x = value, y = inv)) +
  geom_point(alpha = 0.6) + geom_smooth(method = "lm", se = TRUE, color = "red") +
  labs(title = "Investment vs Market Value", x = "Market Value", y = "Investment")


ggplot(data, aes(x = capital, y = inv)) +
  geom_point(alpha = 0.6) + geom_smooth(method = "lm", se = TRUE, color = "blue") +
  labs(title = "Investment vs Capital Stock", x = "Capital", y = "Investment")

#Scatter plots comparing value and captial on x axis with invesment on y
ggplot(gather(data), aes(value)) +
  geom_histogram(bins = 30, fill = "skyblue") +
  facet_wrap(~key, scales = 'free') +
  theme_dark()

#simple histograms
#model without year and firm
model1 <- lm(inv ~ value + capital, data = data)
summary(model1)

Call:
lm(formula = inv ~ value + capital, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-291.68  -30.01    5.30   34.83  369.45 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -42.714369   9.511676  -4.491 1.21e-05 ***
value         0.115562   0.005836  19.803  < 2e-16 ***
capital       0.230678   0.025476   9.055  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 94.41 on 197 degrees of freedom
Multiple R-squared:  0.8124,    Adjusted R-squared:  0.8105 
F-statistic: 426.6 on 2 and 197 DF,  p-value: < 2.2e-16
plot(model1)

#Model with year and firm
model2 <- lm(inv ~ value + capital + firm + year, data = data)
summary(model2)

Call:
lm(formula = inv ~ value + capital + firm + year, data = data)

Residuals:
    Min      1Q  Median      3Q     Max 
-293.93  -28.04    5.38   35.42  386.78 

Coefficients:
              Estimate Std. Error t value Pr(>|t|)    
(Intercept) -1.781e+03  2.732e+03  -0.652    0.515    
value        1.127e-01  8.323e-03  13.539  < 2e-16 ***
capital      2.186e-01  3.090e-02   7.075 2.63e-11 ***
firm        -2.364e+00  3.668e+00  -0.645    0.520    
year         9.037e-01  1.408e+00   0.642    0.522    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 94.72 on 195 degrees of freedom
Multiple R-squared:  0.8131,    Adjusted R-squared:  0.8093 
F-statistic: 212.1 on 4 and 195 DF,  p-value: < 2.2e-16
plot(model2)

# fixed effects
fe_model <- plm(inv ~ value + capital, data = data,
                    index = c("firm", "year"),
                    effect = "twoways",
                    model = "within")

# Random 
re_model <- plm(inv ~ value + capital,  data = data,
                    index = c("firm", "year"),
                    effect = "twoways",
                    model = "random")
#We should use the fixed effects model because the p value is less than 0.05

summary(fe_model)
Twoways effects Within Model

Call:
plm(formula = inv ~ value + capital, data = data, effect = "twoways", 
    model = "within", index = c("firm", "year"))

Balanced Panel: n = 10, T = 20, N = 200

Residuals:
     Min.   1st Qu.    Median   3rd Qu.      Max. 
-162.6094  -19.4710   -1.2669   19.1277  211.8420 

Coefficients:
        Estimate Std. Error t-value  Pr(>|t|)    
value   0.117716   0.013751  8.5604 6.653e-15 ***
capital 0.357916   0.022719 15.7540 < 2.2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Total Sum of Squares:    1615600
Residual Sum of Squares: 452150
R-Squared:      0.72015
Adj. R-Squared: 0.67047
F-statistic: 217.442 on 2 and 169 DF, p-value: < 2.22e-16
#This is to check for mulitcolinearity
vif(model1)
   value  capital 
1.313773 1.313773 
#this test suggests multicolinearity is not an issue. 
coeftest(fe_model, vcov. = vcovHC, type = "HC1")

t test of coefficients:

        Estimate Std. Error t value  Pr(>|t|)    
value   0.117716   0.009761 12.0599 < 2.2e-16 ***
capital 0.357916   0.043147  8.2952 3.277e-14 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

fixef(fe_model, type = "dmean")
        1         2         3         4         5         6         7         8         9        10 
 -54.0639  152.9903 -189.2947   41.2899  -59.5025   48.8247   -2.5973   13.4266  -23.8464   72.7732 
plmtest(fe_model, effect="twoways")

    Lagrange Multiplier Test - two-ways effects (Honda)

data:  inv ~ value + capital
normal = 18.181, p-value < 2.2e-16
alternative hypothesis: significant effects
#Lets now use the random effects model 

summary(re_model)
Twoways effects Random Effect Model 
   (Swamy-Arora's transformation)

Call:
plm(formula = inv ~ value + capital, data = data, effect = "twoways", 
    model = "random", index = c("firm", "year"))

Balanced Panel: n = 10, T = 20, N = 200

Effects:
                  var std.dev share
idiosyncratic 2675.43   51.72 0.274
individual    7095.25   84.23 0.726
time             0.00    0.00 0.000
theta: 0.864 (id) 0 (time) 0 (total)

Residuals:
     Min.   1st Qu.    Median   3rd Qu.      Max. 
-177.1700  -19.7576    4.6048   19.4676  252.7596 

Coefficients:
              Estimate Std. Error z-value Pr(>|z|)    
(Intercept) -57.865377  29.393359 -1.9687  0.04899 *  
value         0.109790   0.010528 10.4285  < 2e-16 ***
capital       0.308190   0.017171 17.9483  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Total Sum of Squares:    2376000
Residual Sum of Squares: 547910
R-Squared:      0.7694
Adj. R-Squared: 0.76706
Chisq: 657.295 on 2 DF, p-value: < 2.22e-16
phtest(fe_model, re_model)

    Hausman Test

data:  inv ~ value + capital
chisq = 13.46, df = 2, p-value = 0.001194
alternative hypothesis: one model is inconsistent
#Im now gonna look at residuals 

plot(resid(fe_model),
     main = "Residuals from Fixed Effects Model",
     xlab = "Observation Index",
     ylab = "Residuals")

#This is just to see the resiudals 
residuals_df <- data.frame(
  fitted = fitted(fe_model),
  resid = resid(fe_model))



ggplot(residuals_df, aes(x = fitted, y = resid)) +
  geom_point(alpha = 0.6, color = "blue") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuals vs Fitted Values",
       x = "Fitted Values",
       y = "Residuals") +
  theme_minimal()

LS0tDQp0aXRsZTogIkFzc2VzaW5nIFBhbmVsIERhdGEiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpUaGlzIGlzIGFuIFtSIE1hcmtkb3duXShodHRwOi8vcm1hcmtkb3duLnJzdHVkaW8uY29tKSBOb3RlYm9vay4gV2hlbiB5b3UgZXhlY3V0ZSBjb2RlIHdpdGhpbiB0aGUgbm90ZWJvb2ssIHRoZSByZXN1bHRzIGFwcGVhciBiZW5lYXRoIHRoZSBjb2RlLiANCg0KVHJ5IGV4ZWN1dGluZyB0aGlzIGNodW5rIGJ5IGNsaWNraW5nIHRoZSAqUnVuKiBidXR0b24gd2l0aGluIHRoZSBjaHVuayBvciBieSBwbGFjaW5nIHlvdXIgY3Vyc29yIGluc2lkZSBpdCBhbmQgcHJlc3NpbmcgKkN0cmwrU2hpZnQrRW50ZXIqLiANCmBgYHtyfQ0KZGF0YSgiR3J1bmZlbGQiLCBwYWNrYWdlPSJwbG0iKQ0KbGlicmFyeShBRVIpDQpsaWJyYXJ5KHRpZHlyKQ0KbGlicmFyeShnZ3Bsb3QyKQ0KbGlicmFyeShkcGx5cikNCmxpYnJhcnkocGxtKQ0KbGlicmFyeShzYW5kd2ljaCkNCmxpYnJhcnkobG10ZXN0KQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KGNhcikNCg0KDQpkYXRhIDwtIGFzLmRhdGEuZnJhbWUoR3J1bmZlbGQpDQpoZWFkKGRhdGEpDQojTG9hZGluZyBpbiB0aGUgZGF0YSBhbmQgcGFja2FnZXMNCmBgYA0KDQpgYGB7cn0NCmRhdGEgJT4lDQogIHNlbGVjdChpbnYsIHZhbHVlLCBjYXBpdGFsKSAlPiUNCiAgc3VtbWFyeSgpDQojUXVpY2sgc3VtbWFyeSBvZiB0aGUgZGF0YQ0KYGBgDQoNCg0KDQoNCg0KYGBge3J9DQpnZ3Bsb3QoZGF0YSwgYWVzKHggPSB2YWx1ZSwgeSA9IGludikpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuNikgKyBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBzZSA9IFRSVUUsIGNvbG9yID0gInJlZCIpICsNCiAgbGFicyh0aXRsZSA9ICJJbnZlc3RtZW50IHZzIE1hcmtldCBWYWx1ZSIsIHggPSAiTWFya2V0IFZhbHVlIiwgeSA9ICJJbnZlc3RtZW50IikNCg0KZ2dwbG90KGRhdGEsIGFlcyh4ID0gY2FwaXRhbCwgeSA9IGludikpICsNCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuNikgKyBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCBzZSA9IFRSVUUsIGNvbG9yID0gImJsdWUiKSArDQogIGxhYnModGl0bGUgPSAiSW52ZXN0bWVudCB2cyBDYXBpdGFsIFN0b2NrIiwgeCA9ICJDYXBpdGFsIiwgeSA9ICJJbnZlc3RtZW50IikNCiNTY2F0dGVyIHBsb3RzIGNvbXBhcmluZyB2YWx1ZSBhbmQgY2FwdGlhbCBvbiB4IGF4aXMgd2l0aCBpbnZlc21lbnQgb24geQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KGdhdGhlcihkYXRhKSwgYWVzKHZhbHVlKSkgKw0KICBnZW9tX2hpc3RvZ3JhbShiaW5zID0gMzAsIGZpbGwgPSAic2t5Ymx1ZSIpICsNCiAgZmFjZXRfd3JhcCh+a2V5LCBzY2FsZXMgPSAnZnJlZScpICsNCiAgdGhlbWVfZGFyaygpDQojc2ltcGxlIGhpc3RvZ3JhbXMNCmBgYA0KDQoNCmBgYHtyfQ0KI21vZGVsIHdpdGhvdXQgeWVhciBhbmQgZmlybQ0KbW9kZWwxIDwtIGxtKGludiB+IHZhbHVlICsgY2FwaXRhbCwgZGF0YSA9IGRhdGEpDQpzdW1tYXJ5KG1vZGVsMSkNCg0KYGBgDQoNCmBgYHtyfQ0KcGxvdChtb2RlbDEpDQpgYGANCg0KYGBge3J9DQojTW9kZWwgd2l0aCB5ZWFyIGFuZCBmaXJtDQptb2RlbDIgPC0gbG0oaW52IH4gdmFsdWUgKyBjYXBpdGFsICsgZmlybSArIHllYXIsIGRhdGEgPSBkYXRhKQ0Kc3VtbWFyeShtb2RlbDIpDQpgYGANCmBgYHtyfQ0KcGxvdChtb2RlbDIpDQpgYGANCg0KDQpgYGB7cn0NCiMgZml4ZWQgZWZmZWN0cw0KZmVfbW9kZWwgPC0gcGxtKGludiB+IHZhbHVlICsgY2FwaXRhbCwgZGF0YSA9IGRhdGEsDQogICAgICAgICAgICAgICAgICAgIGluZGV4ID0gYygiZmlybSIsICJ5ZWFyIiksDQogICAgICAgICAgICAgICAgICAgIGVmZmVjdCA9ICJ0d293YXlzIiwNCiAgICAgICAgICAgICAgICAgICAgbW9kZWwgPSAid2l0aGluIikNCg0KIyBSYW5kb20gDQpyZV9tb2RlbCA8LSBwbG0oaW52IH4gdmFsdWUgKyBjYXBpdGFsLCAgZGF0YSA9IGRhdGEsDQogICAgICAgICAgICAgICAgICAgIGluZGV4ID0gYygiZmlybSIsICJ5ZWFyIiksDQogICAgICAgICAgICAgICAgICAgIGVmZmVjdCA9ICJ0d293YXlzIiwNCiAgICAgICAgICAgICAgICAgICAgbW9kZWwgPSAicmFuZG9tIikNCmBgYA0KDQoNCg0KYGBge3J9DQojV2Ugc2hvdWxkIHVzZSB0aGUgZml4ZWQgZWZmZWN0cyBtb2RlbCBiZWNhdXNlIHRoZSBwIHZhbHVlIGlzIGxlc3MgdGhhbiAwLjA1DQoNCnN1bW1hcnkoZmVfbW9kZWwpDQpgYGANCg0KYGBge3J9DQojVGhpcyBpcyB0byBjaGVjayBmb3IgbXVsaXRjb2xpbmVhcml0eQ0KdmlmKG1vZGVsMSkNCmBgYA0KDQoNCmBgYHtyfQ0KI1RoaXMgaXMgYSB0ZXN0IGZvciB0aGUgY29lZmZpY2FudHMgDQpjb2VmdGVzdChmZV9tb2RlbCwgdmNvdi4gPSB2Y292SEMsIHR5cGUgPSAiSEMxIikNCmBgYA0KDQpgYGB7cn0NCg0KZml4ZWYoZmVfbW9kZWwsIHR5cGUgPSAiZG1lYW4iKQ0KYGBgDQpgYGB7cn0NCnBsbXRlc3QoZmVfbW9kZWwsIGVmZmVjdD0idHdvd2F5cyIpDQpgYGANCg0KYGBge3J9DQojTGV0cyBub3cgdXNlIHRoZSByYW5kb20gZWZmZWN0cyBtb2RlbCANCg0Kc3VtbWFyeShyZV9tb2RlbCkNCmBgYA0KDQpgYGB7cn0NCnBodGVzdChmZV9tb2RlbCwgcmVfbW9kZWwpDQoNCg0KI1RoaXMgYWdhaW4gY29uZmlybXMgdGhhdCB0aGUgZml4ZWQgZWZmZWN0cyBtb2RlbCB3YXMgbW9yZSBlZmZlY3RpdmUgdGhhbiB0aGUgcmFuZG9tIGVmZmVjdHMgYmVjYXVzZSBpdCBpcyBhIHNpZ25pZmljYW50IHJlc3VsdA0KYGBgDQoNCmBgYHtyfQ0KI0ltIG5vdyBnb25uYSBsb29rIGF0IHJlc2lkdWFscyANCg0KcGxvdChyZXNpZChmZV9tb2RlbCksDQogICAgIG1haW4gPSAiUmVzaWR1YWxzIGZyb20gRml4ZWQgRWZmZWN0cyBNb2RlbCIsDQogICAgIHhsYWIgPSAiT2JzZXJ2YXRpb24gSW5kZXgiLA0KICAgICB5bGFiID0gIlJlc2lkdWFscyIpDQojVGhpcyBpcyBqdXN0IHRvIHNlZSB0aGUgcmVzaXVkYWxzIA0KYGBgDQpgYGB7cn0NCnJlc2lkdWFsc19kZiA8LSBkYXRhLmZyYW1lKA0KICBmaXR0ZWQgPSBmaXR0ZWQoZmVfbW9kZWwpLA0KICByZXNpZCA9IHJlc2lkKGZlX21vZGVsKSkNCg0KDQoNCmdncGxvdChyZXNpZHVhbHNfZGYsIGFlcyh4ID0gZml0dGVkLCB5ID0gcmVzaWQpKSArDQogIGdlb21fcG9pbnQoYWxwaGEgPSAwLjYsIGNvbG9yID0gImJsdWUiKSArDQogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGxpbmV0eXBlID0gImRhc2hlZCIsIGNvbG9yID0gInJlZCIpICsNCiAgbGFicyh0aXRsZSA9ICJSZXNpZHVhbHMgdnMgRml0dGVkIFZhbHVlcyIsDQogICAgICAgeCA9ICJGaXR0ZWQgVmFsdWVzIiwNCiAgICAgICB5ID0gIlJlc2lkdWFscyIpICsNCiAgdGhlbWVfbWluaW1hbCgpDQoNCmBgYA0KDQo=