### 0. Setting up environment

#Downloading packages
library(haven)
library(tidyverse)
library(dplyr)
library(readxl)
library(ggplot2)
#set working directory
setwd("C:/Users/66811ldv/OneDrive - Erasmus University Rotterdam/Documents/1. WTP/EUR Data Repository subm/R-code/Analyses WTP questionnaire")


### 1. Preparing dataset/data summary        

# Loading data (from merged dataset, includes 4 sub-versions)
library(readxl)
version1_4 <- read_excel("C:/Users/66811ldv/OneDrive - Erasmus University Rotterdam/Documents/1. WTP/EUR Data Repository subm/Data/Merged dataset (raw subversions combined in one dataset).xlsx")

#calculate new variables counting the number of elements included in the tasks
version1_4$n.elements_considered <- version1_4$EL_productivity + version1_4$EL_spending + version1_4$EL_UoC +  version1_4$EL_leisure
version1_4$n.elements_considered <- as.factor(version1_4$n.elements_considered)
summary(version1_4$n.elements_considered)

#calculate new variables counting number of elements included - excluding UoC
version1_4$n.elements_considered_v2 <- version1_4$EL_productivity + version1_4$EL_spending +  version1_4$EL_leisure
version1_4$n.elements_considered_v2 <- as.factor(version1_4$n.elements_considered_v2)
summary(version1_4$n.elements_considered_v2)

##tell r which variables are categorical
#descriptives
version1_4$Gender <- as.factor(version1_4$Gender)
version1_4$Age_cat <- as.factor(version1_4$Age_cat)
version1_4$Children <- as.factor(version1_4$Children)
version1_4$Marital_stat <- as.factor(version1_4$Marital_stat)
version1_4$Make_ends <- as.factor(version1_4$Make_ends)
#version1_4$Education <- as.factor(version1_4$Education)
version1_4$Employment <- as.factor(version1_4$Employment)
version1_4$Religion <- as.factor(version1_4$Religion)
version1_4$Rel_importance <- as.factor(version1_4$Rel_importance)

#reason wtp of 0
version1_4$Llow_zero <- as.factor(version1_4$Llow_zero)
version1_4$Lmed_zero <- as.factor(version1_4$Lmed_zero)
version1_4$Lhigh_zero <- as.factor(version1_4$Lhigh_zero)
version1_4$Qlow_zero <- as.factor(version1_4$Qlow_zero)
version1_4$Qmed_zero <- as.factor(version1_4$Qmed_zero)
version1_4$Qhigh_zero <- as.factor(version1_4$Qhigh_zero)
version1_4$Version <- as.factor(version1_4$Version)

#elements considered
version1_4$EL_leisure <- as.factor(version1_4$EL_leisure)
version1_4$EL_productivity <- as.factor(version1_4$EL_productivity)
version1_4$EL_spending <- as.factor(version1_4$EL_spending)
version1_4$EL_UoC <- as.factor(version1_4$EL_UoC)
version1_4$EL_no <- as.factor(version1_4$EL_no)

#expectations elements considered change LL
version1_4$EL_leisure_L <- as.factor(version1_4$EL_leisure_L)
version1_4$EL_productivity_L <- as.factor(version1_4$EL_productivity_L)
version1_4$EL_spending_L <- as.factor(version1_4$EL_spending_L)
version1_4$EL_UoC_L <- as.factor(version1_4$EL_UoC_L)

#expectations elements considered change QoL
version1_4$EL_leisure_Q <- as.factor(version1_4$EL_leisure_Q)
version1_4$EL_productivity_Q <- as.factor(version1_4$EL_productivity_Q)
version1_4$EL_spending_Q <- as.factor(version1_4$EL_spending_Q)
version1_4$EL_UoC_Q <- as.factor(version1_4$EL_UoC_Q)

#reason not considering elements
version1_4$EL_leisure_no <- as.factor(version1_4$EL_leisure_no)
version1_4$EL_productivity_no <- as.factor(version1_4$EL_productivity_no)
version1_4$EL_spending_no <- as.factor(version1_4$EL_spending_no)
version1_4$EL_UoC_no <- as.factor(version1_4$EL_UoC_no)

#impact elements
version1_4$EL_leisure_impact <- as.factor(version1_4$EL_leisure_impact)
version1_4$EL_productivity_impact <- as.factor(version1_4$EL_productivity_impact)
version1_4$EL_spending_impact <- as.factor(version1_4$EL_spending_impact)
version1_4$EL_UoC_impact <- as.factor(version1_4$EL_UoC_impact)

#changes in spending
version1_4$EL_spending_Q_cat1 <- as.factor(version1_4$EL_spending_Q_cat1)
version1_4$EL_spending_Q_cat2 <- as.factor(version1_4$EL_spending_Q_cat2)
version1_4$EL_spending_Q_cat3 <- as.factor(version1_4$EL_spending_Q_cat3)
version1_4$EL_spending_Q_cat4 <- as.factor(version1_4$EL_spending_Q_cat4)
version1_4$EL_spending_Q_cat5 <- as.factor(version1_4$EL_spending_Q_cat5)
version1_4$EL_spending_Q_cat6 <- as.factor(version1_4$EL_spending_Q_cat6)
version1_4$EL_spending_Q_cat7 <- as.factor(version1_4$EL_spending_Q_cat7)
version1_4$EL_spending_Q_cat8 <- as.factor(version1_4$EL_spending_Q_cat8)
version1_4$EL_spending_Q_cat9 <- as.factor(version1_4$EL_spending_Q_cat9)

version1_4$EL_spending_Q_change_cat1 <- as.factor(version1_4$EL_spending_Q_change_cat1)
version1_4$EL_spending_Q_change_cat2 <- as.factor(version1_4$EL_spending_Q_change_cat2)
version1_4$EL_spending_Q_change_cat3 <- as.factor(version1_4$EL_spending_Q_change_cat3)
version1_4$EL_spending_Q_change_cat4 <- as.factor(version1_4$EL_spending_Q_change_cat4)
version1_4$EL_spending_Q_change_cat5 <- as.factor(version1_4$EL_spending_Q_change_cat5)
version1_4$EL_spending_Q_change_cat6 <- as.factor(version1_4$EL_spending_Q_change_cat6)
version1_4$EL_spending_Q_change_cat7 <- as.factor(version1_4$EL_spending_Q_change_cat7)
version1_4$EL_spending_Q_change_cat8 <- as.factor(version1_4$EL_spending_Q_change_cat8)
version1_4$EL_spending_Q_change_cat9 <- as.factor(version1_4$EL_spending_Q_change_cat9)

version1_4$EL_spending_L_cat1 <- as.factor(version1_4$EL_spending_L_cat1)
version1_4$EL_spending_L_cat2 <- as.factor(version1_4$EL_spending_L_cat2)
version1_4$EL_spending_L_cat3 <- as.factor(version1_4$EL_spending_L_cat3)
version1_4$EL_spending_L_cat4 <- as.factor(version1_4$EL_spending_L_cat4)
version1_4$EL_spending_L_cat5 <- as.factor(version1_4$EL_spending_L_cat5)
version1_4$EL_spending_L_cat6 <- as.factor(version1_4$EL_spending_L_cat6)
version1_4$EL_spending_L_cat7 <- as.factor(version1_4$EL_spending_L_cat7)
version1_4$EL_spending_L_cat8 <- as.factor(version1_4$EL_spending_L_cat8)
version1_4$EL_spending_L_cat9 <- as.factor(version1_4$EL_spending_L_cat9)

