```{r setup, include=FALSE}
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
# packages
library(ez)
library(reshape2)
library(reshape)
library(ggplot2)
library(plyr)
library(pastecs)
library(ez)
library(data.table)
library(tidyverse) 

library(showtext)
library(readr)


font_add_google("Poppins", "Poppins")
font_add_google("Roboto Mono", "Roboto Mono")
showtext_auto()
```


```{r}
tdata <- read_csv("exp_data.csv")
```


# Subject demographics

```{r}
# demographics 

min(tdata$age)
max(tdata$age)
mean(tdata$age)
sd(tdata$age)

# 1 = male, 2 = female, 3 = other
table(tdata$gender)
```

1 = male, 2 = female, 3 = non-binary, 4 = prefer not to say



```{r}
table(tdata$dv_query, tdata$outcome_valence)
```

```{r}
# check width of the means 95% cis (none is supposed to be grater than 1)

library(rcompanion)
ci_table <- groupwiseMean(DV_rating ~ dv_query + outcome_valence,
              data        = tdata,
              traditional = FALSE,
              percentile  = TRUE)



(ci_width <- ci_table$Percentile.upper - ci_table$Percentile.lower)
```

```{r}
library(dplyr)

tdata %>%
  group_by(dv_query) %>%
  summarise_at(vars(DV_rating), list(name=var))
```




# Results

## Graphs

```{r}
myTheme <- theme(plot.title = element_text(face="bold", size = 22),
        axis.title.x = element_text(size = 20),
        axis.title.y = element_text(size = 20),
        axis.text.x = element_text(size = 14, angle = 0), 
        axis.text.y = element_text(size = 16, angle = 0),
        legend.text = element_text(size = 18),
        legend.title = element_text(face = "bold", size = 18),
        strip.text.x = element_text(size = 18),
        strip.text.y = element_text(size = 18),
        #panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(), 
        panel.background = element_blank(), 
        axis.line.x = element_line(colour = "black"), 
        axis.line.y = element_line(colour = "black"),
        axis.text = element_text(colour ="black"), 
        axis.ticks = element_line(colour ="black"))

tdata_long <- tdata
tdata_sub <- tdata_long


library(see)
## first, turn sID into a factor
tdata_sub$subj_code <- factor(tdata_sub$subj_code)

pd <- position_dodge(width = 0.3)

tdata_sub$valueJitter <- jitter(tdata_sub$rating_rec, factor = 0.01, amount = 0.004)

theme_set(theme_light(base_size = 20, base_family = "Poppins"))

# new labels for the facets 
query.labs <- c("test question: probability", "test question: satisfaction")
names(query.labs) <- c("probability", "satisfaction")


g <- ggplot(tdata_sub, aes(x = outcome_valence, y = valueJitter)) +
  #guides(fill=FALSE)+
  facet_grid( ~ dv_query, labeller = labeller(dv_query = query.labs))+
  #ggtitle("Subjects' causal srength ratings") +
  scale_y_continuous(limits = c(-5.3, 5.3), breaks=seq(-5, 5, 1), expand = c(0,0)) +
  #scale_x_discrete(labels=c("no \ninformation", "'You don't \nknow'")) +
  #stat_summary(fun.y = mean, geom = "bar", position = "dodge", colour = "black", alpha =0.5) +
  geom_violinhalf(aes(y = rating_rec, group = outcome_valence, fill = outcome_valence), color = NA, 
                  position=position_dodge(1), alpha = 0.4)+
  #geom_line(position = pd, color = "black", size = 1, alpha=0.04) +
  geom_hline(yintercept=0, linetype="dashed", color = "black")+
  geom_jitter(aes(color = outcome_valence), alpha = 0.5, width = 0.15, height = 0.2) +
  stat_summary(aes(y = rating_rec, group=1), fun.data = mean_cl_boot, 
               geom = "errorbar", width = 0, size = 1) +
  stat_summary(aes(y = rating_rec, group=1, color = outcome_valence), fun.y=mean, geom="line", 
               color = "black", shape = 22, size = 1, alpha = .7)+
  stat_summary(aes(y = rating_rec, group=1, fill = outcome_valence), fun.y=mean, geom="point", 
               color = "black", shape = 22, size = 2, group=1, alpha = 1)+
  stat_summary(aes(y = rating_rec,group=1), fun.y=median, geom="point", color = "black", shape = 3, size = 4, 
               group=1, alpha = 1, position = position_dodge(width = 0.5))+
  labs(x = "Feature valence", y = "Explanation rating") +
  scale_color_manual(name = "Strength",values=c("#66c2a5", "#e78ac3", "#8da0cb", "#a6d854"))+
  scale_fill_manual(name = "Strength",values=c("#66c2a5", "#e78ac3", "#8da0cb", "#a6d854"))+
  annotate("text", x = 0.5, y = 3.5, label = c("broad-scope"), angle = 90)+
  annotate("text", x = 0.5, y = -3.5, label = c("narrow-scope"), angle = 90)+
  theme(legend.position = "none")+
  myTheme+
   theme(panel.grid.major = element_line(color = "lightgrey",
                                        size = 0.5,
                                        linetype = 'dotted'))+
  stat_summary(aes(label=round(after_stat(y),2)), fun.y=mean, geom="text", size=5,
             vjust = -6)
g


ggsave("results_means_mainDV.svg",width=8,height=5)
ggsave("results_means_mainDV.pdf",width=8,height=5)
```

