knitr::opts_chunk$set(warning = FALSE, message = FALSE)Analysis of the Impact of Science-Based Targets on Performance, Risk, and Enterprise Value - An Empirical Study
Disable warnings and messages
install packages load libraries
# if it's not been installed install.packages("readxl")
library(readxl)
# if it's not been installed install.packages("tidyverse")
library(tidyverse)
# if it's not been installed install.packages("broom")
library(broom)
# if it's not been installed install.packages("modelsummary")
library(modelsummary)
# if it's not been installed install.packages("tinytex")
library(tinytex)Import Data and Data Manipulation for the Control Group
# specifiying the file path for the control group data
Var_ControlGroup_FilePath <- "Meier RE Data/RE Data CG.xlsx"
# extracting the names of the sheets in the workbook
Vec_ControlGroup_Sheetnames <- excel_sheets(Var_ControlGroup_FilePath)
#importing the data to a data list
DList_ControlGroup <- lapply(Vec_ControlGroup_Sheetnames,
function(sheet) {
read_excel(Var_ControlGroup_FilePath, sheet = sheet, col_types = c("text", "text", "text","numeric", "text", "text", "text", "text", "text", "text", "text", "numeric", "numeric", "numeric"), skip = 1)
})
# identifying the equation for the calculation of the tobin's Q
Func_Tobins.Q <- function(df) {
df$Tobins.Q <- (df$TR.TotalAssetsReported - df$TR.TotalEquity +df$TR.CompanyMarketCap) / df$TR.TotalAssetsReported
return(df)
}
# appliction of the Tobin's Q equation on the list
DList_ControlGroup <- lapply(DList_ControlGroup, Func_Tobins.Q)
#identifying the needed columns from the data frames
Vec_SelectedColumns <- c("TR.CompanyName","ISIN","Year", "TR.TRBCIndustryGroup" , "TR.GICSSector" ,"Tobins.Q")
#combining all data in a single data frame
DF_ControlGroup <- bind_rows(lapply(DList_ControlGroup, function(df) {
df %>% select(all_of(Vec_SelectedColumns)) }))
# omitting the missing values
DF_ControlGroup <- DF_ControlGroup %>% na.omit()
#identifying all companies as a control group items in preparation to combine them with the treatment group
DF_ControlGroup$SBT.Company <- 0
#identifying pre-post change of policy
DF_ControlGroup$After.2020 <- ifelse(DF_ControlGroup$Year >= 2020 , 1 , 0 )Import Data and Data Manipulation for the Treatment Group
# specifiying the file path for the treatment group data
Var_TreatmentGroup_FilePath <- "Meier RE Data/RE Data TG.xlsx"
# extracting the names of the sheets in the workbook
Vec_TreatmentGroup_Sheetnames <- excel_sheets(Var_TreatmentGroup_FilePath)
#importing the data to a data list
DList_TreatmentGroup <- lapply(Vec_TreatmentGroup_Sheetnames,
function(sheet) {
read_excel(Var_TreatmentGroup_FilePath, sheet = sheet, col_types = c("text", "text", "text","text","numeric", "text", "text", "text", "text", "text", "text", "text", "numeric", "numeric", "numeric"), skip = 1)
})
# appliction of the Tobin's Q equation on the list
DList_TreatmentGroup <- lapply(DList_TreatmentGroup, Func_Tobins.Q)
#combining all data in a single data frame
DF_TreatmentGroup <- bind_rows(lapply(DList_TreatmentGroup, function(df) {
df %>% select(all_of(Vec_SelectedColumns)) }))
# omitting the missing values
DF_TreatmentGroup <- DF_TreatmentGroup %>% na.omit()
#identifying all companies as a control group items in preparation to combine them with the treatment group
DF_TreatmentGroup$SBT.Company <- 1
#identifying pre-post change of policy
DF_TreatmentGroup$After.2020 <- ifelse(DF_TreatmentGroup$Year >= 2020 , 1 , 0 )Filter the control group and combining the TG with the unique CG
# filter the control group based on the ISIN to companies that are not in the treatment group
DF_ControlGroup_unique <- DF_ControlGroup %>% filter(!(DF_ControlGroup$ISIN%in% DF_TreatmentGroup$ISIN))
#combining the TG with the unique CG
DF_CG_TG_Analysis <- bind_rows(DF_ControlGroup_unique,DF_TreatmentGroup)Winsorise Tobins Q
#Defining the Winsorization formula
Func_winsorize <- function(x, lower_quantile = 0.05, upper_quantile = 0.95) {
lower_bound <- quantile(x, lower_quantile)
upper_bound <- quantile(x, upper_quantile)
x[x < lower_bound] <- lower_bound
x[x > upper_bound] <- upper_bound
return(x)}
# Winsorise the Tobins.Q data
DF_CG_TG_Analysis$Tobins.Q.Wins <- Func_winsorize(DF_CG_TG_Analysis$Tobins.Q, lower_quantile = 0.05, upper_quantile = 0.95)Exploratory data analysis
# Create a named vector for custom labels
Vec_SBT.Labels <- c(`0` = "without SBTs", `1` = "with SBTs")
# visualizing the distribution of Wins.TobinsQ separating companies with SBTS from companies without SBTs
Plot_Distribution.of.TobinsQ <- ggplot(DF_CG_TG_Analysis ,mapping = aes(x = Tobins.Q.Wins))+
labs(title = "Distribution of Tobin's Q") +
geom_histogram(color= "white") +
facet_wrap(vars(SBT.Company), labeller = as_labeller(Vec_SBT.Labels))+
scale_x_continuous(breaks = seq(floor(min(DF_CG_TG_Analysis$Tobins.Q.Wins)),ceiling(max(DF_CG_TG_Analysis$Tobins.Q.Wins)), by = 1)) +
scale_y_continuous(breaks = seq(0,4000, by = 500))
print(Plot_Distribution.of.TobinsQ)
#visualizing the Wins.TobinsQ before and after 2020 separating companies with SBTS from companies without SBTs
Plot_TobinsQ.before.and.after.2020 <- ggplot(DF_CG_TG_Analysis, mapping = aes(x = SBT.Company, y = Tobins.Q.Wins))+
labs(title = "Tobin's Q before and after 2020",x= "Before-After 2020")+
stat_summary(geom = "pointrange", fun.data = "mean_se") +
facet_wrap(vars(After.2020), labeller = as_labeller(Vec_SBT.Labels))+
scale_x_continuous(breaks = seq(floor(min(DF_CG_TG_Analysis$After.2020)),ceiling(max(DF_CG_TG_Analysis$After.2020)), by = 1)) +
scale_y_continuous(breaks = seq(floor(min(DF_CG_TG_Analysis$Tobins.Q.Wins)),ceiling(max(DF_CG_TG_Analysis$Tobins.Q.Wins)), by = 0.1))
print(Plot_TobinsQ.before.and.after.2020)
Difference in Difference using regression
#calculation of diff in diff using regression
Mod_Diff.in.Diff.Model <- lm(DF_CG_TG_Analysis$Tobins.Q.Wins ~ SBT.Company + After.2020 + (SBT.Company * After.2020), data = DF_CG_TG_Analysis)
tidy(Mod_Diff.in.Diff.Model)# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 2.20 0.0200 110. 0
2 SBT.Company -0.260 0.0263 -9.88 5.57e-23
3 After.2020 0.0226 0.0278 0.812 4.17e- 1
4 SBT.Company:After.2020 -0.0909 0.0366 -2.48 1.30e- 2print(modelsummary(Mod_Diff.in.Diff.Model))
+--------------------------+------------+
| | (1) |
+==========================+============+
| (Intercept) | 2.198 |
+--------------------------+------------+
| | (0.020) |
+--------------------------+------------+
| SBT.Company | -0.260 |
+--------------------------+------------+
| | (0.026) |
+--------------------------+------------+
| After.2020 | 0.023 |
+--------------------------+------------+
| | (0.028) |
+--------------------------+------------+
| SBT.Company × After.2020 | -0.091 |
+--------------------------+------------+
| | (0.037) |
+--------------------------+------------+
| Num.Obs. | 27541 |
+--------------------------+------------+
| R2 | 0.010 |
+--------------------------+------------+
| R2 Adj. | 0.010 |
+--------------------------+------------+
| AIC | 100488.9 |
+--------------------------+------------+
| BIC | 100530.0 |
+--------------------------+------------+
| Log.Lik. | -50239.447 |
+--------------------------+------------+
| RMSE | 1.50 |
+--------------------------+------------+ Difference in Difference Manual
#identification of the average points
DF_Diffs <- DF_CG_TG_Analysis %>%
group_by(After.2020, SBT.Company) %>%
summarize(mean_TobinsQ.Wins = mean(Tobins.Q.Wins))
print(DF_Diffs)# A tibble: 4 × 3
# Groups: After.2020 [2]
After.2020 SBT.Company mean_TobinsQ.Wins
<dbl> <dbl> <dbl>
1 0 0 2.20
2 0 1 1.94
3 1 0 2.22
4 1 1 1.87# extracting the averages from the diff dataframe
Var_before.control <- DF_Diffs %>%
filter(After.2020 == 0, SBT.Company == 0) %>%
pull(mean_TobinsQ.Wins)
Var_after.control <- DF_Diffs %>%
filter(After.2020 == 1, SBT.Company == 0) %>%
pull(mean_TobinsQ.Wins)
Var_before.treatment <- DF_Diffs %>%
filter(After.2020 == 0, SBT.Company == 1) %>%
pull(mean_TobinsQ.Wins)
Var_after.treatment <- DF_Diffs %>%
filter(After.2020 == 1, SBT.Company == 1) %>%
pull(mean_TobinsQ.Wins)
# calculation of the differnces
Var_Diff_Control <- Var_after.control - Var_before.control
Var_Diff_treatment <- Var_after.treatment - Var_before.treatment
#Calculation of the Difference in Difference
Var_Diff.in.Diff <- Var_Diff_treatment - Var_Diff_Control
#Visualisation of the Differences
Plot_Diff.in.Diff <- ggplot(data = DF_Diffs, aes(x= After.2020 , y = mean_TobinsQ.Wins, color = SBT.Company)) +
geom_point() +
geom_line(aes(group = SBT.Company)) +
scale_x_continuous( breaks = seq( 0,1, by = 1)) +
labs( title = "Difference in Differnce", x = "Before_After 2020")+
theme(legend.position = "none")+
annotate(geom = "segment", x= 0, xend = 1,
y= Var_before.treatment, yend =Var_after.treatment - Var_Diff.in.Diff,
linetype = "dotted") +
annotate(geom = "segment", x = 1, xend = 1,
y= Var_after.treatment - Var_Diff.in.Diff, yend = Var_after.treatment,
color = " red")
print(Plot_Diff.in.Diff)
Difference in Difference using regression controlling for Sector
#calculation of diff in diff using regression controlling by Sector
Mod_Diff.in.Diff.Model.SectorControl <- lm(DF_CG_TG_Analysis$Tobins.Q.Wins ~ SBT.Company + After.2020 + (SBT.Company * After.2020)
+TR.GICSSector
, data = DF_CG_TG_Analysis)
tidy(Mod_Diff.in.Diff.Model.SectorControl)# A tibble: 15 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 2.59 0.0414 62.5 0
2 SBT.Company -0.436 0.0247 -17.6 2.54e- 69
3 After.2020 0.00491 0.0254 0.193 8.47e- 1
4 TR.GICSSectorConsumer Discretionary -0.0772 0.0436 -1.77 7.70e- 2
5 TR.GICSSectorConsumer Staples 0.163 0.0477 3.42 6.36e- 4
6 TR.GICSSectorEnergy -1.21 0.0650 -18.6 1.08e- 76
7 TR.GICSSectorFinancials -1.11 0.0446 -24.8 8.09e-135
8 TR.GICSSectorHealth Care 0.899 0.0488 18.4 1.95e- 75
9 TR.GICSSectorIndustrials -0.401 0.0418 -9.61 7.54e- 22
10 TR.GICSSectorInformation Technology 0.592 0.0447 13.3 5.95e- 40
11 TR.GICSSectorMaterials -0.588 0.0459 -12.8 1.89e- 37
12 TR.GICSSectorNULL -0.667 0.0640 -10.4 2.23e- 25
13 TR.GICSSectorReal Estate -0.950 0.0529 -18.0 1.05e- 71
14 TR.GICSSectorUtilities -1.13 0.0553 -20.4 4.88e- 92
15 SBT.Company:After.2020 -0.0836 0.0334 -2.50 1.25e- 2print(modelsummary(list(Mod_Diff.in.Diff.Model, Mod_Diff.in.Diff.Model.SectorControl)))
+-------------------------------------+------------+------------+
| | (1) | (2) |
+=====================================+============+============+
| (Intercept) | 2.198 | 2.586 |
+-------------------------------------+------------+------------+
| | (0.020) | (0.041) |
+-------------------------------------+------------+------------+
| SBT.Company | -0.260 | -0.436 |
+-------------------------------------+------------+------------+
| | (0.026) | (0.025) |
+-------------------------------------+------------+------------+
| After.2020 | 0.023 | 0.005 |
+-------------------------------------+------------+------------+
| | (0.028) | (0.025) |
+-------------------------------------+------------+------------+
| SBT.Company × After.2020 | -0.091 | -0.084 |
+-------------------------------------+------------+------------+
| | (0.037) | (0.033) |
+-------------------------------------+------------+------------+
| TR.GICSSectorConsumer Discretionary | | -0.077 |
+-------------------------------------+------------+------------+
| | | (0.044) |
+-------------------------------------+------------+------------+
| TR.GICSSectorConsumer Staples | | 0.163 |
+-------------------------------------+------------+------------+
| | | (0.048) |
+-------------------------------------+------------+------------+
| TR.GICSSectorEnergy | | -1.208 |
+-------------------------------------+------------+------------+
| | | (0.065) |
+-------------------------------------+------------+------------+
| TR.GICSSectorFinancials | | -1.109 |
+-------------------------------------+------------+------------+
| | | (0.045) |
+-------------------------------------+------------+------------+
| TR.GICSSectorHealth Care | | 0.899 |
+-------------------------------------+------------+------------+
| | | (0.049) |
+-------------------------------------+------------+------------+
| TR.GICSSectorIndustrials | | -0.401 |
+-------------------------------------+------------+------------+
| | | (0.042) |
+-------------------------------------+------------+------------+
| TR.GICSSectorInformation Technology | | 0.592 |
+-------------------------------------+------------+------------+
| | | (0.045) |
+-------------------------------------+------------+------------+
| TR.GICSSectorMaterials | | -0.588 |
+-------------------------------------+------------+------------+
| | | (0.046) |
+-------------------------------------+------------+------------+
| TR.GICSSectorNULL | | -0.667 |
+-------------------------------------+------------+------------+
| | | (0.064) |
+-------------------------------------+------------+------------+
| TR.GICSSectorReal Estate | | -0.950 |
+-------------------------------------+------------+------------+
| | | (0.053) |
+-------------------------------------+------------+------------+
| TR.GICSSectorUtilities | | -1.130 |
+-------------------------------------+------------+------------+
| | | (0.055) |
+-------------------------------------+------------+------------+
| Num.Obs. | 27541 | 27541 |
+-------------------------------------+------------+------------+
| R2 | 0.010 | 0.175 |
+-------------------------------------+------------+------------+
| R2 Adj. | 0.010 | 0.175 |
+-------------------------------------+------------+------------+
| AIC | 100488.9 | 95497.4 |
+-------------------------------------+------------+------------+
| BIC | 100530.0 | 95628.9 |
+-------------------------------------+------------+------------+
| Log.Lik. | -50239.447 | -47732.683 |
+-------------------------------------+------------+------------+
| RMSE | 1.50 | 1.37 |
+-------------------------------------+------------+------------+ Resources
https://www.youtube.com/watch?v=u5iEtpITL3s&list=PLS6tnpTr39sHw3FevrihLn2Ly8pSCUUag&pp=iAQB
The code has been written with the help of AI (ChatGPT)