version1_4$EL_spending_L_change_cat1 <- as.factor(version1_4$EL_spending_L_change_cat1)
version1_4$EL_spending_L_change_cat2 <- as.factor(version1_4$EL_spending_L_change_cat2)
version1_4$EL_spending_L_change_cat3 <- as.factor(version1_4$EL_spending_L_change_cat3)
version1_4$EL_spending_L_change_cat4 <- as.factor(version1_4$EL_spending_L_change_cat4)
version1_4$EL_spending_L_change_cat5 <- as.factor(version1_4$EL_spending_L_change_cat5)
version1_4$EL_spending_L_change_cat6 <- as.factor(version1_4$EL_spending_L_change_cat6)
version1_4$EL_spending_L_change_cat7 <- as.factor(version1_4$EL_spending_L_change_cat7)
version1_4$EL_spending_L_change_cat8 <- as.factor(version1_4$EL_spending_L_change_cat8)
version1_4$EL_spending_L_change_cat9 <- as.factor(version1_4$EL_spending_L_change_cat9)

##computing new variables
#WTP per QALY per year (*4*12=*48)
version1_4$wtp_Llow <- version1_4$Llow*48
version1_4$wtp_Lmed <- version1_4$Lmed*48
version1_4$wtp_Lhigh <- version1_4$Lhigh*48
version1_4$wtp_Qlow <- version1_4$Qlow*48
version1_4$wtp_Qmed <- version1_4$Qmed*48
version1_4$wtp_Qhigh <- version1_4$Qhigh*48

#completion time in minutes
version1_4$completion_minutes <- version1_4$Length_seconds/60

##creating general subsets data
#subset variables describing respondents
descriptives <- select(version1_4, ID, QoL, UoC, Gender, Age:Children_n, Householdsize, Marital_stat, Net_hh_income, Make_ends, Education, Edu_other, Employment, Emp_other, Religion, Rel_other, Rel_importance, Length_seconds,completion_minutes, Version)
#subset WTP questions
WTP <- select(version1_4, Lhigh:Lmed_zero_other, Qhigh:Qmed_zero_other, wtp_Llow:wtp_Qhigh, ID, Version)
#subset utilities
utilities <- select(version1_4, ID, QoL, UoC:UoC_M_100, Version)
#subset follow up questions on elements considered
follow_up <- select(version1_4, ID, EL_leisure:EL_UoC_Q_other, EL_no, E_I_change_LL, Spec_E_I_change_LL, Higher_E_I_LL, Lower_E_I_LL, No_E_I_change_LL, Other_E_I_LL, E_I_change_QoL, Spec_E_I_change_Qol, Higher_E_I_Qol, Lower_E_I_Qol, No_E_I_change_QoL, Other_E_I_Qol, Version)
#subset questions to evaluate the questionnaire
evaluation <- select(version1_4, ID, EV_certainty:EV_WTP, Version)
#subset specific WTPs
WTPspec <- select(WTP, ID, Llow, Lmed, Lhigh, Qlow, Qmed, Qhigh, wtp_Llow:wtp_Qhigh, Version) 

#subset variables to determine exclusion criteria
exclusion <- select(version1_4, ID, Net_hh_income, Length_seconds, completion_minutes, Llow, Lmed, Lhigh, Qlow, Qmed, Qhigh, wtp_Llow:wtp_Qhigh, Llow_zero, Lmed_zero, Lhigh_zero, Qlow_zero, Qmed_zero, Qhigh_zero, Llow_zero_other, Lmed_zero_other, Lhigh_zero_other, Qlow_zero_other, Qmed_zero_other, Qhigh_zero_other, Version )

##creating subsets with most relevant data
sub_WTPspec <- select(version1_4, ID, wtp_Llow:wtp_Qhigh, Version)
sub_follow_up <- select(version1_4, ID, EL_leisure, EL_productivity, EL_spending, EL_UoC, EL_no, Version)
wtp_el <- select(version1_4, ID, wtp_Llow:wtp_Qhigh, EL_leisure, EL_productivity, EL_spending, EL_UoC, EL_no, Version)

##generating summaries subsets
summary(descriptives)
summary(WTP) 
summary(utilities) 
summary(follow_up) 
summary(evaluation) 
summary(WTPspec) 
summary(exclusion)
summary(sub_WTPspec)
summary(sub_follow_up)

##summaries by group
tapply(wtp_el$wtp_Qlow, wtp_el$Version, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$Version, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$Version, summary)
tapply(wtp_el$wtp_Llow, wtp_el$Version, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$Version, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$Version, summary)

#WTP with and without UoC
tapply(wtp_el$wtp_Qlow, wtp_el$EL_UoC, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$EL_UoC, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$EL_UoC, summary)
tapply(wtp_el$wtp_Llow, wtp_el$EL_UoC, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$EL_UoC, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$EL_UoC, summary)

#WTP with and without leisure
tapply(wtp_el$wtp_Qlow, wtp_el$EL_leisure, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$EL_leisure, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$EL_leisure, summary)
tapply(wtp_el$wtp_Llow, wtp_el$EL_leisure, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$EL_leisure, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$EL_leisure, summary)

#WTP with and without productivity
tapply(wtp_el$wtp_Qlow, wtp_el$EL_productivity, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$EL_productivity, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$EL_productivity, summary)
tapply(wtp_el$wtp_Llow, wtp_el$EL_productivity, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$EL_productivity, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$EL_productivity, summary)

#WTP with and without spending
tapply(wtp_el$wtp_Qlow, wtp_el$EL_spending, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$EL_spending, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$EL_spending, summary)
tapply(wtp_el$wtp_Llow, wtp_el$EL_spending, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$EL_spending, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$EL_spending, summary)

#WTP with and without no elements considered
tapply(wtp_el$wtp_Qlow, wtp_el$EL_no, summary)
tapply(wtp_el$wtp_Qmed, wtp_el$EL_no, summary)
tapply(wtp_el$wtp_Qhigh, wtp_el$EL_no, summary)
tapply(wtp_el$wtp_Llow, wtp_el$EL_no, summary)
tapply(wtp_el$wtp_Lmed, wtp_el$EL_no, summary)
tapply(wtp_el$wtp_Lhigh, wtp_el$EL_no, summary)

##summary expectations about elements considered
#UoC - living longer and lower QoL
TuocL <- table(version1_4$EL_UoC_L)
addmargins(TuocL)
prop.table(TuocL)

TuocQ <- table(version1_4$EL_UoC_Q)
addmargins(TuocQ)
prop.table(TuocQ)

#Leisure - living longer and lower QoL
TleisureL <- table(version1_4$EL_leisure_L)
addmargins(TleisureL)
prop.table(TleisureL)

TleisureQ <- table(version1_4$EL_leisure_Q)
addmargins(TleisureQ)
prop.table(TleisureQ)

#Productivity - living longer and lower QoL
TproductivityL <- table(version1_4$EL_productivity_L)
addmargins(TproductivityL)
prop.table(TproductivityL)

TproductivityQ <- table(version1_4$EL_productivity_Q)
addmargins(TproductivityQ)
prop.table(TproductivityQ)

#Spending - living longer and lower QoL
TspendingL <- table(version1_4$EL_spending_L)
addmargins(TspendingL)
prop.table(TspendingL)

