From 0ad3a421aa425db840d81d7717be3a34f37c3f87 Mon Sep 17 00:00:00 2001
From: Marder <fm58hufi@usr.idiv.de>
Date: Tue, 26 Mar 2024 10:34:32 +0100
Subject: [PATCH] OLS tables
---
Scripts/MAKE_FILE.R | 1 +
Scripts/create_tables.R | 41 ++++++-
Scripts/data_prep.R | 7 ++
Scripts/logit/chr_vol_treat.R | 7 +-
Scripts/mxl/mxl_wtp_space_caseD.R | 167 +++++++++++++++++++++++++++++
Scripts/ols/ols_consequentiality.R | 7 ++
Scripts/ols/ols_nr.R | 2 +
Scripts/ols/ols_opt_out.R | 7 ++
Scripts/ols/ols_quiz.R | 8 +-
Scripts/ols/ols_time_spent.R | 13 ++-
Scripts/treatment.R | 15 ++-
11 files changed, 265 insertions(+), 10 deletions(-)
create mode 100644 Scripts/mxl/mxl_wtp_space_caseD.R
diff --git a/Scripts/MAKE_FILE.R b/Scripts/MAKE_FILE.R
index 08efb1f..be870b6 100644
--- a/Scripts/MAKE_FILE.R
+++ b/Scripts/MAKE_FILE.R
@@ -70,6 +70,7 @@ mxl_wtp_case_c_NR <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_NR_Case_C"
mxl_wtp_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case A Rent Int")
mxl_wtp_case_b_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp Case B Rent Int")
mxl_wtp_case_c_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_C Rent INT")
+mxl_wtp_case_d_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp_Case_D")
# rent interactions models NR
mxl_wtp_NR_case_a_rentINT <- apollo_loadModel("Estimation_results/mxl/MXL_wtp NR A Rent INT")
diff --git a/Scripts/create_tables.R b/Scripts/create_tables.R
index 9513164..588d392 100644
--- a/Scripts/create_tables.R
+++ b/Scripts/create_tables.R
@@ -5,11 +5,48 @@ dir.create("Tables/logit")
dir.create("Tables/ols/")
-list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Vol. Treated",
+list_ols <- list("(Intercept)" = "Intercept", "as.factor(Treatment_A)Treated" = "Treated", "as.factor(Treatment_A)Vol_Treated" = "Optional Treatment",
"as.factor(Treatment_C)No Info 2" = "No Info 2", "as.factor(Treatment_C)No Video 1" = "Text 1",
"as.factor(Treatment_C)No Video 2" = "Text 2", "as.factor(Treatment_C)Video 1" = "Video 1",
- "as.factor(Treatment_C)Video 2" = "Video 2", "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
+ "as.factor(Treatment_C)Video 2" = "Video 2", "as.factor(Treatment_D)Treated" = "Treated", "as.factor(Treatment_D)Vol. Treated" = "Vol. Treated",
+ "as.factor(Treatment_D)No Info 2" = "No Info",
+ "Z_Mean_NR" = "NR-Index", "as.factor(Gender)2" = "Female",
"Age_mean" = "Age", "QFIncome" = "Income", "Uni_degree" = "University Degree")
+# OLS A
+texreg(l=list(ols_percentage_correct_control_A, ols_time_spent_control_A, ols_time_cc_control_A, conseq_model_control_A),
+ custom.model.names = c("Quiz", "Interview Time", "CC Time", "Cons. Score"),
+ custom.header = list("Model 1A" = 1:1, "Model 2A" = 2:2, "Model 3A" = 3:3, "Model 4A" = 4:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "Notes: (i) The dependent variables examined in this regression analysis are as follows:
+ Model 1A represents the percentage of correct quiz questions, Model 2A refers to net interview time,
+ Model 3A denotes choice card time, and Model 4A represents consequentiality score.
+ (ii) The variables included in the analysis are as follows: Treated is a dummy variable indicating membership
+ in the obligatory treated group, Optional Treatment is a dummy variable indicating membership in the group with
+ the choice to receive treatment or not, with the reference group being Non-Treated. NR-Index represents the z-standardized
+ natural relatedness index. Female is a dummy variable denoting gender, Age has been mean-centered and measured in years,
+ Income is a continuous variable indicating a transition from one income group to the next higher, and University Degree is
+ a dummy variable indicating whether an individual holds a university degree; (iii) %stars and standard errors in parentheses.",
+ label = "tab:mani",
+ caption = "Results of OLS regressions for Scenario Case A.",
+ file="Tables/ols/ols_A.tex")
+
+# OLS D
+texreg(l=list(ols_percentage_correct_control_D, ols_time_spent_control_D, ols_time_cc_control_D, conseq_model_control_D),
+ custom.model.names = c("Quiz", "Interview Time", "CC Time", "Cons. Score"),
+ custom.header = list("Model 1B" = 1:1, "Model 2B" = 2:2, "Model 3B" = 3:3, "Model 4B" = 4:4),
+ custom.coef.map = list_ols, stars = c(0.01, 0.05, 0.1), float.pos="tb",
+ custom.note = "Notes: (i) The dependent variables examined in this regression analysis are as follows:
+ Model 1B represents the percentage of correct quiz questions, Model 2B refers to net interview time,
+ Model 3B denotes choice card time, and Model 4B represents consequentiality score.
+ (ii) The variables included in the analysis are as follows: Treated is a dummy variable indicating membership
+ in the obligatory treated group, Vol. Treated is a dummy variable indicating the group that voluntarily chose the optional treatment,
+ while No Info indicates the group that did not opt for the treatment, with the reference group being Non-Treated. NR-Index represents the z-standardized
+ natural relatedness index. Female is a dummy variable denoting gender, Age has been mean-centered and measured in years,
+ Income is a continuous variable indicating a transition from one income group to the next higher, and University Degree is
+ a dummy variable indicating whether an individual holds a university degree; (iii) %stars and standard errors in parentheses.",
+ label = "tab:mani",
+ caption = "Results of OLS regressions for Scenario Case B.",
+ file="Tables/ols/ols_D.tex")
# Manipulation check
texreg(l=list(ols_percentage_correct_A, ols_percentage_correct_control_A, ols_percentage_correct_C, ols_percentage_correct_control_C),
diff --git a/Scripts/data_prep.R b/Scripts/data_prep.R
index 567faf4..8f69532 100644
--- a/Scripts/data_prep.R
+++ b/Scripts/data_prep.R
@@ -58,6 +58,13 @@ database_full <- database_full %>%
Treatment_new == 5 ~ 'Video 2',
Treatment_new == 6 ~ 'No Treatment 3',
TRUE ~ NA_character_
+ )) %>%
+ mutate(Treatment_D = case_when(
+ Treatment_new == 1 | Treatment_new == 2 ~ 'Treated',
+ Treatment_new == 3 ~ 'No Info 2',
+ Treatment_new == 4 | Treatment_new == 5 ~ 'Vol. Treated',
+ Treatment_new == 6 ~ 'No Treatment 3',
+ TRUE ~ NA_character_
))
id_list <- unique(database_full$id)
diff --git a/Scripts/logit/chr_vol_treat.R b/Scripts/logit/chr_vol_treat.R
index 8272830..6f652b4 100644
--- a/Scripts/logit/chr_vol_treat.R
+++ b/Scripts/logit/chr_vol_treat.R
@@ -18,8 +18,9 @@ data <- database_full %>%
slice(1) %>%
ungroup()
data <- data %>%
- mutate(Choice_Treat = ifelse(Dummy_Video_1 == 1 | Dummy_Video_2 == 1 | Dummy_Info_nv2 == 1, 1,
- ifelse(Dummy_no_info==1 | Dummy_Info_nv1 == 1,0,NA)))
+ mutate(Choice_Treat = ifelse( Dummy_Video_2 == 1 | Dummy_Info_nv2 == 1, 1,
+ ifelse(Dummy_no_info==1 ,0,NA)))
+
table(data$Choice_Treat)
@@ -36,7 +37,7 @@ logit_choice_treat_uni<-glm(Choice_Treat ~ as.factor(Gender)+Z_Mean_NR+Age_mean
summary(logit_choice_treat_uni)
# Calculate marginal effects
-marginal_effects <- margins(logit_choice_treat)
+marginal_effects <- margins(logit_choice_treat_uni)
# Display the marginal effects
summary(marginal_effects)
diff --git a/Scripts/mxl/mxl_wtp_space_caseD.R b/Scripts/mxl/mxl_wtp_space_caseD.R
new file mode 100644
index 0000000..d32875f
--- /dev/null
+++ b/Scripts/mxl/mxl_wtp_space_caseD.R
@@ -0,0 +1,167 @@
+#### Apollo standard script #####
+
+library(apollo) # Load apollo package
+
+
+
+# Test treatment effect
+
+database <- database_full %>%
+ filter(!is.na(Treatment_new)) %>%
+ mutate(Dummy_Treated = case_when(Treatment_new == 1|Treatment_new == 2 ~ 1, TRUE ~ 0),
+ Dummy_Vol_Treated = case_when(Treatment_new == 5 |Treatment_new == 4 ~ 1, TRUE ~ 0),
+ Dummy_no_info = case_when(Treatment_new == 3 ~ 1, TRUE~0))
+
+table(database$Dummy_Treated)
+table(database$Dummy_Vol_Treated)
+table(database$Dummy_no_info)
+
+#initialize model
+
+apollo_initialise()
+
+
+### Set core controls
+apollo_control = list(
+ modelName = "MXL_wtp_Case_D",
+ modelDescr = "MXL wtp space Case D",
+ indivID ="id",
+ mixing = TRUE,
+ HB= FALSE,
+ nCores = n_cores,
+ outputDirectory = "Estimation_results/mxl"
+)
+
+##### Define model parameters depending on your attributes and model specification! ####
+# set values to 0 for conditional logit model
+
+apollo_beta=c(mu_natural = 15,
+ mu_walking = -1,
+ mu_rent = -2,
+ ASC_sq = 0,
+ mu_ASC_sq_treated = 0,
+ mu_ASC_sq_vol_treated = 0,
+ mu_ASC_sq_no_info = 0,
+ mu_rent_treated = 0,
+ mu_rent_vol_treated = 0,
+ mu_rent_no_info = 0,
+ mu_nat_treated =0,
+ mu_nat_vol_treated = 0,
+ mu_nat_no_info = 0,
+ mu_walking_treated =0,
+ mu_walking_vol_treated = 0,
+ mu_walking_no_info = 0,
+ sig_natural = 15,
+ sig_walking = 2,
+ sig_rent = 2,
+ sig_ASC_sq = 2)
+
+### specify parameters that should be kept fixed, here = none
+apollo_fixed = c()
+
+### Set parameters for generating draws, use 2000 sobol draws
+apollo_draws = list(
+ interDrawsType = "sobol",
+ interNDraws = n_draws,
+ interUnifDraws = c(),
+ interNormDraws = c("draws_natural", "draws_walking", "draws_rent", "draws_asc"),
+ intraDrawsType = "halton",
+ intraNDraws = 0,
+ intraUnifDraws = c(),
+ intraNormDraws = c()
+)
+
+### Create random parameters, define distribution of the parameters
+apollo_randCoeff = function(apollo_beta, apollo_inputs){
+ randcoeff = list()
+
+ randcoeff[["b_mu_natural"]] = mu_natural + sig_natural * draws_natural
+ randcoeff[["b_mu_walking"]] = mu_walking + sig_walking * draws_walking
+ randcoeff[["b_mu_rent"]] = -exp(mu_rent + sig_rent * draws_rent)
+ randcoeff[["b_ASC_sq"]] = ASC_sq + sig_ASC_sq * draws_asc
+
+ return(randcoeff)
+}
+
+
+### validate
+apollo_inputs = apollo_validateInputs()
+apollo_probabilities=function(apollo_beta, apollo_inputs, functionality="estimate"){
+
+ ### Function initialisation: do not change the following three commands
+ ### Attach inputs and detach after function exit
+ apollo_attach(apollo_beta, apollo_inputs)
+ on.exit(apollo_detach(apollo_beta, apollo_inputs))
+
+ ### Create list of probabilities P
+ P = list()
+
+ #### List of utilities (later integrated in mnl_settings below) ####
+ # Define utility functions here:
+
+ V = list()
+ V[['alt1']] = -(b_mu_rent + mu_rent_treated *Dummy_Treated + mu_rent_vol_treated * Dummy_Vol_Treated + mu_rent_no_info * Dummy_no_info)*(b_mu_natural * Naturalness_1 + b_mu_walking * WalkingDistance_1 +
+ + mu_nat_treated * Naturalness_1 *Dummy_Treated + mu_nat_no_info * Naturalness_1 * Dummy_no_info
+ + mu_nat_vol_treated * Naturalness_1 * Dummy_Vol_Treated
+ + mu_walking_treated * WalkingDistance_1 *Dummy_Treated + mu_walking_no_info * WalkingDistance_1 * Dummy_no_info
+ + mu_walking_vol_treated * WalkingDistance_1 * Dummy_Vol_Treated - Rent_1)
+
+ V[['alt2']] = -(b_mu_rent + mu_rent_treated *Dummy_Treated + mu_rent_vol_treated * Dummy_Vol_Treated + mu_rent_no_info * Dummy_no_info)*(b_mu_natural * Naturalness_2 + b_mu_walking * WalkingDistance_2
+ + mu_nat_treated * Naturalness_2 *Dummy_Treated + mu_nat_no_info * Naturalness_2 * Dummy_no_info
+ + mu_nat_vol_treated * Naturalness_2 * Dummy_Vol_Treated
+ + mu_walking_treated * WalkingDistance_2 *Dummy_Treated + mu_walking_no_info * WalkingDistance_2 * Dummy_no_info
+ + mu_walking_vol_treated * WalkingDistance_2 * Dummy_Vol_Treated- Rent_2)
+
+ V[['alt3']] = -(b_mu_rent + mu_rent_treated *Dummy_Treated + mu_rent_vol_treated * Dummy_Vol_Treated + mu_rent_no_info * Dummy_no_info)*(b_ASC_sq + b_mu_natural * Naturalness_3 + b_mu_walking * WalkingDistance_3
+ + mu_nat_treated * Naturalness_3 *Dummy_Treated + mu_nat_no_info * Naturalness_3 * Dummy_no_info
+ + mu_nat_vol_treated * Naturalness_3 * Dummy_Vol_Treated
+ + mu_walking_treated * WalkingDistance_3 *Dummy_Treated + mu_walking_no_info * WalkingDistance_3 * Dummy_no_info
+ + mu_walking_vol_treated * WalkingDistance_3 * Dummy_Vol_Treated
+ + mu_ASC_sq_treated * Dummy_Treated + mu_ASC_sq_vol_treated * Dummy_Vol_Treated
+ + mu_ASC_sq_no_info * Dummy_no_info - Rent_3)
+
+
+ ### Define settings for MNL model component
+ mnl_settings = list(
+ alternatives = c(alt1=1, alt2=2, alt3=3),
+ avail = 1, # all alternatives are available in every choice
+ choiceVar = choice,
+ V = V#, # tell function to use list vector defined above
+
+ )
+
+ ### Compute probabilities using MNL model
+ P[['model']] = apollo_mnl(mnl_settings, functionality)
+
+ ### Take product across observation for same individual
+ P = apollo_panelProd(P, apollo_inputs, functionality)
+
+ ### Average across inter-individual draws - nur bei Mixed Logit!
+ P = apollo_avgInterDraws(P, apollo_inputs, functionality)
+
+ ### Prepare and return outputs of function
+ P = apollo_prepareProb(P, apollo_inputs, functionality)
+ return(P)
+}
+
+
+
+# ################################################################# #
+#### MODEL ESTIMATION ##
+# ################################################################# #
+# estimate model with bfgs algorithm
+
+mxl_wtp_case_c = apollo_estimate(apollo_beta, apollo_fixed,
+ apollo_probabilities, apollo_inputs,
+ estimate_settings=list(maxIterations=400,
+ estimationRoutine="bfgs",
+ hessianRoutine="analytic"))
+
+
+
+# ################################################################# #
+#### MODEL OUTPUTS ##
+# ################################################################# #
+apollo_saveOutput(mxl_wtp_case_c)
+
+
diff --git a/Scripts/ols/ols_consequentiality.R b/Scripts/ols/ols_consequentiality.R
index 446c328..7f89ba5 100644
--- a/Scripts/ols/ols_consequentiality.R
+++ b/Scripts/ols/ols_consequentiality.R
@@ -26,3 +26,10 @@ summary(conseq_model_C)
conseq_model_control_C <- lm(Conseq_score ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
summary(conseq_model_control_C)
+
+
+conseq_model_D <- lm(Conseq_score ~ as.factor(Treatment_D), data)
+summary(conseq_model_D)
+
+conseq_model_control_D <- lm(Conseq_score ~ as.factor(Treatment_D) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(conseq_model_control_D)
diff --git a/Scripts/ols/ols_nr.R b/Scripts/ols/ols_nr.R
index 274e610..85d4145 100644
--- a/Scripts/ols/ols_nr.R
+++ b/Scripts/ols/ols_nr.R
@@ -3,7 +3,9 @@
data$Treatment_C <- as.factor(data$Treatment_C)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
+data$Treatment_D <- as.factor(data$Treatment_D)
+data$Treatment_D <- relevel(data$Treatment_D, ref = "No Treatment 3")
nr_model <- lm(Z_Mean_NR ~ Age_mean + Uni_degree + Kids_Dummy + Gender_female+ Rent_SQ +
Naturalness_SQ + WalkingDistance_SQ , data)
diff --git a/Scripts/ols/ols_opt_out.R b/Scripts/ols/ols_opt_out.R
index 9c2357f..74784e9 100644
--- a/Scripts/ols/ols_opt_out.R
+++ b/Scripts/ols/ols_opt_out.R
@@ -6,7 +6,9 @@ data <- database_full %>%
data$Treatment_C <- as.factor(data$Treatment_C)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
+data$Treatment_D <- as.factor(data$Treatment_D)
+data$Treatment_D <- relevel(data$Treatment_D, ref = "No Treatment 3")
ols_opt_out_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) ,data)
summary(ols_opt_out_A)
ols_opt_out_control_A<- lm( count_choosen_3 ~ as.factor(Treatment_A) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
@@ -20,6 +22,11 @@ ols_opt_out_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) ,data)
summary(ols_opt_out_C)
ols_opt_out_control_C<- lm( count_choosen_3 ~ as.factor(Treatment_C) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
summary(ols_opt_out_control_C)
+ols_opt_out_D<- lm( count_choosen_3 ~ as.factor(Treatment_D) ,data)
+summary(ols_opt_out_D)
+ols_opt_out_control_D<- lm( count_choosen_3 ~ as.factor(Treatment_D) + Z_Mean_NR + QFIncome + as.factor(Gender)+Age_mean+Uni_degree,data)
+summary(ols_opt_out_control_D)
+
# Obtain predicted values
predictions <- predict(ols_opt_out_control_C, data, se.fit = TRUE)
diff --git a/Scripts/ols/ols_quiz.R b/Scripts/ols/ols_quiz.R
index d80f763..489286f 100644
--- a/Scripts/ols/ols_quiz.R
+++ b/Scripts/ols/ols_quiz.R
@@ -1,8 +1,9 @@
quiz_data$Treatment_C <- as.factor(quiz_data$Treatment_C)
+quiz_data$Treatment_D <- as.factor(quiz_data$Treatment_D)
quiz_data$Treatment_C <- relevel(quiz_data$Treatment_C, ref = "No Treatment 3")
-
+quiz_data$Treatment_D <- relevel(quiz_data$Treatment_D, ref = "No Treatment 3")
ols_percentage_correct_A<- lm( percentage_correct ~ as.factor(Treatment_A) ,quiz_data)
summary(ols_percentage_correct_A)
@@ -21,6 +22,11 @@ summary(ols_percentage_correct_control_C)
vif(ols_percentage_correct_control_C)
+
+ols_percentage_correct_D<- lm( percentage_correct ~ as.factor(Treatment_D) ,quiz_data)
+summary(ols_percentage_correct_D)
+ols_percentage_correct_control_D<- lm( percentage_correct ~ as.factor(Treatment_D) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,quiz_data)
+summary(ols_percentage_correct_control_D)
#
# # Create an HTML results table with customized names and stars
# results_table_3 <- stargazer(
diff --git a/Scripts/ols/ols_time_spent.R b/Scripts/ols/ols_time_spent.R
index a9afc04..71dba63 100644
--- a/Scripts/ols/ols_time_spent.R
+++ b/Scripts/ols/ols_time_spent.R
@@ -7,9 +7,9 @@ data <- database_full %>%
data$Treatment_C <- as.factor(data$Treatment_C)
-
+data$Treatment_D <- as.factor(data$Treatment_D)
data$Treatment_C <- relevel(data$Treatment_C, ref = "No Treatment 3")
-
+data$Treatment_D <- relevel(data$Treatment_D, ref = "No Treatment 3")
ols_time_spent_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) ,data)
summary(ols_time_spent_A)
ols_time_spent_control_A<- lm( interviewtime_net_clean ~ as.factor(Treatment_A) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
@@ -23,7 +23,10 @@ ols_time_spent_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) ,data)
summary(ols_time_spent_C)
ols_time_spent_control_C<- lm( interviewtime_net_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
summary(ols_time_spent_control_C)
-
+ols_time_spent_D<- lm( interviewtime_net_clean ~ as.factor(Treatment_D) ,data)
+summary(ols_time_spent_D)
+ols_time_spent_control_D<- lm( interviewtime_net_clean ~ as.factor(Treatment_D) + Z_Mean_NR + as.factor(Gender)+Age_mean+ QFIncome + Uni_degree,data)
+summary(ols_time_spent_control_D)
ols_time_cc_A<- lm( CC_time_mean_clean ~ as.factor(Treatment_A) ,data)
summary(ols_time_cc_A)
@@ -38,6 +41,10 @@ ols_time_cc_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) ,data)
summary(ols_time_cc_C)
ols_time_cc_control_C<- lm( CC_time_mean_clean ~ as.factor(Treatment_C) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
summary(ols_time_cc_control_C)
+ols_time_cc_D<- lm( CC_time_mean_clean ~ as.factor(Treatment_D) ,data)
+summary(ols_time_cc_D)
+ols_time_cc_control_D<- lm( CC_time_mean_clean ~ as.factor(Treatment_D) + Z_Mean_NR + as.factor(Gender)+Age_mean + QFIncome +Uni_degree,data)
+summary(ols_time_cc_control_D)
# # Create an HTML results table with customized names and stars
# results_table_5 <- stargazer(
# ols_tme_spent_1, ols_tme_spent_control_1,
diff --git a/Scripts/treatment.R b/Scripts/treatment.R
index acec3c3..0d86be9 100644
--- a/Scripts/treatment.R
+++ b/Scripts/treatment.R
@@ -109,12 +109,25 @@ database_full <- database_full %>% mutate(groupTime1774 = case_when(is.na(groupT
mutate(interviewtime_net = interviewtime - groupTime1774 - groupTime1784 - groupTime1775 - groupTime1785- groupTime1786 )
# Calculate the cutoff values for the lowest and highest 1 percent
lower_cutoff <- quantile(database_full$interviewtime_net, 0.01)
-upper_cutoff <- quantile(database_full$interviewtime_net, 0.99)
+upper_cutoff <- quantile(database_full$interviewtime_net, 0.95)
# Filter the data to keep only values within the specified range
database_full <- database_full %>%
mutate(interviewtime_net_clean = ifelse(between(interviewtime_net, lower_cutoff, upper_cutoff), interviewtime_net, NA))
+# Assuming 'database' is your data frame
+video2_data <- subset(database_full, Treatment_C == "Video 2")
+
+# Summary statistics for interview time in 'Video 2' cases
+summary(video2_data$interviewtime_net_clean)
+# Assuming 'database' is your data frame
+sorted_database <- video2_data[order(video2_data$interviewtime_net_clean, decreasing = F), ]
+
+# Display the ten highest values of interview time
+top_10_highest <- tail(sorted_database$interviewtime_net_clean, 200)
+print(top_10_highest)
+
+
bxplt_interview_time_A<-ggplot(data=database_full[!is.na(database_full$Treatment_A), ]) +
geom_boxplot(aes(y=interviewtime_net_clean, x= Treatment_A, group=Treatment_A, fill=Treatment_A), outlier.shape = NA) +
coord_cartesian(ylim = c(500, 2900)) +
--
GitLab