Wine Study: Willingness To Buy and Pay
We first load the packages that we may need
We set our directory. Please change the patch to the folder that you have created.
Also, we transform and Centralize the data to follow a normal distribution.
setwd("D:/ACG - Wine Study")
#load the data
library(readxl)
wineData <- read_excel("WineStudyPK.xlsx")
#define the main factor variables
wineData$ID <- as.factor(wineData$ID)
wineData$Image <- as.factor(wineData$Image)
wineData$Familiarity <- as.factor(wineData$Familiarity)
#Transforming and Centralizing the data to follow a normal distribution.
rec <- recipe(~ ., data = as.data.frame(wineData))
bn_trans <- step_best_normalize(rec, all_numeric())
bn_estimates <- prep(bn_trans, training = as.data.frame(wineData))
bn_data <- bake(bn_estimates, as.data.frame(wineData))
df <- bn_data
df$Age <- df$`Age-Group`Willingness to Buy - ANOVA
anovWTB <- aov_ez("ID","WTB", df,
within = c("Image","Familiarity"),
anova_table = list(es = "pes"))
summary(anovWTB)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 0.000 1 940.21 359 0.000 1.000000
## Image 8.102 1 154.29 359 18.852 1.84e-05 ***
## Familiarity 53.573 1 174.12 359 110.454 < 2.2e-16 ***
## Image:Familiarity 4.184 1 104.52 359 14.371 0.000176 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Willingness to Buy - ANOVA -POST-HOC COMPARISONS
contrast(emmeans(anovWTB,~ Image + Familiarity),
method="pairwise", interaction=FALSE, adjust = "bonf")## contrast estimate SE df t.ratio p.value
## Humorous High - Nature High -0.0422 0.0472 359 -0.895 1.0000
## Humorous High - Humorous Low 0.4936 0.0492 359 10.041 <.0001
## Humorous High - Nature Low 0.2357 0.0504 359 4.676 <.0001
## Nature High - Humorous Low 0.5358 0.0504 359 10.629 <.0001
## Nature High - Nature Low 0.2780 0.0435 359 6.384 <.0001
## Humorous Low - Nature Low -0.2578 0.0422 359 -6.111 <.0001
##
## P value adjustment: bonferroni method for 6 testsANOVA - Plot
anovWTB_Plot <- ggplot(df, aes(x = Image, y= WTB, fill = Familiarity)) +
geom_violin(trim = FALSE) +
geom_boxplot(width=0.3, position = position_dodge(width = 0.9)) +
scale_color_brewer(palette="Dark2")+
jtools::theme_nice() + theme(legend.position="top") + ylim(-4,4)
anovWTB_Plot 
ANOVA - Plot
anovWTB_Plot2 <- ggplot(df, aes(x = Familiarity, y= WTB, fill = Image)) +
geom_violin(trim = FALSE) +
geom_boxplot(width=0.3, position = position_dodge(width = 0.9)) +
scale_color_brewer(palette="Dark2")+
jtools::theme_nice() + theme(legend.position="top") + ylim(-4,4)
anovWTB_Plot2 
ANOVA - Plot
WTB_aov <- ggstatsplot::grouped_ggwithinstats(
data = df,
x = Image,
y = WTB,
grouping.var = Familiarity,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Image",
ylab = "WTB",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTB_aov
ANOVA - Plot
WTB_aov2 <- ggstatsplot::grouped_ggwithinstats(
data = df,
x = Familiarity,
y = WTB,
grouping.var = Image,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Familiarity",
ylab = "WTB",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTB_aov2
ANOVA - Plot
WTB_aov3 <- ggstatsplot::ggwithinstats(
data = df,
x = Familiarity,
y = WTB,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Familiarity",
ylab = "WTB",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTB_aov3
ANOVA - Plot
WTB_aov4 <- ggstatsplot::ggwithinstats(
data = df,
x = Image,
y = WTB,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Image",
ylab = "WTB",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTB_aov4
Willingness To Buy - Single Predictor Mixed Regression Models
WTB0 <- lme4::lmer(WTB ~ 1 + (1|ID), data = df)
WTB1 <- lme4::lmer(WTB ~ 1 + Age + (1|ID), data = df)
WTB2 <- lme4::lmer(WTB ~ 1 + Sex + (1|ID), data = df)
WTB3 <- lme4::lmer(WTB ~ 1 + Frequency + (1|ID), data = df)
WTB4 <- lme4::lmer(WTB ~ 1 + Quantity + (1|ID), data = df)
WTB5 <- lme4::lmer(WTB ~ 1 + Knowledge + (1|ID), data = df)
WTB6 <- lme4::lmer(WTB ~ 1 + Image + (1|ID), data = df)
WTB7 <- lme4::lmer(WTB ~ 1 + Familiarity + (1|ID), data = df)
WTB8 <- lme4::lmer(WTB ~ 1 + Income + (1|ID), data = df)
WTB9 <- lme4::lmer(WTB ~ 1 + OPQ + (1|ID), data = df)
WTB10 <- lme4::lmer(WTB ~ 1 + Risk3 + (1|ID), data = df)
WTB11 <- lme4::lmer(WTB ~ 1 + RiskTotal + (1|ID), data = df)Now, we compare the models with the NULL Model
anova(WTB0,WTB1)## refitting model(s) with ML (instead of REML)#Signficant
anova(WTB0,WTB2)## refitting model(s) with ML (instead of REML)#Signficant
anova(WTB0,WTB3)## refitting model(s) with ML (instead of REML)#Significant
anova(WTB0,WTB4)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB0,WTB5)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB0,WTB6)## refitting model(s) with ML (instead of REML)#Significant
anova(WTB0,WTB7)## refitting model(s) with ML (instead of REML)#Significant
anova(WTB0,WTB8)## refitting model(s) with ML (instead of REML)#Non-Significant
anova(WTB0,WTB9)## refitting model(s) with ML (instead of REML)#Significant
anova(WTB0,WTB10)## refitting model(s) with ML (instead of REML)#Non-Significant
anova(WTB0,WTB11)## refitting model(s) with ML (instead of REML)#Non-SignificantComparisons Between the Single-Predictor Models
anova(WTB2,WTB3)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB2,WTB6)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB2,WTB7)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB2,WTB8)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTB2,WTB9)## refitting model(s) with ML (instead of REML)#NON-SignificantRANKING: WORST TO BEST MODEL
The ranking was based on the R-Squared and the Beta Coefficient of each Model
jtools::summ(WTB1)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3608.64, BIC = 3629.73
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.54
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.37 0.16 2.32 358.00 0.02
## Age -0.12 0.05 -2.41 358.00 0.02
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.73
## Residual 0.68
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.53
## -------------------------jtools::summ(WTB3)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3609.06, BIC = 3630.15
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.54
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.30 0.14 2.17 358.00 0.03
## Frequency -0.13 0.06 -2.28 358.00 0.02
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.73
## Residual 0.68
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.54
## -------------------------jtools::summ(WTB6)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3597.44, BIC = 3618.53
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.55
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.08 0.05 -1.62 489.59 0.11
## ImageNature 0.15 0.04 4.22 1079.00 0.00
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.74
## Residual 0.67
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.54
## -------------------------jtools::summ(WTB2)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3607.69, BIC = 3628.77
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.54
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.10 0.06 1.69 358.00 0.09
## SexMale -0.20 0.08 -2.39 358.00 0.02
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.73
## Residual 0.68
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.53
## -------------------------jtools::summ(WTB7)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3492.51, BIC = 3513.60
## Pseudo-R² (fixed effects) = 0.04
## Pseudo-R² (total) = 0.59
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.19 0.05 4.20 477.09 0.00
## FamiliarityLow -0.39 0.03 -11.39 1079.00 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.74
## Residual 0.64
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.57
## -------------------------jtools::summ(WTB9)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2254.23, BIC = 2275.32
## Pseudo-R² (fixed effects) = 0.64
## Pseudo-R² (total) = 0.83
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.00 0.03 -0.07 357.22 0.95
## OPQ 0.83 0.02 47.64 1409.01 0.00
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.44
## Residual 0.43
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.52
## -------------------------Plot of the best Model - Overall Perceived Quality
X = Overall Perceived Quality Predicted = Willingness to Buy
WTB9p <- ggpredict(WTB9, terms = "OPQ")
WTB9plot <- ggplot(WTB9p, aes(x, predicted)) +
geom_line() +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1)+
geom_point(data = df, aes(x = OPQ, y = WTB))+
geom_smooth(method="lm", se =T)+
geom_smooth(method=lm, aes(group = 1), se = T)+
scale_color_brewer(palette="Dark2")+ jtools::theme_nice() #+ ylim(-2,2)+ xlim(-2,2)
WTB9plot## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
Multiple Regression Models (Two Predictors) - Built Based on their Ranking as Single Predictor (see Models Above)
WTB9A <- lme4::lmer(WTB ~ 1 + OPQ + Age + (1|ID), data = df)
WTB9B <- lme4::lmer(WTB ~ 1 + OPQ + Frequency + (1|ID), data = df)
WTB9C <- lme4::lmer(WTB ~ 1 + OPQ + Sex + (1|ID), data = df)
WTB9D <- lme4::lmer(WTB ~ 1 + OPQ + Image + (1|ID), data = df)
WTB9E <- lme4::lmer(WTB ~ 1 + OPQ + Familiarity + (1|ID), data = df)Comparisons of Multiple Regression Models with the Best Single Predictor Model
anova(WTB9,WTB9A)## refitting model(s) with ML (instead of REML)#Sig
anova(WTB9,WTB9B)## refitting model(s) with ML (instead of REML)#Non-Sig
anova(WTB9,WTB9C)## refitting model(s) with ML (instead of REML)#Non-Sig
anova(WTB9,WTB9D)## refitting model(s) with ML (instead of REML)#Non-Sig
anova(WTB9,WTB9E)## refitting model(s) with ML (instead of REML)#SigRANKING: WORST TO BEST MODEL (Minor Differences in Between Beta Coefficients)
jtools::summ(WTB9A)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2255.96, BIC = 2282.32
## Pseudo-R² (fixed effects) = 0.64
## Pseudo-R² (total) = 0.83
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) 0.22 0.10 2.23 356.54 0.03
## OPQ 0.83 0.02 47.62 1405.65 0.00
## Age -0.07 0.03 -2.33 356.57 0.02
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.44
## Residual 0.43
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.51
## -------------------------jtools::summ(WTB9E)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2236.55, BIC = 2262.91
## Pseudo-R² (fixed effects) = 0.64
## Pseudo-R² (total) = 0.83
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.06 0.03 2.01 505.74 0.04
## OPQ 0.81 0.02 45.10 1388.98 0.00
## FamiliarityLow -0.12 0.02 -5.06 1125.46 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.44
## Residual 0.42
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.52
## -------------------------Multiple Regression Models (Three Predictors) - Built Based on their Ranking (see Models with Two Predictors Above)
WTB9AF <- lme4::lmer(WTB ~ 1 + OPQ + Familiarity + Age + (1|ID), data = df)
anova(WTB9E,WTB9AF)## refitting model(s) with ML (instead of REML)#Significant
WTB9AG <- lme4::lmer(WTB ~ 1 + OPQ + Familiarity + Sex + (1|ID), data = df)
anova(WTB9E,WTB9AG)## refitting model(s) with ML (instead of REML)#Non-Significant
WTB9AH <- lme4::lmer(WTB ~ 1 + OPQ + Sex + (1|ID), data = df)
anova(WTB9E,WTB9AH)## refitting model(s) with ML (instead of REML)#Non-Significant
WTB9AI <- lme4::lmer(WTB ~ 1 + OPQ + Frequency + (1|ID), data = df)
anova(WTB9E,WTB9AI)## refitting model(s) with ML (instead of REML)#Non-SignificantBest Model is WTB9AF , thus the best significant prediction of WTB is facilitated by the combination of OPQ, Familiarity, and Age.
jtools::summ(WTB9AF)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTB
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2238.04, BIC = 2269.67
## Pseudo-R² (fixed effects) = 0.64
## Pseudo-R² (total) = 0.83
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.28 0.10 2.86 368.73 0.00
## OPQ 0.81 0.02 45.08 1384.85 0.00
## FamiliarityLow -0.12 0.02 -5.09 1125.50 0.00
## Age -0.07 0.03 -2.38 357.82 0.02
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.44
## Residual 0.42
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.52
## -------------------------WTB9Ap <- ggpredict(WTB9AF, terms = c("OPQ","Familiarity", "Age"))
WTB9Aplot <- ggplot(WTB9Ap, aes(x, predicted)) +
#geom_line() +
#geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1)+
geom_point()+
#geom_smooth(method="lm", se =T)+
geom_smooth(method=lm, aes(group = 1), se = T)+
scale_color_brewer(palette="Dark2")+ jtools::theme_nice() + ylim(-2,2)+ xlim(-2,2)
WTB9Aplot## `geom_smooth()` using formula 'y ~ x'## Warning: Removed 12 rows containing non-finite values (stat_smooth).## Warning: Removed 12 rows containing missing values (geom_point).
ANOVA - Willingness to Pay
anovWTP <- aov_ez("ID","WTP", df,
within = c("Image","Familiarity"),
anova_table = list(es = "pes"))
summary(anovWTP)##
## Univariate Type III Repeated-Measures ANOVA Assuming Sphericity
##
## Sum Sq num Df Error SS den Df F value Pr(>F)
## (Intercept) 0.000 1 1047.10 359 0.0000 1.000000
## Image 3.525 1 120.42 359 10.5080 0.001300 **
## Familiarity 40.053 1 126.11 359 114.0168 < 2.2e-16 ***
## Image:Familiarity 2.284 1 99.51 359 8.2411 0.004338 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1POST HOC COMPARISONS - WTP
contrast(emmeans(anovWTP,~ Image + Familiarity),
method="pairwise", interaction=FALSE, adjust = "bonf")## contrast estimate SE df t.ratio p.value
## Humorous High - Nature High -0.0193 0.0394 359 -0.489 1.0000
## Humorous High - Humorous Low 0.4132 0.0422 359 9.798 <.0001
## Humorous High - Nature Low 0.2346 0.0420 359 5.588 <.0001
## Nature High - Humorous Low 0.4325 0.0453 359 9.546 <.0001
## Nature High - Nature Low 0.2539 0.0414 359 6.135 <.0001
## Humorous Low - Nature Low -0.1786 0.0430 359 -4.155 0.0002
##
## P value adjustment: bonferroni method for 6 testsANOVA PLOT1 - WTP
anovWTP_Plot <- ggplot(df, aes(x = Image, y= WTP, fill = Familiarity)) +
geom_violin(trim = FALSE) +
geom_boxplot(width=0.3, position = position_dodge(width = 0.9)) +
scale_color_brewer(palette="Dark2")+
jtools::theme_nice() + theme(legend.position="top") + ylim(-4,4)
anovWTP_Plot
ANOVA PLOT2 - WTP
anovWTP_Plot2 <- ggplot(df, aes(x =Familiarity , y= WTP, fill = Image)) +
geom_violin(trim = FALSE) +
geom_boxplot(width=0.3, position = position_dodge(width = 0.9)) +
scale_color_brewer(palette="Dark2")+
jtools::theme_nice() + theme(legend.position="top") + ylim(-4,4)
anovWTP_Plot2 
ANOVA PLOT3 - WTP
WTP_aov <- ggstatsplot::grouped_ggwithinstats(
data = df,
x = Image,
y = WTP,
grouping.var = Familiarity,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Image",
ylab = "WTP",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTP_aov
ANOVA PLOT4 - WTP
WTP_aov2 <- ggstatsplot::grouped_ggwithinstats(
data = df,
x = Familiarity,
y = WTP,
grouping.var = Image,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Familiarity",
ylab = "WTP",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTP_aov2
ANOVA PLOT5 - WTP
WTP_aov3 <- ggstatsplot::ggwithinstats(
data = df,
x = Familiarity,
y = WTP,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Familiarity",
ylab = "WTP",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTP_aov3
ANOVA PLOT6 - WTP
WTP_aov4 <- ggstatsplot::ggwithinstats(
data = df,
x = Image,
y = WTP,
type = "p",
pairwise.comparisons = TRUE,
pairwise.display = "significant",
p.adjust.method = "bonferroni",
effsize.type = "unbiased",
subtitle = TRUE,
xlab = "Image",
ylab = "WTP",
var.equal = TRUE,
mean.ci = TRUE,
notch = FALSE,
paired = TRUE
)
WTP_aov4
Willingness to Pay - Regression Models with Single Predictors
WTP0 <- lme4::lmer(WTP ~ 1 + (1|ID), data = df)
WTP1 <- lme4::lmer(WTP ~ 1 + Age + (1|ID), data = df)
WTP2 <- lme4::lmer(WTP ~ 1 + Sex + (1|ID), data = df)
WTP3 <- lme4::lmer(WTP ~ 1 + Frequency + (1|ID), data = df)
WTP4 <- lme4::lmer(WTP ~ 1 + Quantity + (1|ID), data = df)
WTP5 <- lme4::lmer(WTP ~ 1 + Knowledge + (1|ID), data = df)
WTP6 <- lme4::lmer(WTP ~ 1 + Image + (1|ID), data = df)
WTP7 <- lme4::lmer(WTP ~ 1 + Familiarity + (1|ID), data = df)
WTP8 <- lme4::lmer(WTP ~ 1 + Income + (1|ID), data = df)
WTP9 <- lme4::lmer(WTP ~ 1 + OPQ + (1|ID), data = df)
WTP10 <- lme4::lmer(WTP ~ 1 + Risk3 + (1|ID), data = df)
WTP11 <- lme4::lmer(WTP ~ 1 + RiskTotal + (1|ID), data = df)Comparison of each model with the NULL model
anova(WTP0,WTP1)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP0,WTP2)## refitting model(s) with ML (instead of REML)#Signficant
anova(WTP0,WTP3)## refitting model(s) with ML (instead of REML)#Significant
anova(WTP0,WTP4)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP0,WTP5)## refitting model(s) with ML (instead of REML)#Significant
anova(WTP0,WTP6)## refitting model(s) with ML (instead of REML)#Significant
anova(WTP0,WTP7)## refitting model(s) with ML (instead of REML)#Significant
anova(WTP0,WTP8)## refitting model(s) with ML (instead of REML)#Non-Significant
anova(WTP0,WTP9)## refitting model(s) with ML (instead of REML)#Significant
anova(WTP0,WTP10)## refitting model(s) with ML (instead of REML)#Non-Significant
anova(WTP0,WTP11)## refitting model(s) with ML (instead of REML)#Non-SignificantComparisons between the models
anova(WTP2,WTP3)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP2,WTP6)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP2,WTP7)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP2,WTP8)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(WTP2,WTP9)## refitting model(s) with ML (instead of REML)#NON-SignificantRANKING: WORST TO BEST MODEL BASED ON THE R-SQUARED AND THE BETA COEFFICIENT
jtools::summ(WTP6)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3383.78, BIC = 3404.87
## Pseudo-R² (fixed effects) = 0.00
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.05 0.05 -1.04 450.79 0.30
## ImageNature 0.10 0.03 3.13 1079.00 0.00
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.80
## Residual 0.60
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.64
## -------------------------jtools::summ(WTP3)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3387.47, BIC = 3408.56
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.31 0.15 2.10 358.00 0.04
## Frequency -0.13 0.06 -2.20 358.00 0.03
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.79
## Residual 0.60
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.63
## -------------------------jtools::summ(WTP5)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3385.37, BIC = 3406.46
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) -0.35 0.14 -2.44 358.00 0.02
## Knowledge 0.18 0.07 2.57 358.00 0.01
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.79
## Residual 0.60
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.63
## -------------------------jtools::summ(WTP2)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3386.60, BIC = 3407.69
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.10 0.06 1.56 358.00 0.12
## SexMale -0.20 0.09 -2.21 358.00 0.03
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.79
## Residual 0.60
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.63
## -------------------------jtools::summ(WTP7)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3277.21, BIC = 3298.30
## Pseudo-R² (fixed effects) = 0.03
## Pseudo-R² (total) = 0.67
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.17 0.05 3.51 441.92 0.00
## FamiliarityLow -0.33 0.03 -11.08 1079.00 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.80
## Residual 0.57
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.67
## -------------------------jtools::summ(WTP9)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2455.74, BIC = 2476.83
## Pseudo-R² (fixed effects) = 0.41
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.00 0.04 -0.04 356.10 0.97
## OPQ 0.69 0.02 37.09 1373.85 0.00
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.71
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------Plot of the best Model - Overall Perceived Quality
X = Overall Perceived Quality Predicted = Willingness to Pay
WTP9p <- ggpredict(WTP9, terms = "OPQ")
WTP9plot <- ggplot(WTP9p, aes(x, predicted)) +
geom_line() +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1)+
geom_point(data = df, aes(x = OPQ, y = WTP))+
geom_smooth(method="lm", se =T)+
geom_smooth(method=lm, aes(group = 1), se = T)+
scale_color_brewer(palette="Dark2")+ jtools::theme_nice() #+ ylim(-2,2)+ xlim(-2,2)
WTP9plot## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'
Multiple Regression Models (Two Predictors) - Built Based on their Ranking as Single Predictor (see Models Above) Comparisons against the Best Model with a Single Predictor
WTP9A <- lme4::lmer(WTP ~ 1 + OPQ + Familiarity + (1|ID), data = df)
WTP9B <- lme4::lmer(WTP ~ 1 + OPQ + Frequency + (1|ID), data = df)
WTP9C <- lme4::lmer(WTP ~ 1 + OPQ + Image + (1|ID), data = df)
WTP9D <- lme4::lmer(WTP ~ 1 + OPQ + Sex + (1|ID), data = df)
WTP9E <- lme4::lmer(WTP ~ 1 + OPQ + Knowledge + (1|ID), data = df)
anova(WTP9,WTP9A)## refitting model(s) with ML (instead of REML)#Sig
anova(WTP9,WTP9B)## refitting model(s) with ML (instead of REML)#Non-Sig
anova(WTP9,WTP9C)## refitting model(s) with ML (instead of REML)#Sig
anova(WTP9,WTP9D)## refitting model(s) with ML (instead of REML)#Non-Sig
anova(WTP9,WTP9E)## refitting model(s) with ML (instead of REML)#SigRANKING: WORST TO BEST MODEL BASED ON THE R-SQUARED AND THE BETA COEFFICIENT
jtools::summ(WTP9A)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2437.70, BIC = 2464.06
## Pseudo-R² (fixed effects) = 0.40
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.06 0.04 1.39 417.75 0.17
## OPQ 0.66 0.02 34.43 1388.19 0.00
## FamiliarityLow -0.11 0.02 -5.10 1106.04 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.70
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------jtools::summ(WTP9C)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2457.34, BIC = 2483.71
## Pseudo-R² (fixed effects) = 0.41
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) 0.03 0.04 0.64 413.82 0.52
## OPQ 0.70 0.02 36.98 1378.47 0.00
## ImageNature -0.05 0.02 -2.49 1087.46 0.01
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.71
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------jtools::summ(WTP9E)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2456.63, BIC = 2482.99
## Pseudo-R² (fixed effects) = 0.42
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.26 0.12 -2.11 355.09 0.04
## OPQ 0.69 0.02 37.05 1374.92 0.00
## Knowledge 0.14 0.06 2.21 355.12 0.03
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.70
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.74
## -------------------------Multiple Regression Models (THREE Predictors) - Built Based on their Ranking as Single Predictor (see Models Above) COMPARISONS AGAINST THE BEST MODEL WITH TWO PREDICTORS
WTP9AF <- lme4::lmer(WTP ~ 1 + OPQ + Knowledge + Image + (1|ID), data = df)
anova(WTP9E,WTP9AF)## refitting model(s) with ML (instead of REML)#Significant
WTP9AG <- lme4::lmer(WTP ~ 1 + OPQ + Knowledge + Familiarity + (1|ID), data = df)
anova(WTP9E,WTP9AG)## refitting model(s) with ML (instead of REML)#SignificantRANKING: WORST TO BEST MODEL BASED ON R-SQUARED AND BETA COEFFICIENT
jtools::summ(WTP9AG)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2438.41, BIC = 2470.05
## Pseudo-R² (fixed effects) = 0.41
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) -0.21 0.12 -1.68 361.09 0.09
## OPQ 0.66 0.02 34.39 1389.18 0.00
## Knowledge 0.14 0.06 2.25 356.02 0.03
## FamiliarityLow -0.11 0.02 -5.12 1106.02 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.70
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------jtools::summ(WTP9AF)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2458.29, BIC = 2489.92
## Pseudo-R² (fixed effects) = 0.42
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.23 0.13 -1.87 360.49 0.06
## OPQ 0.70 0.02 36.95 1379.47 0.00
## Knowledge 0.14 0.06 2.19 354.63 0.03
## ImageNature -0.05 0.02 -2.48 1087.27 0.01
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.70
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------MODEL WITH FOUR PREDICTORS THIS IS THE BEST MODEL: the best significant predictors of WTP are OPQ, Knowledge, Image, Familiarity
WTP9AFK <- lme4::lmer(WTP ~ 1 + OPQ + Knowledge + Image + Familiarity + (1|ID), data = df)
anova(WTP9AF,WTP9AFK)## refitting model(s) with ML (instead of REML)#Significant
jtools::summ(WTP9AFK)## MODEL INFO:
## Observations: 1440
## Dependent Variable: WTP
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 2441.32, BIC = 2478.23
## Pseudo-R² (fixed effects) = 0.41
## Pseudo-R² (total) = 0.85
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) -0.19 0.13 -1.48 366.01 0.14
## OPQ 0.67 0.02 34.22 1394.45 0.00
## Knowledge 0.14 0.06 2.24 355.60 0.03
## ImageNature -0.05 0.02 -2.22 1089.51 0.03
## FamiliarityLow -0.11 0.02 -4.99 1106.82 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.70
## Residual 0.41
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.75
## -------------------------PLOT OF THE BEST MODEL
WTP9AFKp <- ggpredict(WTP9AFK, terms = c("OPQ","Knowledge", "Image", "Familiarity"))
WTP9AFKplot <- ggplot(WTP9AFKp, aes(x, predicted)) +
#geom_line() +
#geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1)+
geom_point()+
#geom_smooth(method="lm", se =T)+
geom_smooth(method=glm, aes(group = 1), se = T)+
scale_color_brewer(palette="Dark2")+ jtools::theme_nice()# + ylim(-2,2)+ xlim(-2,2)
WTP9AFKplot## `geom_smooth()` using formula 'y ~ x'
MEDIATORS - PREDICTORS OF OPQ
PQ0 <- lme4::lmer(OPQ ~ 1 + (1|ID), data = df)
PQ1 <- lme4::lmer(OPQ ~ 1 + Age + (1|ID), data = df)
PQ2 <- lme4::lmer(OPQ ~ 1 + Sex + (1|ID), data = df)
PQ3 <- lme4::lmer(OPQ ~ 1 + Frequency + (1|ID), data = df)
PQ4 <- lme4::lmer(OPQ ~ 1 + Quantity + (1|ID), data = df)
PQ5 <- lme4::lmer(OPQ ~ 1 + Knowledge + (1|ID), data = df)
PQ6 <- lme4::lmer(OPQ ~ 1 + Image + (1|ID), data = df)
PQ7 <- lme4::lmer(OPQ ~ 1 + Familiarity + (1|ID), data = df)
PQ8 <- lme4::lmer(OPQ ~ 1 + Income + (1|ID), data = df)
PQ9 <- lme4::lmer(OPQ ~ 1 + Risk3 + (1|ID), data = df)
PQ10 <- lme4::lmer(OPQ ~ 1 + RiskTotal + (1|ID), data = df)
anova(PQ0,PQ1)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ0,PQ2)## refitting model(s) with ML (instead of REML)#Signficant
anova(PQ0,PQ3)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ0,PQ4)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ0,PQ5)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ0,PQ6)## refitting model(s) with ML (instead of REML)#Significant
anova(PQ0,PQ7)## refitting model(s) with ML (instead of REML)#Significant
anova(PQ0,PQ8)## refitting model(s) with ML (instead of REML)#Non-Significant
anova(PQ0,PQ9)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ0,PQ10)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ2,PQ6)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ2,PQ7)## refitting model(s) with ML (instead of REML)#NON-Significant
anova(PQ2,PQ8)## refitting model(s) with ML (instead of REML)#NON-SignificantRANKING: WORST TO BEST MODEL BASED ON R-SQUARED AND BETA COEFFICIENT
jtools::summ(PQ2)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3413.54, BIC = 3434.63
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.61
##
## FIXED EFFECTS:
## ---------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- -------- ------
## (Intercept) 0.09 0.06 1.55 358.00 0.12
## SexMale -0.19 0.09 -2.16 358.00 0.03
## ---------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.76
## Residual 0.62
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.60
## -------------------------jtools::summ(PQ6)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3373.36, BIC = 3394.45
## Pseudo-R² (fixed effects) = 0.01
## Pseudo-R² (total) = 0.62
##
## FIXED EFFECTS:
## ----------------------------------------------------------
## Est. S.E. t val. d.f. p
## ----------------- ------- ------ -------- --------- ------
## (Intercept) -0.11 0.05 -2.33 458.88 0.02
## ImageNature 0.22 0.03 6.91 1079.00 0.00
## ----------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.77
## Residual 0.60
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.62
## -------------------------jtools::summ(PQ7)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3310.67, BIC = 3331.76
## Pseudo-R² (fixed effects) = 0.03
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.17 0.05 3.64 453.08 0.00
## FamiliarityLow -0.33 0.03 -10.73 1079.00 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.77
## Residual 0.59
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.63
## -------------------------MODELS WITH TWO PREDICTORS COMPARISONS AGAINST THE SINGLE PREDICTOR MODEL
PQ9A <- lme4::lmer(OPQ ~ 1 + Familiarity + Image + (1|ID), data = df)
PQ9B <- lme4::lmer(OPQ ~ 1 + Familiarity + Sex + (1|ID), data = df)
PQ9C <- lme4::lmer(OPQ ~ 1 + Familiarity + Image + Sex + (1|ID), data = df)
anova(PQ7,PQ9A)## refitting model(s) with ML (instead of REML)#Sig
anova(PQ7,PQ9B)## refitting model(s) with ML (instead of REML)#Sig
anova(PQ9A,PQ9C)## refitting model(s) with ML (instead of REML)Worst to Best Model
jtools::summ(PQ9B)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3311.09, BIC = 3337.46
## Pseudo-R² (fixed effects) = 0.04
## Pseudo-R² (total) = 0.64
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.26 0.06 4.14 404.89 0.00
## FamiliarityLow -0.33 0.03 -10.73 1079.00 0.00
## SexMale -0.19 0.09 -2.16 358.00 0.03
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.77
## Residual 0.59
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.63
## -------------------------jtools::summ(PQ9A)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3265.94, BIC = 3292.30
## Pseudo-R² (fixed effects) = 0.04
## Pseudo-R² (total) = 0.66
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.06 0.05 1.20 542.51 0.23
## FamiliarityLow -0.33 0.03 -10.99 1078.00 0.00
## ImageNature 0.22 0.03 7.29 1078.00 0.00
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.77
## Residual 0.57
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.65
## -------------------------jtools::summ(PQ9C)## MODEL INFO:
## Observations: 1440
## Dependent Variable: OPQ
## Type: Mixed effects linear regression
##
## MODEL FIT:
## AIC = 3266.37, BIC = 3298.00
## Pseudo-R² (fixed effects) = 0.05
## Pseudo-R² (total) = 0.66
##
## FIXED EFFECTS:
## -------------------------------------------------------------
## Est. S.E. t val. d.f. p
## -------------------- ------- ------ -------- --------- ------
## (Intercept) 0.15 0.06 2.33 448.83 0.02
## FamiliarityLow -0.33 0.03 -10.99 1078.00 0.00
## ImageNature 0.22 0.03 7.29 1078.00 0.00
## SexMale -0.19 0.09 -2.16 358.00 0.03
## -------------------------------------------------------------
##
## p values calculated using Satterthwaite d.f.
##
## RANDOM EFFECTS:
## ------------------------------------
## Group Parameter Std. Dev.
## ---------- ------------- -----------
## ID (Intercept) 0.77
## Residual 0.57
## ------------------------------------
##
## Grouping variables:
## -------------------------
## Group # groups ICC
## ------- ---------- ------
## ID 360 0.64
## -------------------------PLOT OF THE BEST MODEL
PQp <- ggpredict(PQ7, terms = "Familiarity", type = "random")
PQplot <- ggplot(PQp, aes(x, predicted)) +
geom_line() +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .1)+
geom_point(data = df, aes(x = Familiarity, y = OPQ))+
geom_smooth(method="lm", se =T)+
geom_smooth(method=lm, aes(group = 1), se = T)+
scale_color_brewer(palette="Dark2")+ jtools::theme_nice() #+ ylim(-2,2)+ xlim(-2,2)
PQplot## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'## Warning in qt((1 - level)/2, df): NaNs produced## geom_path: Each group consists of only one observation. Do you need to adjust
## the group aesthetic?## Warning in max(ids, na.rm = TRUE): no non-missing arguments to max; returning
## -Inf
USING THE MEDIATE PACKAGE TO EXPLORE THE MEDIATING EFFECTS
WTP - FAMILIARITY AND OPQ Significant Direct Effect But the Mediating Effect is Much Larger
med.fit.WTP1 <- lme4::lmer(OPQ ~ 1 + Familiarity + (1|ID), data = df)
out.fit.WTP1 <- lme4::lmer(WTP ~ 1 + OPQ*Familiarity + (1|ID), data = df)
med.out.WTP1 <- mediate(med.fit.WTP1, out.fit.WTP1, treat = "Familiarity", mediator = "OPQ", sims = 100)## Warning in mediate(med.fit.WTP1, out.fit.WTP1, treat = "Familiarity", mediator =
## "OPQ", : treatment and control values do not match factor levels; using High and
## Low as control and treatment, respectivelysummary(med.out.WTP1)##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Mediator Groups: ID
##
## Outcome Groups: ID
##
## Output Based on Overall Averages Across Groups
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME (control) -0.214 -0.250 -0.18 <2e-16 ***
## ACME (treated) -0.218 -0.253 -0.18 <2e-16 ***
## ADE (control) -0.118 -0.158 -0.08 <2e-16 ***
## ADE (treated) -0.122 -0.161 -0.08 <2e-16 ***
## Total Effect -0.336 -0.384 -0.29 <2e-16 ***
## Prop. Mediated (control) 0.637 0.537 0.73 <2e-16 ***
## Prop. Mediated (treated) 0.657 0.544 0.75 <2e-16 ***
## ACME (average) -0.216 -0.250 -0.18 <2e-16 ***
## ADE (average) -0.120 -0.158 -0.08 <2e-16 ***
## Prop. Mediated (average) 0.647 0.544 0.73 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 1440
##
##
## Simulations: 100PLOT - WTP - FAMILIARITY AND OPQ Significant Direct Effect But the Mediating Effect is Much Larger
plot(med.out.WTP1)
WTP - IMAGE AND OPQ Significant Direct Effect But the Mediating Effect is Much Larger
med.fit.WTP2 <- lme4::lmer(OPQ ~ 1 + Image + (1|ID), data = df)
out.fit.WTP2 <- lme4::lmer(WTP ~ 1 + OPQ*Image + (1|ID), data = df)
med.out.WTP2 <- mediate(med.fit.WTP2, out.fit.WTP2, treat = "Image", mediator = "OPQ", sims = 100)## Warning in mediate(med.fit.WTP2, out.fit.WTP2, treat = "Image", mediator =
## "OPQ", : treatment and control values do not match factor levels; using Humorous
## and Nature as control and treatment, respectivelysummary(med.out.WTP2)##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Mediator Groups: ID
##
## Outcome Groups: ID
##
## Output Based on Overall Averages Across Groups
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME (control) 0.1618 0.1164 0.21 <2e-16 ***
## ACME (treated) 0.1472 0.1067 0.19 <2e-16 ***
## ADE (control) -0.0470 -0.0998 -0.01 0.04 *
## ADE (treated) -0.0616 -0.1113 -0.03 <2e-16 ***
## Total Effect 0.1002 0.0287 0.15 <2e-16 ***
## Prop. Mediated (control) 1.5768 1.2043 4.48 <2e-16 ***
## Prop. Mediated (treated) 1.4577 1.0852 4.19 <2e-16 ***
## ACME (average) 0.1545 0.1117 0.20 <2e-16 ***
## ADE (average) -0.0543 -0.1063 -0.02 <2e-16 ***
## Prop. Mediated (average) 1.5172 1.1508 4.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 1440
##
##
## Simulations: 100PLOT - WTP - IMAGE AND OPQ Significant Direct Effect But the Mediating Effect is Much Larger
plot(med.out.WTP2)
WTB - FAMILIARITY AND OPQ Significant Direct Effect But the Mediating
Effect is Much Larger
med.fit.WTB1 <- lme4::lmer(OPQ ~ 1 + Familiarity + (1|ID), data = df)
out.fit.WTB1 <- lme4::lmer(WTB ~ 1 + OPQ*Familiarity + (1|ID), data = df)
med.out.WTB1 <- mediate(med.fit.WTB1, out.fit.WTB1, treat = "Familiarity", mediator = "OPQ", sims = 100)## Warning in mediate(med.fit.WTB1, out.fit.WTB1, treat = "Familiarity", mediator =
## "OPQ", : treatment and control values do not match factor levels; using High and
## Low as control and treatment, respectivelysummary(med.out.WTB1)##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Mediator Groups: ID
##
## Outcome Groups: ID
##
## Output Based on Overall Averages Across Groups
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME (control) -0.275 -0.330 -0.22 <2e-16 ***
## ACME (treated) -0.260 -0.310 -0.21 <2e-16 ***
## ADE (control) -0.125 -0.163 -0.08 <2e-16 ***
## ADE (treated) -0.110 -0.152 -0.06 <2e-16 ***
## Total Effect -0.385 -0.456 -0.31 <2e-16 ***
## Prop. Mediated (control) 0.713 0.620 0.83 <2e-16 ***
## Prop. Mediated (treated) 0.676 0.591 0.76 <2e-16 ***
## ACME (average) -0.267 -0.319 -0.22 <2e-16 ***
## ADE (average) -0.118 -0.159 -0.07 <2e-16 ***
## Prop. Mediated (average) 0.694 0.609 0.79 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 1440
##
##
## Simulations: 100PLOT - WTB - FAMILIARITY AND OPQ Significant Direct Effect But the Mediating Effect is Much Larger
plot(med.out.WTB1)
WTB - IMAGE AND OPQ NON-Significant Direct Effect. The Mediating Effect is SIGNIFICANT and Much Larger
med.fit.WTB2 <- lme4::lmer(OPQ ~ 1 + Image + (1|ID), data = df)
out.fit.WTB2 <- lme4::lmer(WTB ~ 1 + OPQ*Image + (1|ID), data = df)
med.out.WTB2 <- mediate(med.fit.WTB2, out.fit.WTB2, treat = "Image", mediator = "OPQ", sims = 100)## Warning in mediate(med.fit.WTB2, out.fit.WTB2, treat = "Image", mediator =
## "OPQ", : treatment and control values do not match factor levels; using Humorous
## and Nature as control and treatment, respectivelysummary(med.out.WTB2) ##
## Causal Mediation Analysis
##
## Quasi-Bayesian Confidence Intervals
##
## Mediator Groups: ID
##
## Outcome Groups: ID
##
## Output Based on Overall Averages Across Groups
##
## Estimate 95% CI Lower 95% CI Upper p-value
## ACME (control) 0.1910 0.1354 0.25 <2e-16 ***
## ACME (treated) 0.1829 0.1311 0.24 <2e-16 ***
## ADE (control) -0.0310 -0.0781 0.03 0.16
## ADE (treated) -0.0391 -0.0841 0.02 0.10 .
## Total Effect 0.1519 0.0858 0.23 <2e-16 ***
## Prop. Mediated (control) 1.2488 0.9137 1.80 <2e-16 ***
## Prop. Mediated (treated) 1.1898 0.8926 1.73 <2e-16 ***
## ACME (average) 0.1869 0.1336 0.25 <2e-16 ***
## ADE (average) -0.0351 -0.0805 0.02 0.12
## Prop. Mediated (average) 1.2193 0.8967 1.77 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Sample Size Used: 1440
##
##
## Simulations: 100PLOT - WTB - IMAGE AND OPQ NON-Significant Direct Effect. The Mediating Effect is SIGNIFICANT and Much Larger
plot(med.out.WTB2)