TspendingQ <- table(version1_4$EL_spending_Q)
addmargins(TspendingQ)
prop.table(TspendingQ)

#%gender
Tgender <- table(version1_4$Gender)
addmargins(Tgender)
prop.table(Tgender)

#standard dev
sd(sub_WTPspec$wtp_Llow, na.rm=TRUE)
sd(sub_WTPspec$wtp_Lmed, na.rm=TRUE)
sd(sub_WTPspec$wtp_Lhigh, na.rm=TRUE)
sd(sub_WTPspec$wtp_Qlow, na.rm=TRUE)
sd(sub_WTPspec$wtp_Qmed, na.rm=TRUE)
sd(sub_WTPspec$wtp_Qhigh, na.rm=TRUE)

#elements considered by version
tapply(version1_4$n.elements_considered_v2, version1_4$Version, summary)



### 2. Exclusion based on predefined criteria

###Create new variables for conditions exclusion

##Completion time --> define 'speeders' based on criterium of <9 minutes
version1_4$speeder <- ifelse(version1_4$completion_minutes<9, 1, 0)

##Zero's--> define 'protest' based on criterium of answer option 4 and 6n for WTP '0'
#WTP Qlow 
version1_4$Qlow.protest4 <- ifelse(version1_4$Qlow_zero == 4, 1, 0)
version1_4$Qlow.protest6 <- ifelse(version1_4$Qlow_zero == 6, 1, 0)
version1_4$Qlow.protest <- version1_4$Qlow.protest4 + version1_4$Qlow.protest6
#WTP Qmed
version1_4$Qmed.protest4 <- ifelse(version1_4$Qmed_zero == 4, 1, 0)
version1_4$Qmed.protest6 <- ifelse(version1_4$Qmed_zero == 6, 1, 0)
version1_4$Qmed.protest <- version1_4$Qmed.protest4 + version1_4$Qmed.protest6
#WTP Qhigh
version1_4$Qhigh.protest4 <- ifelse(version1_4$Qhigh_zero == 4, 1, 0)
version1_4$Qhigh.protest6 <- ifelse(version1_4$Qhigh_zero == 6, 1, 0)
version1_4$Qhigh.protest <- version1_4$Qhigh.protest4 + version1_4$Qhigh.protest6
#WTP Llow
version1_4$Llow.protest4 <- ifelse(version1_4$Llow_zero == 4, 1, 0)
version1_4$Llow.protest6 <- ifelse(version1_4$Llow_zero == 6, 1, 0)
version1_4$Llow.protest <- version1_4$Llow.protest4 + version1_4$Llow.protest6
#WTP Lmed
version1_4$Lmed.protest4 <- ifelse(version1_4$Lmed_zero == 4, 1, 0)
version1_4$Lmed.protest6 <- ifelse(version1_4$Lmed_zero == 6, 1, 0)
version1_4$Lmed.protest <- version1_4$Lmed.protest4 + version1_4$Lmed.protest6
#WTP Lhigh
version1_4$Lhigh.protest4 <- ifelse(version1_4$Lhigh_zero == 4, 1, 0)
version1_4$Lhigh.protest6 <- ifelse(version1_4$Lhigh_zero == 6, 1, 0)
version1_4$Lhigh.protest <- version1_4$Lhigh.protest4 + version1_4$Lhigh.protest6

##Count of fulfilling exclusion criteria per respondent
#NA as 0
version1_4 <- mutate_at(version1_4, c("Qlow.protest", "Qmed.protest", "Qhigh.protest","Llow.protest", "Lmed.protest", "Lhigh.protest", "speeder"), ~replace(., is.na(.), 0))

#number of protests
version1_4$n.protest <- version1_4$Qlow.protest + version1_4$Qmed.protest + version1_4$Qhigh.protest + version1_4$Llow.protest + version1_4$Lmed.protest + version1_4$Lhigh.protest

#total of exclusion criteria
version1_4$n.exclusion <- version1_4$n.protest + version1_4$speeder

#exclude yes(1) or no(0) --> yes if one or more of the exclusion criteria is met
version1_4$exclude <- ifelse(version1_4$n.exclusion <1, 0, 1)

##variables as factor
version1_4$speeder <- as.factor(version1_4$speeder)

version1_4$Qlow.protest <- as.factor(version1_4$Qlow.protest)
version1_4$Qmed.protest <- as.factor(version1_4$Qmed.protest)
version1_4$Qhigh.protest <- as.factor(version1_4$Qhigh.protest)
version1_4$Llow.protest <- as.factor(version1_4$Llow.protest)
version1_4$Lmed.protest <- as.factor(version1_4$Lmed.protest)
version1_4$Lhigh.protest <- as.factor(version1_4$Lhigh.protest)

version1_4$n.exclusion <- as.factor(version1_4$n.exclusion)
version1_4$n.protest <- as.factor(version1_4$n.protest)

version1_4$exclude <-as.factor(version1_4$exclude)

#income (<2000, 2000-3999, >3999)
version1_4$low.inc <- ifelse(version1_4$Net_hh_income <2000, 1, 0)
version1_4$high.inc <- ifelse(version1_4$Net_hh_income >3999, 1, 0)
version1_4$low_high.inc <- version1_4$low.inc+version1_4$high.inc
version1_4$med.inc <- ifelse(version1_4$low_high.inc <1, 1, 0)

version1_4$low.inc <- as.factor(version1_4$low.inc)
version1_4$high.inc <- as.factor(version1_4$high.inc)
version1_4$med.inc <- as.factor(version1_4$med.inc)

##Dataframe combining exclusion criteria variables
exclusion.criteria  <- select(version1_4, ID, exclude, n.exclusion, n.protest, speeder, Qlow.protest, Qmed.protest, Qhigh.protest, Llow.protest, Lmed.protest, Lhigh.protest, Version)
summary(exclusion.criteria)

tapply(version1_4$exclude, version1_4$Version, summary)
tapply(version1_4$n.exclusion, version1_4$Version, summary)
tapply(version1_4$speeder, version1_4$Version, summary)

## add exclusion variable to subset variables describing respondents
descriptives <- select(version1_4, ID, exclude, QoL, UoC, Gender, Age:Children_n, Householdsize, Marital_stat, Net_hh_income, Make_ends, Education, Edu_other, Employment, Emp_other, Religion, Rel_other, Rel_importance, Length_seconds,completion_minutes, Version)
summary(descriptives)

##descriptives sample after exclusion
tapply(version1_4$Age, version1_4$exclude, summary)
tapply(version1_4$Gender, version1_4$exclude, summary)
tapply(version1_4$Children, version1_4$exclude, summary)
tapply(version1_4$Net_hh_income, version1_4$exclude, summary)
tapply(version1_4$QoL, version1_4$exclude, summary)
tapply(version1_4$UoC, version1_4$exclude, summary)
tapply(version1_4$completion_minutes, version1_4$exclude, summary)
tapply(version1_4$Education, version1_4$exclude, summary)

tapply(version1_4$low.inc, version1_4$exclude, summary)
tapply(version1_4$med.inc, version1_4$exclude, summary)
tapply(version1_4$high.inc, version1_4$exclude, summary)

tapply(version1_4$Age, version1_4$exclude, sd)
tapply(version1_4$Net_hh_income, version1_4$exclude, sd)
tapply(version1_4$QoL, version1_4$exclude, sd)
tapply(version1_4$UoC, version1_4$exclude, sd)
tapply(version1_4$completion_minutes, version1_4$exclude, sd)