```{r}
tdata_sub_g2 <- tdata_sub
tdata_sub_g2$cond_combined <- str_c(tdata_sub_g2$dv_query, ' ', tdata_sub_g2$outcome_valence) 


library(ggridges)
g2 <- ggplot(tdata_sub_g2, aes(x = rating_rec, y = cond_combined, fill = after_stat(x))) +
  geom_density_ridges_gradient() +
  #geom_density_ridges(fill = "lightblue", alpha = 0.5)+
   #stat_summary(aes(x = rating_rec), fun.x=mean, geom="point", 
  #             color = "black", shape = 22, size = 2, group=1, alpha = 1)+
  scale_fill_viridis_c(name = "Explanation \nRating", option = "C")+
  labs(x = "Rating", y = "Category Features") +
  myTheme

g2
```


Get the values of the CIs shown in the first plot:

```{r}
values <- ggplot_build(g)$data[[4]] # values are shown in the 4th panel 
values
```


get group medians: 

```{r}
# groupwiseMean(rating_rec ~ Features + Knowledge,
#               data        = tdata_long,
#               traditional = FALSE,
#               percentile  = TRUE)

groupwiseMedian(rating_rec ~ dv_query + outcome_valence,
                data        = tdata_long,
                bca         = FALSE,
                percentile  = TRUE,
                R           = 1000)
```




```{r}
counts <- tdata_long %>%
  group_by(dv_query, outcome_valence, rating_rec) %>%
  summarize(n = n()) %>% 
  mutate(pct = n/sum(n),
         lbl = scales::percent(pct))

counts
# shows that 0 is the mode in all conditions
```




```{r}

tdata_long$category[tdata_long$rating_rec < 0] <- "narrow"
tdata_long$category[tdata_long$rating_rec == 0] <- "unbiased"
tdata_long$category[tdata_long$rating_rec > 0] <- "broad"

counts2 <- tdata_long %>%
  group_by(dv_query, outcome_valence, category) %>%
  summarize(n = n()) %>% 
  mutate(pct = n/sum(n),
         lbl = scales::percent(pct))

counts2

counts2$category <- factor(counts2$category, levels = c("unbiased", "narrow", "broad"), labels = c("unbiased", "narrow l.s.", "broad l.s."))

```


Get proportion CIs for different categories in each diagnosability condition:

```{r}
library(PropCIs)
library(DescTools)
library(purrr)

counts_prob_neg <- subset(counts2, dv_query == "probability" & outcome_valence == "negative")
counts_prob_pos <- subset(counts2, dv_query == "probability" & outcome_valence == "positive")

counts_sat_neg <- subset(counts2, dv_query == "satisfaction" & outcome_valence == "negative")
counts_sat_pos <- subset(counts2, dv_query == "satisfaction" & outcome_valence == "positive")



(MultinomCI(counts_prob_neg$n,
           conf.level=0.95,
           method="sisonglaz") -> selection_ci_1)
  
(MultinomCI(counts_sat_neg$n,
           conf.level=0.95,
           method="sisonglaz") -> selection_ci_3)

(MultinomCI(counts_prob_pos$n,
           conf.level=0.95,
           method="sisonglaz") -> selection_ci_2)

(MultinomCI(counts_sat_pos$n,
           conf.level=0.95,
           method="sisonglaz") -> selection_ci_4)
  



ci_low <- c(selection_ci_1[,2], selection_ci_2[,2], selection_ci_3[,2], selection_ci_4[,2])

ci_up <- c(selection_ci_1[,3], selection_ci_2[,3], selection_ci_3[,3], selection_ci_4[,3])


```


```{r}
plotdata <- counts2

plotdata$ci_low <- ci_low
plotdata$ci_up <- ci_up
```


Plot:

```{r}

library(scales)
theme_set(theme_light(base_size = 13, base_family = "Poppins"))

library(grid)

# new labels for the facets 
query.labs <- c("test question: probability", "test question: satisfaction")
names(query.labs) <- c("probability", "satisfaction")

# new labels for the facets 
valence.labs <- c("feature valence: negative", "feature valence: positive")
names(valence.labs) <- c("negative", "positive")


g<- ggplot(plotdata, 
       aes(x = category,
           y = pct,
           fill = outcome_valence)) +
  facet_grid(dv_query ~ outcome_valence, labeller = labeller(outcome_valence = valence.labs, dv_query = query.labs))+
  geom_bar(stat = "identity",
           position = "dodge") +
  scale_y_continuous(limits = seq(0, 1.2),
                     breaks = seq(0, 1, .25),
                     expand = c(0,0),
                     label = percent) +
  #coord_cartesian(xlim =c(1, 7), ylim = c(0, 1.1))+
  #coord_cartesian(clip = "off")+
  geom_text(aes(label = lbl), 
            size = 3.5,
            position = position_dodge(width = 1),
            vjust = -3) +
  scale_fill_manual(name = "Strength",values=c("#66c2a5", "#e78ac3", "#8da0cb", "#a6d854"))+
  #scale_fill_brewer(palette = "Pastel1") +
  labs(y = "Percentage", 
       fill = "Explanatory preference",
       x = "Explanatory preference")+
  geom_pointrange(ymin = ci_low, ymax = ci_up, position = position_dodge(width = 0.89), shape = 22, size = 0.3)+
  #annotate(geom = "hline",yintercept = 0.5, y = 0.5, color = "black", size = 1, linetype='dotted')+
  #annotate("pointrange", x = plotdata$Transformation, y = plotdata$pct, 
   #        ymin = plotdata$ci_low, 
    #       ymax = plotdata$ci_up, 
     #      colour = "black", size = 0.8, shape = 22, fill = Transformation, fatten = 1)+
  #annotate("text", x = pvalues_x, y = Inf, label = pvalues, size = 4, vjust = 1.8)+
  theme(legend.position = "none", axis.title = element_text(size = 20), axis.text = element_text(size = 13, color = "black"),
        legend.text = element_text(size = 13),legend.title = element_text(size = 13),strip.text = element_text(size = 13))+
  theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
  theme(panel.spacing.y = unit(1, "lines"))

g

#ggsave("selections_between.pdf",width=6,height=5)
ggsave("categories.svg",width=7.5,height=6)
ggsave("categories.pdf",width=7.5,height=6)
```


## Analyses

```{r, echo = FALSE, warning = FALSE, message = FALSE}
################################################################################################################
##################################### Statistical Analyses #####################################################
################################################################################################################
library(pastecs)
library(lme4)
library(nlme)
library(ez)
library(vtable)
library(rcompanion)
```


### ANOVA 

```{r}
library(afex)
library(emmeans)

a1 <- aov_car(rating_rec ~ dv_query*outcome_valence + Error(subj_code), tdata_long, anova_table = list(es = "pes"))
a1

```
more digits for the p.values can be obtained by running model comparisons manually.

```{r}
null <- lme(rating_rec ~ 1, random = ~1|subj_code, data = tdata_long, method = "ML")

main_query <- lme(rating_rec ~ dv_query, random = ~1|subj_code, data = tdata_long, method = "ML")

anova(null, main_query)
```


```{r}
main_valence <- lme(rating_rec ~ dv_query + outcome_valence, random = ~1|subj_code, data = tdata_long, method = "ML")

anova(null, main_query, main_valence)
```


```{r}
interaction <- lme(rating_rec ~ dv_query*outcome_valence, random = ~1|subj_code, data = tdata_long, method = "ML")

anova(null, main_query, main_valence, interaction)
```



### Contrasts

```{r}
############### 
# a follow-up analysis 
library(lsmeans)
# means

ls2 <- lsmeans(a1, c("dv_query", "outcome_valence")) # group means by between-condition
ls2

# contrast the strength levels (main effect; averaging over decision level, as there was no sig. interaction)
contrasts <- emmeans(a1, ~ dv_query*outcome_valence)
s <- pairs(contrasts, adjust = "none") # no need to adjust because one single contrast was planned a priori (the interaction contrast)


s
confint(s, level = 0.95)
```

```{r}
############### 
# a follow-up analysis 
library(lsmeans)
# means

ls2 <- lsmeans(a1, c("dv_query", "outcome_valence")) # group means by between-condition
ls2

# contrast the strength levels (main effect; averaging over decision level, as there was no sig. interaction)
contrasts <- emmeans(a1, ~ dv_query*outcome_valence)
s <- pairs(pairs(contrasts), adjust = "none") # no need to adjust because one single contrast was planned a priori (the interaction contrast)


s
confint(s, level = 0.95)
```

## Proportion tests 

1. Test if the proportion of subjects in the negative-effects condition who selected the narrow latent scope explanation was higher when asked about satisfaction than when asked about probability: 

```{r}
neg_prob_vs_sat <- prop.test(x = c(plotdata$n[2], plotdata$n[8]), n = c(50, 104), alternative = "less", correct = F)
neg_prob_vs_sat 
```
2. Test if the proportions of subjects in the positive-effects condition who selected the broad scope explanation was higher when asked about satisfaction than when asked about probability: 

```{r}
# Note: Yates' correction is turned off, because it is recommended only if a cell contains less than 5 observations see: https://en.wikipedia.org/wiki/Yates%27s_correction_for_continuity) 

pos_prob_vs_sat <- prop.test(x = c(plotdata$n[4], plotdata$n[10]), n = c(50, 104), alternative = "less", correct = F)
pos_prob_vs_sat 
```