#Create a copy of the dataset
write.csv2(version1_4,'fulldata.csv')

#create a copy of the dataset excluding those to exclude based on criteria
data_excl <-subset(version1_4, exclude!=1)
write.csv2(data_excl,'data_after_exclusion.csv')

summary(data_excl)
summary(data_excl$Education)

#summary data by version based on dataset after exclusion (=data_excl)

##descriptives sample after exclusion
tapply(data_excl$Age, data_excl$Version, summary)
tapply(data_excl$Gender, data_excl$Version, summary)
tapply(data_excl$Children, data_excl$Version, summary)
tapply(data_excl$Net_hh_income, data_excl$Version, summary)
tapply(data_excl$QoL, data_excl$Version, summary)
tapply(data_excl$UoC, data_excl$Version, summary)
tapply(data_excl$completion_minutes, data_excl$Version, summary)
tapply(data_excl$Education, data_excl$Version, summary)

tapply(data_excl$low.inc, data_excl$Version, summary)
tapply(data_excl$med.inc, data_excl$Version, summary)
tapply(data_excl$high.inc, data_excl$Version, summary)

tapply(data_excl$Age, data_excl$Version, sd)
tapply(data_excl$Net_hh_income, data_excl$Version, sd)
tapply(data_excl$QoL, data_excl$Version, sd)
tapply(data_excl$UoC, data_excl$Version, sd)
tapply(data_excl$completion_minutes, data_excl$Version, sd)

#creating variable categorizing net household income into groups: 0-1999 = low, 2000-3999 = medium, >3999 = high
data_excl$income_groups <- cut(data_excl$Net_hh_income,
                               breaks = c(-1, 1999, 3999, 100000),
                               labels=c('Low', 'Middle', 'High'))

Tincome_gr <- table(data_excl$income_groups)
addmargins(Tincome_gr)
prop.table(Tincome_gr)

#adding variable indicating subversions

data_excl$sub_version <- data_excl$Version
levels(data_excl$sub_version) <- c('1B', '1C', '1A', '2A')

#creating variable only indicating sub of subversion (A,B,C)
data_excl$sub_version_abc <- data_excl$sub_version
levels(data_excl$sub_version_abc)[levels(data_excl$sub_version_abc)=='2A'] <- 'A'
levels(data_excl$sub_version_abc)[levels(data_excl$sub_version_abc)=='1A'] <- 'A'
levels(data_excl$sub_version_abc)[levels(data_excl$sub_version_abc)=='1B'] <- 'B'
levels(data_excl$sub_version_abc)[levels(data_excl$sub_version_abc)=='1C'] <- 'C'

#reclassify variable education (low: 1-3, medium: 4-6, high 7-8, other =9)
data_excl$edu_groups <- cut(data_excl$Education,
                            breaks = c(0, 3, 6, 8, 10),
                            labels=c('Low', 'Medium', 'High', 'Other'))

Tedu_gr <- table(data_excl$edu_groups)
addmargins(Tedu_gr)
prop.table(Tedu_gr)

#creating variable indicating whether religious or not (yes=1, no=0)
data_excl$Religious <- data_excl$Religion
levels(data_excl$Religious)[levels(data_excl$Religious)=='1'] <- '0'
levels(data_excl$Religious)[levels(data_excl$Religious)=='2'] <- '1'
levels(data_excl$Religious)[levels(data_excl$Religious)=='3'] <- '1'
levels(data_excl$Religious)[levels(data_excl$Religious)=='4'] <- '1'
levels(data_excl$Religious)[levels(data_excl$Religious)=='5'] <- '1'
levels(data_excl$Religious)[levels(data_excl$Religious)=='6'] <- '1'
levels(data_excl$Religious)[levels(data_excl$Religious)=='7'] <- '1'


Treligous <- table(data_excl$Religious)
addmargins(Treligous)
prop.table(Treligous)

summary(data_excl$Religion)
Treligion <- table(data_excl$Religion)
addmargins(Treligion)
prop.table(Treligion)

#creating variable reclassifying importance of religion (1=unimportant, 2=neutral 3 important, 4=very important)
data_excl$Importance_religion <- data_excl$Rel_importance
levels(data_excl$Importance_religion)[levels(data_excl$Importance_religion)=='1'] <- '1'
levels(data_excl$Importance_religion)[levels(data_excl$Importance_religion)=='2'] <- '1'
levels(data_excl$Importance_religion)[levels(data_excl$Importance_religion)=='3'] <- '2'
levels(data_excl$Importance_religion)[levels(data_excl$Importance_religion)=='4'] <- '3'
levels(data_excl$Importance_religion)[levels(data_excl$Importance_religion)=='5'] <- '4'

summary(data_excl$Importance_religion)
Timportance_religion <- table(data_excl$Importance_religion)
addmargins(Timportance_religion)
prop.table(Timportance_religion)

#%gender
Tgender <- table(data_excl$Gender)
addmargins(Tgender)
prop.table(Tgender)

#%children
Tchildren <- table(data_excl$Children)
addmargins(Tchildren)
prop.table(Tchildren)

summary(data_excl$El_UoC)

#Stated impact of inclusion elements
Tuoc_im <- table(data_excl$EL_UoC_impact)
addmargins(Tuoc_im)
prop.table(Tuoc_im)

Tspending_im <- table(data_excl$EL_spending_impact)
addmargins(Tspending_im)
prop.table(Tspending_im)

Tproductivity_im <- table(data_excl$EL_productivity_impact)
addmargins(Tproductivity_im)
prop.table(Tproductivity_im)

Tleisure_im <- table(data_excl$EL_leisure_impact)
addmargins(Tleisure_im)
prop.table(Tleisure_im)

#props reasons not to include an element
Tuoc_no <- table(data_excl$EL_UoC_no)
addmargins(Tuoc_no)
prop.table(Tuoc_no)

Tspending_no <- table(data_excl$EL_spending_no)
addmargins(Tspending_no)
prop.table(Tspending_no)

Tproductivity_no <- table(data_excl$EL_productivity_no)
addmargins(Tproductivity_no)
prop.table(Tproductivity_no)

Tleisure_no <- table(data_excl$EL_leisure_no)
addmargins(Tleisure_no)
prop.table(Tleisure_no)


### 3. Analyses after exclusion

##Analyses for data after exclusion 
# - based on completion time (<9 minutes),
# - protests (those with a protest answer excluded)

#WTP per version
tapply(data_excl$wtp_Qlow, data_excl$Version, summary)
tapply(data_excl$wtp_Qmed, data_excl$Version, summary)
tapply(data_excl$wtp_Qhigh, data_excl$Version, summary)
tapply(data_excl$wtp_Llow, data_excl$Version, summary)
tapply(data_excl$wtp_Lmed, data_excl$Version, summary)
tapply(data_excl$wtp_Lhigh, data_excl$Version, summary)

###Summary WTP in relation to UoC considered/instruction
#WTP with and without UoC
tapply(data_excl$wtp_Qlow, data_excl$EL_UoC, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_UoC, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_UoC, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_UoC, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_UoC, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_UoC, summary)

##summary expectations about elements considered
#number of elements considered version 1 (no instruction to consider uoc)
Tn.elements <- table(data_excl$n.elements_considered)
addmargins(Tn.elements)
prop.table(Tn.elements)

#number of elements considered version 2 (instruction to consider uoc)
tapply(data_excl$n.elements_considered_v2, data_excl$Version, summary)

#UoC considered or not
Tuoc <- table(data_excl$EL_UoC)
addmargins(Tuoc)
prop.table(Tuoc)

#UoC - living longer and lower QoL
TuocL <- table(data_excl$EL_UoC_L)
addmargins(TuocL)
prop.table(TuocL)

TuocQ <- table(data_excl$EL_UoC_Q)
addmargins(TuocQ)
prop.table(TuocQ)

#means grouped by expectations when UoC is considered
#WTP including UoC -> by expectations on UoC for life-extension (1=equal, 2=lower, 3=higher, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_UoC_L, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_UoC_L, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_UoC_L, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_UoC_L, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_UoC_L, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_UoC_L, summary)

#WTP including UoC -> by expectations on UoC for lower QoL (1=equal, 2=lower, 3=higher, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_UoC_Q, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_UoC_Q, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_UoC_Q, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_UoC_Q, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_UoC_Q, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_UoC_Q, summary)

#creating variable to indicate whether people received instruction to include UoC (version 4) or not (version 1-3)
data_excl$instruction <- ifelse(data_excl$Version==4, 1, 0)
data_excl$instruction <- as.factor(data_excl$instruction)

#creating variable named 'inclusion_UoC' indicating 1. no (spontaneous) inclusion, 2. spontaneous inclusion, 3. instruction
data_excl$inclusion_UoC <- as.factor(ifelse(data_excl$instruction == 1, 3,
                                            ifelse(data_excl$EL_UoC == 1, 2, 1)))

#creating variable named 'inclusion_type_UoC' indicating 1.instructed inclusion and 2.spontaneous inclusion

#WTP with and without instruction to consider UoC
tapply(data_excl$wtp_Qlow, data_excl$instruction, summary)
tapply(data_excl$wtp_Qmed, data_excl$instruction, summary)
tapply(data_excl$wtp_Qhigh, data_excl$instruction, summary)
tapply(data_excl$wtp_Llow, data_excl$instruction, summary)
tapply(data_excl$wtp_Lmed, data_excl$instruction, summary)
tapply(data_excl$wtp_Lhigh, data_excl$instruction, summary)

#WTP by 1. no (spontaneous) inclusion, 2. spontaneous inclusion, 3. instruction
tapply(data_excl$wtp_Qlow, data_excl$inclusion_UoC, summary)
tapply(data_excl$wtp_Qmed, data_excl$inclusion_UoC, summary)
tapply(data_excl$wtp_Qhigh, data_excl$inclusion_UoC, summary)
tapply(data_excl$wtp_Llow, data_excl$inclusion_UoC, summary)
tapply(data_excl$wtp_Lmed, data_excl$inclusion_UoC, summary)
tapply(data_excl$wtp_Lhigh, data_excl$inclusion_UoC, summary)

###Summary WTP in relation to leisure considered
#WTP with and without Leisure
tapply(data_excl$wtp_Qlow, data_excl$EL_leisure, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_leisure, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_leisure, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_leisure, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_leisure, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_leisure, summary)

##summary expectations about elements considered
#Leisure considered or not
Tleisure <- table(data_excl$EL_leisure)
addmargins(Tleisure)
prop.table(Tleisure)

tapply(data_excl$EL_leisure, data_excl$instruction, summary)

#Leisure - living longer and lower QoL
TleisureL <- table(data_excl$EL_leisure_L)
addmargins(TleisureL)
prop.table(TleisureL)

TleisureQ <- table(data_excl$EL_leisure_Q)
addmargins(TleisureQ)
prop.table(TleisureQ)

#means grouped by expectations when Leisure is considered
#WTP including Leisure -> by expectations on Leisure for life-extension (1=equal, 2=less, 3=more, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_leisure_L, mean, na.rm=TRUE)
tapply(data_excl$wtp_Qmed, data_excl$EL_leisure_L, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_leisure_L, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_leisure_L, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_leisure_L, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_leisure_L, summary)

#WTP including Leisure -> by expectations on Leisure for lower QoL (1=equal, 2=less, 3=more, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_leisure_Q, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_leisure_Q, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_leisure_Q, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_leisure_Q, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_leisure_Q, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_leisure_Q, summary)

###Summary WTP in relation to productivity considered
#WTP with and without Productivity
tapply(data_excl$wtp_Qlow, data_excl$EL_productivity, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_productivity, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_productivity, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_productivity, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_productivity, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_productivity, summary)

##summary expectations about elements considered
#Productivity considered or not
Tproductivity <- table(data_excl$EL_productivity)
addmargins(Tproductivity)
prop.table(Tproductivity)

#Productivity - living longer and lower QoL
TproductivityL <- table(data_excl$EL_productivity_L)
addmargins(TproductivityL)
prop.table(TproductivityL)

TproductivityQ <- table(data_excl$EL_productivity_Q)
addmargins(TproductivityQ)
prop.table(TproductivityQ)

#means grouped by expectations when Productivity is considered
#WTP including Productivity -> by expectations on Productivity for life-extension (1=equal, 2=lower, 3=higher, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_productivity_L, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_productivity_L, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_productivity_L, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_productivity_L, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_productivity_L, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_productivity_L, summary)

#WTP including Productivity -> by expectations on Productivity for lower QoL (1=equal, 2=lower, 3=higher, 4=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_productivity_Q, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_productivity_Q, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_productivity_Q, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_productivity_Q, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_productivity_Q, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_productivity_Q, summary)

###Summary WTP in relation to spending considered
#WTP with and without Spending
tapply(data_excl$wtp_Qlow, data_excl$EL_spending, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_spending, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_spending, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_spending, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_spending, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_spending, summary)

##summary expectations about elements considered
#Spending considered or not
Tspending <- table(data_excl$EL_spending)
addmargins(Tspending)
prop.table(Tspending)

#Spending - living longer and lower QoL
TspendingL <- table(data_excl$EL_spending_L)
addmargins(TspendingL)
prop.table(TspendingL)

TspendingQ <- table(data_excl$EL_spending_Q)
addmargins(TspendingQ)
prop.table(TspendingQ)

#means grouped by expectations when Spending is considered
#WTP including Spending -> by expectations on Spending for life-extension (1=equal, 2=lower, 3=higher, 4=different, 5=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_spending_L, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_spending_L, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_spending_L, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_spending_L, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_spending_L, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_spending_L, summary)

#WTP including Spending -> by expectations on Spending for lower QoL (1=equal, 2=lower, 3=higher, 4=different, 5=other)
tapply(data_excl$wtp_Qlow, data_excl$EL_spending_Q, summary)
tapply(data_excl$wtp_Qmed, data_excl$EL_spending_Q, summary)
tapply(data_excl$wtp_Qhigh, data_excl$EL_spending_Q, summary)
tapply(data_excl$wtp_Llow, data_excl$EL_spending_Q, summary)
tapply(data_excl$wtp_Lmed, data_excl$EL_spending_Q, summary)
tapply(data_excl$wtp_Lhigh, data_excl$EL_spending_Q, summary)

##Overall means WTP
summary(data_excl$wtp_Qlow)
summary(data_excl$wtp_Qmed)
summary(data_excl$wtp_Qhigh)
summary(data_excl$wtp_Llow)
summary(data_excl$wtp_Lmed)
summary(data_excl$wtp_Lhigh)

##UoC values based on stated expectations when UoC was considered per version
#for changing quality of life
tapply(data_excl$UoC_25, data_excl$EL_UoC_Q, summary)
tapply(data_excl$UoC_50, data_excl$EL_UoC_Q, summary)
tapply(data_excl$UoC_75, data_excl$EL_UoC_Q, summary)
tapply(data_excl$UoC_100, data_excl$EL_UoC_Q, summary)

#for changing length of life
tapply(data_excl$UoC_25, data_excl$EL_UoC_L, summary)
tapply(data_excl$UoC_50, data_excl$EL_UoC_L, summary)
tapply(data_excl$UoC_75, data_excl$EL_UoC_L, summary)
tapply(data_excl$UoC_100, data_excl$EL_UoC_L, summary)

##UoC values per HrQoL
summary(data_excl$UoC_25)
summary(data_excl$UoC_50)
summary(data_excl$UoC_75)
summary(data_excl$UoC_100)

tapply(data_excl$UoC_25, data_excl$Version, summary)
tapply(data_excl$UoC_50, data_excl$Version, summary)
tapply(data_excl$UoC_75, data_excl$Version, summary)
tapply(data_excl$UoC_100, data_excl$Version, summary)

#calculating mean WTP per person
data_excl$mean_wtp <- ( rowMeans(select(data_excl,
                                        c(wtp_Qlow,wtp_Qmed, wtp_Qhigh, wtp_Llow, wtp_Lmed, wtp_Lhigh)), na.rm = TRUE))

summary(data_excl$mean_wtp)


### 4. Tests

###t-tests for equality of means
#test for normality
shapiro.test(data_excl$wtp_Qlow)
shapiro.test(data_excl$wtp_Qmed)
shapiro.test(data_excl$wtp_Qhigh)
shapiro.test(data_excl$wtp_Llow)
shapiro.test(data_excl$wtp_Lmed)
shapiro.test(data_excl$wtp_Lhigh)
shapiro.test(data_excl$mean_wtp)


shapiro.test(data_excl$UoC_25)
shapiro.test(data_excl$UoC_50)
shapiro.test(data_excl$UoC_75)
shapiro.test(data_excl$UoC_100)

##test for equality of means
#comparing means - unpaired t tests (No instruction versus instruction to include)
t.test(formula = wtp_Qlow ~ instruction,
       data = data_excl)
t.test(formula = wtp_Qhigh ~ instruction,
       data = data_excl)
t.test(formula = wtp_Llow ~ instruction,
       data = data_excl)
t.test(formula = wtp_Lhigh ~ instruction,
       data = data_excl)
t.test(formula = mean_wtp ~ instruction,
       data = data_excl)

#comparing means - unpaired t tests (no versus spontaneous inclusion UoC)
t.test(formula = wtp_Qlow ~ EL_UoC,
       data = data_excl)
t.test(formula = wtp_Qmed ~ EL_UoC,
       data = data_excl)
t.test(formula = wtp_Qhigh ~ EL_UoC,
       data = data_excl)
t.test(formula = wtp_Llow ~ EL_UoC,
       data = data_excl)
t.test(formula = wtp_Lmed ~ EL_UoC,
       data = data_excl)
t.test(formula = wtp_Lhigh ~ EL_UoC,
       data = data_excl)
t.test(formula = mean_wtp ~ EL_UoC,
       data = data_excl)

#comparing means - unpaired t tests (no versus spontaneous inclusion leisure)
t.test(formula = wtp_Qlow ~ EL_leisure,
       data = data_excl)
t.test(formula = wtp_Qmed ~ EL_leisure,
       data = data_excl)
t.test(formula = wtp_Qhigh ~ EL_leisure,
       data = data_excl)
t.test(formula = wtp_Llow ~ EL_leisure,
       data = data_excl)
t.test(formula = wtp_Lmed ~ EL_leisure,
       data = data_excl)
t.test(formula = wtp_Lhigh ~ EL_leisure,
       data = data_excl)
t.test(formula = mean_wtp ~ EL_leisure,
       data = data_excl)

#comparing means - unpaired t tests (no versus spontaneous inclusion productivity)
t.test(formula = wtp_Qlow ~ EL_productivity,
       data = data_excl)
t.test(formula = wtp_Qmed ~ EL_productivity,
       data = data_excl)
t.test(formula = wtp_Qhigh ~ EL_productivity,
       data = data_excl)
t.test(formula = wtp_Llow ~ EL_productivity,
       data = data_excl)
t.test(formula = wtp_Lmed ~ EL_productivity,
       data = data_excl)
t.test(formula = wtp_Lhigh ~ EL_productivity,
       data = data_excl)
t.test(formula = mean_wtp ~ EL_productivity,
       data = data_excl)

#comparing means - unpaired t tests (no versus spontaneous inclusion spending)
t.test(formula = wtp_Qlow ~ EL_spending,
       data = data_excl)
t.test(formula = wtp_Qmed ~ EL_spending,
       data = data_excl)
t.test(formula = wtp_Qhigh ~ EL_spending,
       data = data_excl)
t.test(formula = wtp_Llow ~ EL_spending,
       data = data_excl)
t.test(formula = wtp_Lmed ~ EL_spending,
       data = data_excl)
t.test(formula = wtp_Lhigh ~ EL_spending,
       data = data_excl)
t.test(formula = mean_wtp ~ EL_spending,
       data = data_excl)

#Testing difference UoC based on version
one.way_UoC_25 <- aov(UoC_25 ~ Version, data = data_excl)
summary(one.way_UoC_25)
pairwise.t.test(data_excl$UoC_25, data_excl$Version, p.adj = "bonf")

one.way_UoC_50 <- aov(UoC_50 ~ Version, data = data_excl)
summary(one.way_UoC_50)
pairwise.t.test(data_excl$UoC_50, data_excl$Version, p.adj = "bonf")

one.way_UoC_75 <- aov(UoC_75 ~ Version, data = data_excl)
summary(one.way_UoC_75)
pairwise.t.test(data_excl$UoC_75, data_excl$Version, p.adj = "bonf")

one.way_UoC_100 <- aov(UoC_100 ~ Version, data = data_excl)
summary(one.way_UoC_100)
pairwise.t.test(data_excl$UoC_100, data_excl$Version, p.adj = "bonf")

### 5. Reshape dataset
#add respondent ID
data_excl$ID <- seq.int(nrow(data_excl))

#convert data from wide to long, by ID, creating one variable (time) for UOC per health states
data_excl_w_to_l_uoc<- reshape(data=data_excl, idvar="ID",
                               varying = c("UoC_25", "UoC_50", "UoC_75","UoC_100"),
                               v.name=c("UOC"),
                               times=c("A. QoL 25", "B. QoL 50", "C. QoL 75","D. QoL 100"),
                               new.row.names = 1:50000,
                               direction="long")

#rename variable indicating differences in QoL 
data_excl_w_to_l_uoc$QoL_UoC <- data_excl_w_to_l_uoc$time
rm <- data_excl_w_to_l_uoc$time

#summarize new variable all UoCs
summary(data_excl_w_to_l_uoc$UOC)
tapply(data_excl_w_to_l_uoc$UOC, data_excl_w_to_l_uoc$QoL_UoC, summary)

##
#convert data from wide to long, by ID, creating one variable (time) for different types of WTP
data_excl_w_to_l_WTP<- reshape(data=data_excl, idvar="ID",
                               varying = c("wtp_Llow", "wtp_Lmed", "wtp_Lhigh","wtp_Qlow","wtp_Qmed","wtp_Qhigh"),
                               v.name=c("WTP"),
                               times=c("wtp_Llow", "wtp_Lmed", "wtp_Lhigh","wtp_Qlow","wtp_Qmed","wtp_Qhigh"),
                               new.row.names = 1:50000,
                               direction="long")

#rename variable indicating differences in scenario 
data_excl_w_to_l_WTP$scenario <- data_excl_w_to_l_WTP$time
rm <- data_excl_w_to_l_WTP$time

#summarize new variable all WTPs
summary(data_excl_w_to_l_WTP$WTP)
tapply(data_excl_w_to_l_WTP$WTP, data_excl_w_to_l_WTP$scenario, summary)

##new dataset for difference in uoc after receiving 100.000
data_excl$diff_uoc_25 <-  data_excl$UoC_M_25 - data_excl$UoC_25
data_excl$diff_uoc_50 <-  data_excl$UoC_M_50 - data_excl$UoC_50
data_excl$diff_uoc_75 <-  data_excl$UoC_M_75 - data_excl$UoC_75
data_excl$diff_uoc_100 <-  data_excl$UoC_M_100 - data_excl$UoC_100

#convert data from wide to long, by ID, creating one variable (time) for difference in UOC after money per health states
dif_uoc<- reshape(data=data_excl, idvar="ID",
                  varying = c("diff_uoc_25", "diff_uoc_50", "diff_uoc_75","diff_uoc_100"),
                  v.name=c("dif_UOC"),
                  times=c("A. QoL 25", "B. QoL 50", "C. QoL 75","D. QoL 100"),
                  new.row.names = 1:50000,
                  direction="long")

#rename variable indicating differences in QoL 
dif_uoc$QoL_UoC <- data_excl_w_to_l_uoc$time
rm <- dif_uoc$time

#summarize new variable all dif UoCs
summary(dif_uoc$dif_UOC)
tapply(dif_uoc$dif_UOC, dif_uoc$QoL_UoC, summary)


### 6. Paired tests
#Paired t-test based on reshaped data

#Comparing UoC, varying by health state
one.way_UOC <- aov(UOC ~ QoL_UoC, data = data_excl_w_to_l_uoc)
summary(one.way_UOC)
pairwise.t.test(data_excl_w_to_l_uoc$UOC, data_excl_w_to_l_uoc$QoL_UoC, p.adj = "bonf")

#Comparing WTP, varying by scenario
one.way_WTP <- aov(WTP ~ scenario, data = data_excl_w_to_l_WTP)
summary(one.way_WTP)
pairwise.t.test(data_excl_w_to_l_WTP$WTP, data_excl_w_to_l_WTP$scenario, p.adj = "bonf")

#creating some graphs/plots for UoC
ggplot(aes(x=QoL_UoC,y=UOC), data=data_excl_w_to_l_uoc)+
  geom_point()

boxplot(data_excl_w_to_l_uoc$UOC ~ data_excl_w_to_l_uoc$QoL_UoC, main="Utility of Consumption by Quality of Life",
        xlab="Quality of life (QoL)",
        ylab="Utility of consumption",
        boxwex=.3)

means <- tapply(data_excl_w_to_l_uoc$UOC, data_excl_w_to_l_uoc$QoL_UoC, mean)
points(means, pch=20, cex=1.5)

#creating same boxplot with averages in numbers shown
ggplot(data_excl_w_to_l_uoc, aes(x = QoL_UoC, y = UOC)) +                 
  geom_boxplot() +
  ggtitle("Boxplot Utility of Consumption by Quality of Life") +
  labs(y = "Utility of Consumption (UoC)", x = "Quality of Life (QoL)") +
  stat_summary(fun = mean, geom = "point", col = "black") +  
  stat_summary(fun = mean, geom = "text", col = "black",     
               vjust = 1.5, aes(label = paste("Mean:", round(..y.., digits = 0))))

#creating some graphs/plots for WTP
boxplot(data_excl_w_to_l_WTP$WTP ~ data_excl_w_to_l_WTP$instruction)

ggplot(aes(x=WTP,y=instruction), data=data_excl_w_to_l_WTP)+
  geom_point()

ggplot(aes(x=WTP,y= EL_spending), data=data_excl_w_to_l_WTP)+
  geom_point()

### 7. Regression analyses

#Instal packages
install.packages("plm")
install.packages("AER")
install.packages("stargazer")
library(plm)
library(AER)
library(stargazer)

#Fixed effects with UOC as dependent variable, with QOL as explanatory variable and respondent fixed effects
UOC_fe_lm_mod <- plm(UOC ~ QoL_UoC, 
                     index = c("ID", "QoL_UoC"), 
                     model = "within",
                     data = data_excl_w_to_l_uoc)

summary(UOC_fe_lm_mod)
coeftest(UOC_fe_lm_mod, vcov. = vcovHC, type = "HC1")

#generating table with outcomes for FE UoC 
stargazer(UOC_fe_lm_mod, type = "html",
          title = "Fixed effects model for Utility of Consumption")

stargazer(UOC_fe_lm_mod, type = "html", out = "regression_UoC_FE.html" ,title = "Fixed effects model for Utility of Consumption")

#Fixed effects WTP
WTP_fe_lm_mod <- plm(WTP ~ scenario, 
                     data = data_excl_w_to_l_WTP,
                     index = c("ID", "scenario"), 
                     model = "within")

summary(WTP_fe_lm_mod)

#estimating lm models for average WTP per person (no repeated measures)

mean_wtp_lm_mod1 <- lm(mean_wtp ~ Age + Net_hh_income + EL_UoC + EL_productivity + EL_leisure + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod1)

mean_wtp_lm_mod2 <- lm(mean_wtp ~ inclusion_UoC + EL_productivity + EL_leisure + EL_spending + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod2)


mean_wtp_lm_mod3 <- lm(mean_wtp ~ inclusion_UoC + EL_productivity + EL_leisure + EL_spending + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod3)

mean_wtp_lm_mod4 <- lm(mean_wtp ~ Age + Net_hh_income + inclusion_UoC + EL_productivity + EL_leisure + EL_spending + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod4)

mean_wtp_lm_mod5 <- lm(mean_wtp ~ Age + income_groups + inclusion_UoC + EL_productivity + EL_leisure + EL_spending + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod5)

mean_wtp_lm_mod6 <- lm(mean_wtp ~ Age + income_groups + inclusion_UoC + EL_productivity + EL_leisure + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod6)

mean_wtp_lm_mod7 <- lm(mean_wtp ~ Age + income_groups + inclusion_UoC + EL_productivity + EL_leisure + EL_spending + QoL + UoC, data = data_excl)
summary(mean_wtp_lm_mod7)

mean_wtp_lm_mod8 <- lm(mean_wtp ~ Age + income_groups + inclusion_UoC + EL_productivity + EL_leisure + EL_spending + QoL + UoC + UoC_25 +UoC_50 + UoC_75 + UoC_100 , data = data_excl)
summary(mean_wtp_lm_mod8)

mean_wtp_lm_mod9 <- lm(mean_wtp ~ Gender + Age + income_groups + inclusion_UoC + EL_productivity + EL_leisure + EL_spending + QoL + UoC , data = data_excl)
summary(mean_wtp_lm_mod9)

mean_wtp_lm_mod10 <- lm(mean_wtp ~ Gender + Age +  edu_groups + income_groups + QoL + UoC + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod10)

mean_wtp_lm_mod11 <- lm(mean_wtp ~ Gender + Age + Children_athome + Make_ends + Importance_religion + edu_groups + income_groups + QoL + UoC + inclusion_UoC + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod11)

mean_wtp_lm_mod12 <- lm(mean_wtp ~ Gender + Age + income_groups  + edu_groups  + QoL + UoC + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod12)

mean_wtp_lm_mod13 <- lm(mean_wtp ~ Gender + Age + Net_hh_income  + edu_groups  + QoL + UoC + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod13)

mean_wtp_lm_mod14 <- lm(mean_wtp ~ Gender + Age + income_groups + Make_ends  + edu_groups  + QoL + UoC + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod14)

mean_wtp_lm_mod15 <- lm(mean_wtp ~ Gender + Age + Make_ends  + edu_groups  + QoL + UoC + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod15)

mean_wtp_lm_mod16 <- lm(mean_wtp ~ Gender + Age +  edu_groups + Make_ends + QoL + UoC + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod16)

mean_wtp_lm_mod17 <- lm(mean_wtp ~ Gender + Age +  edu_groups + Net_hh_income + Make_ends + QoL + UoC + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod17)

mean_wtp_lm_mod18 <- lm(mean_wtp ~ Gender + Age +  edu_groups + Net_hh_income + Make_ends +  QoL + UoC + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod18)

mean_wtp_lm_mod19 <- lm(mean_wtp ~ Gender + Age +  edu_groups + Net_hh_income + Make_ends + UoC + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + sub_version_abc, data = data_excl)
summary(mean_wtp_lm_mod19)

mean_wtp_lm_mod20 <- lm(mean_wtp ~ Gender + Age + edu_groups + Net_hh_income + Make_ends + UoC + EL_spending , data = data_excl)
summary(mean_wtp_lm_mod20)

mean_wtp_lm_mod21 <- lm(mean_wtp ~ sub_version_abc + inclusion_UoC  + EL_productivity + EL_leisure + EL_spending  + QoL + UoC + Gender + Age + Children + Net_hh_income + edu_groups , data = data_excl)
summary(mean_wtp_lm_mod21)


#generating table with outcomes for WTP 
stargazer(mean_wtp_lm_mod18, mean_wtp_lm_mod19, mean_wtp_lm_mod20, type = "html",
          title = "Regression model for Willingness to Pay per QALY")

stargazer(mean_wtp_lm_mod18, mean_wtp_lm_mod19, mean_wtp_lm_mod20, type = "html", out = "t5_regression_wtp.html" ,title = "Table 5: Regression model for Willingness to Pay per QALY")

stargazer(mean_wtp_lm_mod21, type = "html", out = "t5_regression_wtp_full.html" ,title = "Table 5: Regression model for Willingness to Pay per QALY")

#checking relation UoC and QoL
cor.test(data_excl$UoC,data_excl$QoL)

QoL_own <- lm(QoL ~ UoC , data = data_excl)
summary(QoL_own)

UoC_own <- lm(UoC ~ QoL , data = data_excl)
summary(UoC_own)

# plot a scatter plot for UoC by QoL
plot(data_excl$QoL, data_excl$UoC,
     main='Respondent UoC by QoL',
     xlab='QoL',ylab='UoC')

# plot a regression line for UoC by QoL
abline(lm(UoC ~ QoL, data = data_excl),col='red')

#checking relation UoC and income
cor.test(data_excl_w_to_l_uoc$UOC, data_excl_w_to_l_uoc$Net_hh_income)

# plot a scatter plot for QoL by income
plot(data_excl$Net_hh_income, data_excl$QoL,
     main='Respondent QoL by income',
     xlab='Income',ylab='QoL')

# plot a regression line for QoL by income
abline(lm(QoL ~ Net_hh_income, data = data_excl),col='red')

# plot a scatter plot for UoC by income
plot(data_excl$Net_hh_income, data_excl$UoC,
     main='Respondent UoC by income',
     xlab='Income',ylab='UoC')

# plot a regression line for UoC by income
abline(lm(UoC ~ Net_hh_income, data = data_excl),col='red')

#some models for estimating own uoc
UoC_own1 <- lm(UoC ~ QoL + Age + Net_hh_income + Gender + Children, data = data_excl)
summary(UoC_own1)

UoC_own2 <- lm(UoC ~ QoL + Age + Gender + Children + Make_ends, data = data_excl)
summary(UoC_own2)

UoC_own3 <- lm(UoC ~ QoL + Age + Gender + Religious + Importance_religion + Children + Make_ends, data = data_excl)
summary(UoC_own3)

UoC_own4 <- lm(UoC ~ QoL + Age + Gender + Children + Householdsize + Make_ends, data = data_excl)
summary(UoC_own4)

UoC_own5 <- lm(UoC ~ QoL + Age + Gender + Children  + edu_groups + Employment + Make_ends, data = data_excl)
summary(UoC_own5)

UoC_own6 <- lm(UoC ~ QoL + Gender + Children + Make_ends + income_groups + Age, data = data_excl)
summary(UoC_own6)

UoC_own7 <- lm(UoC ~ QoL + Gender + Children + Make_ends + Net_hh_income + Age , data = data_excl)
summary(UoC_own7)

UoC_own8 <- lm(UoC ~ QoL + Gender + Age + Children + Net_hh_income , data = data_excl)
summary(UoC_own8)

#looking into nonlinear relation QoL and UoC
UoC_own9 <- lm(UoC ~ QoL + I(QoL**2) + Gender + Children + Make_ends, data = data_excl)
summary(UoC_own9)

UoC_own10 <- lm(UoC ~ QoL + I(QoL**2), data = data_excl)
summary(UoC_own10)

UoC_own11 <- lm(UoC ~ QoL, data = data_excl)
summary(UoC_own11)

#compare  models
stargazer(UoC_own9, UoC_own10, UoC_own11, type = "html", out = "regression_UoC_nl.html" ,title = "Regression model for own Utility of Consumption (linear v.s. nonlinear)")

# plot a scatter plot for UoC by QoL+QoL^2
plot(data_excl$QoL, data_excl$UoC,
     main='Respondent UoC by QoL',
     xlab='QoL',ylab='UoC')

# plot a regression line for UoC by QoL
abline(lm(UoC ~ QoL + I(QoL**2), data = data_excl),col='red')

abline(lm(UoC ~ QoL, data = data_excl),col='blue')

#generating table with outcomes for own UoC 

stargazer(UoC_own7, UoC_own8, type = "html",
          title = "Regression model for own Utility of Consumption")

stargazer(UoC_own7, UoC_own8, type = "html", out = "regression_UoC.html" ,title = "Regression model for own Utility of Consumption")

#generating table with outcomes combining LM own UoC and FE UoC 

stargazer(UoC_own7, UoC_own8, UOC_fe_lm_mod, type = "html",
          title = "Models for Utility of Consumption")

stargazer(UoC_own7, UoC_own8, UOC_fe_lm_mod, type = "html", out = "t3_regression_UoC_combined.html" ,title = "Table 3: Models for Utility of Consumption")

stargazer(UoC_own7, UoC_own8, UOC_fe_lm_mod, type = "text", out = "t3_regression_UoC_combined.txt" ,title = "Table 3: Models for Utility of Consumption")