{"id":17949338,"url":"https://github.com/helske/statvis","last_synced_at":"2026-02-16T01:08:56.760Z","repository":{"id":79595240,"uuid":"206002369","full_name":"helske/statvis","owner":"helske","description":"Can visualization alleviate dichotomous thinking? Effects of visual representations on the cliff effect","archived":false,"fork":false,"pushed_at":"2021-04-21T05:29:44.000Z","size":25598,"stargazers_count":7,"open_issues_count":0,"forks_count":0,"subscribers_count":2,"default_branch":"master","last_synced_at":"2025-02-09T04:26:18.287Z","etag":null,"topics":["bayesian-inference","brms","confidence-intervals","p-values","uncertainty-visualisation","visualization"],"latest_commit_sha":null,"homepage":"","language":"HTML","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":null,"status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/helske.png","metadata":{"files":{"readme":"README.Rmd","changelog":null,"contributing":null,"funding":null,"license":null,"code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null,"governance":null,"roadmap":null,"authors":null,"dei":null,"publiccode":null,"codemeta":null}},"created_at":"2019-09-03T06:14:31.000Z","updated_at":"2023-06-19T14:53:47.000Z","dependencies_parsed_at":"2023-05-13T00:00:12.000Z","dependency_job_id":null,"html_url":"https://github.com/helske/statvis","commit_stats":null,"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/helske%2Fstatvis","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/helske%2Fstatvis/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/helske%2Fstatvis/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/helske%2Fstatvis/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/helske","download_url":"https://codeload.github.com/helske/statvis/tar.gz/refs/heads/master","host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":247029705,"owners_count":20871946,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2022-07-04T15:15:14.044Z","host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":["bayesian-inference","brms","confidence-intervals","p-values","uncertainty-visualisation","visualization"],"created_at":"2024-10-29T09:16:18.391Z","updated_at":"2026-02-16T01:08:51.735Z","avatar_url":"https://github.com/helske.png","language":"HTML","funding_links":[],"categories":[],"sub_categories":[],"readme":"---\ntitle: \"Can visualization alleviate dichotomous thinking? Effects of visual representations on the cliff effect\"\nauthor: \"Jouni Helske, Satu Helske, Matthew Cooper, Anders Ynnerman, Lonni Besançon\"\ndate: \"13/4/2020\"\noutput: \n  github_document:\n    fig_width: 12\n    fig_height: 12\n    toc: true\n    toc_depth: 3\n---\n\n```{r setup, include=FALSE}\nknitr::opts_chunk$set(echo = TRUE, width = 150)\n```\n\n\n# What is this\n\nThis repository contains data and scripts for reproducing the analysis of the paper *Can visualization alleviate dichotomous thinking? Effects of visual representations on the cliff effect* by Jouni Helske, Satu Helske, Matthew Cooper, Anders Ynnerman, and Lonni Besançon. \n\nThis Rmd file contains full scripts (and extra stuff) to reproduce figures in the paper.\n\nThe raw data for both experiments can be found in folders `experiment1/data/` and `experiment2/data/` respectively, which also contains the R data frames used in the analysis (`exp1_data.rds` and `exp2_data.rds`). The web pages for the surveys are in folder `web`, with some screenshots in folder `screenshots`.\n\n\n## One-sample experiment\n\n### Creating the dataset\n\nFirst, we load some packages:\n```{r load_packages}\nsuppressPackageStartupMessages({\n  library(brms)\n  library(modelr)\n  library(ggplot2)\n  library(dplyr)\n  library(jsonlite)\n  library(loo)\n  library(ggthemes)\n})\n```\n\nThen we transform the raw data to suitable format for analysis:\n\n```{r create_data_exp1, eval = FALSE}\npath \u003c- \"experiment1/data\"\nanswers \u003c- list.files(path, pattern=\"answers\", full.names = TRUE)\n\n# fetch number of participants\nn \u003c- length(answers)\n\n# create a data frame for the results\ndata_raw \u003c- data.frame(id = rep(1:n, each = 32), viz = NA, replication = NA, value = NA,\n  expertise = NA, degree = NA, age = NA, experience = NA, tools = NA)\n\n# read in answers, not optimal way will do\nfor(i in 1:n){\n  x \u003c- strsplit(fromJSON(answers[i]), \",\")\n  dem \u003c- fromJSON(paste0(path,  \"/demography\", x[[1]][1], \".txt\"))\n  for(j in 1:32) {\n    data_raw[32*(i-1) + j, c(\"id\", \"viz\", \"replication\", \"value\")] \u003c- x[[j]]\n    data_raw[32*(i-1) + j, c(\"expertise\", \"degree\", \"age\", \"experience\", \"tools\")] \u003c- \n      dem[c(\"expertise\", \"level\", \"age\", \"experience\", \"tools\")]\n  }\n}\nsaveRDS(data_raw, file = \"experiment1/data/data_raw.rds\")\n# remove person who didn't answer reasonably on the demography part\n# Degree is None and more importantly expertise is 1..?\ndata \u003c- data_raw[data_raw$degree != \"None\",]\n\n# true p-values\ntrue_p \u003c- c(0.001, 0.01, 0.04, 0.05, 0.06, 0.1, 0.5, 0.8)\n\n# convert to factors and numeric\ndata \u003c- data %\u003e% mutate(n = factor(ifelse(as.numeric(id) %% 8 \u003c 4, 50, 200)),\n  id = factor(id),\n  viz = relevel(factor(viz, labels = c(\"CI\", \"gradient\", \"p\", \"violin\")), \"p\"),\n  replication = as.numeric(replication),\n  value = as.numeric(value),\n  p = true_p[replication],\n  true_p = factor(p), # for monotonic but non-linear effect on confidence\n  confidence = (value - 1) / 99,\n  expertise = factor(expertise)) %\u003e% arrange(id, viz)\n\n\n# Classify expertise\ndata$expertise \u003c- recode_factor(data$expertise, \n  \n  \"Statistics\" = \"Stats/ML\",\n  \"statistics\" = \"Stats/ML\",\n  \"statistics/machine learning\" = \"Stats/ML\",\n  \"Analytics\" = \"Stats/ML\",\n  \"Statistics/Medicine\" = \"Stats/ML\",\n  \"Data science\" = \"Stats/ML\",\n  \"Biostatistics\" = \"Stats/ML\",\n  \"IT \u0026 Business Data Science\" = \"Stats/ML\",\n  \"methods\" = \"Stats/ML\",\n  \"AI\" = \"Stats/ML\",\n  \"Neuroscience and Statistics\" = \"Stats/ML\",\n  \"Computer vision\" = \"Stats/ML\",\n  \"Psychometric\" = \"Stats/ML\",\n  \n  \"HCI, Visualization\" = \"VIS/HCI\",\n  \"HCI/Visualization\" = \"VIS/HCI\",\n  \"interaction design and evaluation\" = \"VIS/HCI\",\n  \"Human-Computer Interaction\" = \"VIS/HCI\",\n  \"HCI\" = \"VIS/HCI\",\n  \"Vis\" = \"VIS/HCI\",\n  \"Visualization\" = \"VIS/HCI\",\n  \"Data Visualization\" = \"VIS/HCI\",\n  \"CS, Visualization, HCI\" = \"VIS/HCI\",\n  \"Infovis\" = \"VIS/HCI\",\n  \"Visualization / Computer Science\" = \"VIS/HCI\",\n  \"Virtual Reality\" = \"VIS/HCI\",\n  \"Visualisation\" = \"VIS/HCI\",\n  \"research in HCI\" = \"VIS/HCI\",\n  \"Computer science\" = \"VIS/HCI\",\n  \"Computer Science\" = \"VIS/HCI\",\n  \n  \"Social science\" = \"Social science and humanities\",\n  \"Political science\" = \"Social science and humanities\",\n  \"sociology\" = \"Social science and humanities\",\n  \"Sociology\" = \"Social science and humanities\",\n  \"Analytical Sociology\" = \"Social science and humanities\",\n  \"Education research\" = \"Social science and humanities\",\n  \"Economics\" = \"Social science and humanities\", \n  \"market research\" = \"Social science and humanities\",\n  \"Politics\" = \"Social science and humanities\",\n  \"Finance\" = \"Social science and humanities\",\n  \"Linguistics\" = \"Social science and humanities\",\n  \"Education Poliy\" = \"Social science and humanities\",\n  \"Political Science\" = \"Social science and humanities\",\n  \"Psychology\" =  \"Social science and humanities\",\n  \"psychology\" =  \"Social science and humanities\",\n  \"segregation\" = \"Social science and humanities\",\n  \"Philosophy\" = \"Social science and humanities\",\n  \"organizational science\" = \"Social science and humanities\",\n  \"Strategic Management\" = \"Social science and humanities\",\n  \"network analysis\" = \"Social science and humanities\",\n  \"CSS\" = \"Social science and humanities\",\n  \"Management\" = \"Social science and humanities\",\n  \n  \"Animal science\" = \"Physical and life sciences\",\n  \"Biology\" = \"Physical and life sciences\",\n  \"Botany\" = \"Physical and life sciences\",\n  \"ecology\" = \"Physical and life sciences\",\n  \"Zoology\" = \"Physical and life sciences\",\n  \"Physics\" = \"Physical and life sciences\",\n  \"cognitive neuroscience\" = \"Physical and life sciences\",\n  \"Neuroscience\" = \"Physical and life sciences\",\n  \"neuroscience/motor control\" = \"Physical and life sciences\",\n  \"Biomechanics\" = \"Physical and life sciences\",\n  \"Neurocognitive Psychology\" = \"Physical and life sciences\",\n  \"pharma\" =  \"Physical and life sciences\",\n  \"Public health\" = \"Physical and life sciences\",\n  \"neurobiology\" = \"Physical and life sciences\",\n  \"medicine\" = \"Physical and life sciences\",\n  \"Molcular Biology\" = \"Physical and life sciences\",\n  \"Wind Energy\" = \"Physical and life sciences\",\n  \"Mathematical Biology\" = \"Physical and life sciences\",\n  \"Pain\" = \"Physical and life sciences\",\n  \"genomics\" = \"Physical and life sciences\",\n  \"Medicine\" = \"Physical and life sciences\",\n  \"Water engineering\" = \"Physical and life sciences\")\ndata$expertise \u003c- relevel(data$expertise, \"Stats/ML\")\n```\n\n\n### Descriptive statistics\n\n```{r, cache = TRUE, echo = FALSE}\ndata \u003c- readRDS(\"experiment1/data/exp1_data.rds\")\n```\n\nLet's first look at some descriptive statistic:\n```{r, cache = TRUE}\nids \u003c- which(!duplicated(data$id))\nbarplot(table(data$expertise[ids]))\nbarplot(table(data$degree[ids]))\nhist(as.numeric(data$age[ids]))\n```\n\nLet us now focus on the cliff effect as difference between confidence when $p$-value=0.04 versus $p$-value=0.06:\n```{r cliff_effect_exp1, cache = TRUE}\ndata %\u003e% group_by(id, viz) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz) %\u003e%\n  summarise(\n    mean = mean(difference), \n    median = median(difference),\n    sd = sd(difference), \n    se = sd(difference) / sqrt(length(difference)),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5%\" = quantile(difference, 0.975))\n\ndata %\u003e% group_by(id, viz) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06]) %\u003e%\n  ggplot(aes(x = viz, y = difference)) + \n  geom_violin() +\n  geom_point(alpha = 0.5, position = position_jitter(0.1)) +\n  scale_y_continuous(\"Difference in confidence when p-value is 0.06 vs 0.04\") +\n  scale_x_discrete(\"Representation\") +\n  theme_classic() \n```\n\nThe cliff effect seems to be largest when information is presented as traditional CI or $p$-value which behave similarly. Gradient CI and Violin CI plots are pretty close to each other.\n\nNow same but with subgrouping using sample size:\n```{r cliff_effect_n_exp1, cache = TRUE}\ndata %\u003e% group_by(id, viz, n) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz, n) %\u003e%\n  summarise(\n    mean = mean(difference), \n    median = median(difference),\n    sd = sd(difference), \n    se = sd(difference) / sqrt(length(difference)),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5%\" = quantile(difference, 0.975))\n```\nand expertise:\n```{r cliff_effect_expertise_exp1, cache = TRUE}\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz, expertise) %\u003e%\n  summarise(\n    mean = mean(difference), \n    median = median(difference),\n    sd = sd(difference), \n    se = sd(difference) / sqrt(length(difference)),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5%\" = quantile(difference, 0.975))\n```\n\nIn terms of sample size, there doesn't seem to be clear differences in cliff effect especially when considering medians. In terms of expertise, there seems to be some differences especially in terms of variability (most notably the Violin plot for VIS/HCI), but the differences are likely due to few very extreme cases:\n```{r cliff_effect_n_exp1_plot, cache = TRUE}\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n  summarize(\n    difference = confidence[true_p==0.04] - confidence[true_p==0.06]) %\u003e%\n  ggplot(aes(x=viz, y = difference)) + geom_violin() + theme_classic() + \n  scale_y_continuous(\"Difference in confidence when p-value is 0.04 vs 0.06\") +\n  scale_x_discrete(\"Representation\") +\n  geom_point(aes(colour = expertise), position=position_jitter(0.1))\n```\n\nLet's check how the much extreme answers (full or zero confidence) there are in different groups:\n```{r extreme_exp1, cache = TRUE}\ndata %\u003e% group_by(id, viz, n) %\u003e% \n  mutate(extreme = confidence %in% c(0, 1))  %\u003e% \n  group_by(viz, n) %\u003e%\n  summarise(\n    mean = mean(extreme),\n    sd = sd(extreme), \n    se = sd(extreme) / sqrt(length(extreme)))\n\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n  mutate(extreme = confidence %in% c(0, 1))  %\u003e% \n  group_by(viz, expertise) %\u003e%\n  summarise(\n    mean = mean(extreme),\n    sd = sd(extreme), \n    se = sd(extreme) / sqrt(length(extreme)))\n```\n\nStats/ML and VIS/HCI groups tend to give slightly more extreme answers, but differences are quite small.\n\n\n### Model\n\nFor modelling the data and the potential cliff effect we use piece-wise logit-normal model with following pdf:\n\n$$\np(x)=\\begin{cases}\n\\alpha (1 - \\gamma), \u0026 \\text{if $x = 0$},\\\\\n\\alpha \\gamma, \u0026 \\text{if $x = 1$},\\\\\n(1 - \\alpha) \\phi(logit(x), \\mu, \\sigma), \u0026 \\text{otherwise}.\\\\\n\\end{cases}\n$$\n\nHere $\\alpha = P(x \\in \\{0, 1\\})$ is the probability of answering one of the extreme values (not at all confident or fully confident), and $\\gamma = P(x = 1 \\mid x \\in \\{0, 1\\})$, is the conditional probability of full confidence given that the answer is one of the extremes.\n\nFor $\\mu$,$\\alpha$,$\\gamma$, and $\\sigma$, we define following linear predictors:\n\n$$\n\\begin{align}\n\\begin{split}\n\\mu        \u0026\\sim viz \\cdot I(p \u003c 0.05) \\cdot logit(p) + \nviz \\cdot I(p = 0.05) \\\\ \n\u0026 + (viz + I(p \u003c 0.05) \\cdot logit(p) + I(p = 0.05) \\mid id),\\\\\n\\alpha     \u0026\\sim  p \\cdot viz + (1 \\mid id),\\\\\n\\gamma     \u0026\\sim mo(p),\\\\\n\\sigma     \u0026\\sim viz + (1 \\mid id),\n\\end{split}\n\\end{align}\n$$\nwhere $p$ is a categorical variable defining the true $p$-value, logit($p$) is a continuous variable of the logit-transformed $p$-value, $mo(p)$ denotes a monotonic effect of the $p$-value, the dot corresponds to interaction (\\ie $I(p = 0.05) \\cdot viz$ \\rev{implies} both the main and two-way interaction terms) and $(z \\mid id)$ denotes participant-level random effect for variable $z$. As priors we used the relatively uninformative defaults of the \\texttt{brms} package.\n\nNow in a presence of a cliff effect we should observe a discontinuity in an otherwise linear relationship (in logit-logit scale) between the true $p$-value and participants' confidence. \n\nWe also tested submodels of this model (omitting some of the interactions or random effects), and all of these models gave very similar results. However, this encompassing model integrates over the uncertainty regarding the parameter estimates (with coefficient zero corresponding to simpler model where the variable is omitted) and is that sense \"more Bayesian\" than selecting some of the simpler models (note that we are not particularly interested in predictive performance).\n\nNow we create the necessary functions for our model:\n```{r create_model, eval = TRUE, cache = TRUE}\nstan_funs \u003c- \"\n real logit_p_gaussian_lpdf(real y, real mu, real sigma,\n                            real zoi, real coi) {\n     if (y == 0) { \n       return bernoulli_lpmf(1 | zoi) + bernoulli_lpmf(0 | coi); \n     } else if (y == 1) {\n       return bernoulli_lpmf(1 | zoi) + bernoulli_lpmf(1 | coi);\n     } else { \n       return bernoulli_lpmf(0 | zoi) + normal_lpdf(logit(y) | mu, sigma);\n     } \n                                    }\n  real logit_p_gaussian_rng(real y, real mu, real sigma,\n                            real zoi, real coi) {\n    // 0 or 1\n    int zero_one = bernoulli_rng(zoi);\n    if (zero_one == 1) {\n      // casting to real\n      int one = bernoulli_rng(coi);\n      if (one == 1) {\n        return 1.0;\n      } else {\n        return 0.0;\n      }\n    } else {\n      return inv_logit(normal_rng(mu, sigma));\n    }\n  }\n\"\n\nlog_lik_logit_p_gaussian \u003c- function(i, draws) {\n  # mu \u003c- draws$dpars$mu[, i]\n  # zoi \u003c- draws$dpars$zoi[, i]\n  # coi \u003c- draws$dpars$coi[, i]\n  # sigma \u003c- draws$dpars$sigma\n  # y \u003c- draws$data$Y[i]\n  mu \u003c- brms:::get_dpar(draws, \"mu\", i = i)\n  zoi \u003c- brms:::get_dpar(draws, \"zoi\", i = i)\n  coi \u003c- brms:::get_dpar(draws, \"coi\", i = i)\n  sigma \u003c- brms:::get_dpar(draws, \"sigma\", i = i)\n  y \u003c- draws$data$Y[i]\n  if (y == 0) { \n    dbinom(1, 1, zoi, TRUE) + dbinom(0, 1, coi, TRUE)\n  } else if (y == 1) {\n    dbinom(1, 1, zoi, TRUE) + dbinom(1, 1, coi, TRUE)\n  } else { \n    dbinom(0, 1, zoi, TRUE) + dnorm(qlogis(y), mu, sigma, TRUE)\n  } \n}\n\npredict_logit_p_gaussian \u003c- function(i, draws, ...) {\n  mu \u003c- brms:::get_dpar(draws, \"mu\", i = i)\n  zoi \u003c- brms:::get_dpar(draws, \"zoi\", i = i)\n  coi \u003c- brms:::get_dpar(draws, \"coi\", i = i)\n  sigma \u003c- brms:::get_dpar(draws, \"sigma\", i = i)\n  zero_one \u003c- rbinom(length(zoi), 1, zoi)\n  ifelse(zero_one, rbinom(length(coi), 1, coi), plogis(rnorm(length(mu), mu, sigma)))\n}\n\nfitted_logit_p_gaussian \u003c- function(draws) {\n  mu \u003c- draws$dpars$mu\n  zoi \u003c- draws$dpars$zoi\n  coi \u003c- draws$dpars$coi\n  sigma \u003c- draws$dpars$sigma\n  # no analytical solution for the mean of logistic normal distribution, rely on simulation\n  for (i in 1:ncol(mu)) {\n    for(j in 1:nrow(mu)) {\n      mu[j, i] \u003c- mean(plogis(rnorm(1000, mu[j, i], sigma[j])))\n    }\n  }\n  zoi * coi + (1 - zoi) * mu\n}\n\n\nlogit_p_gaussian \u003c- custom_family(\n  \"logit_p_gaussian\", \n  dpars = c(\"mu\", \"sigma\", \"zoi\", \"coi\"),\n  links = c(\"identity\", \"log\", \"logit\", \"logit\"),\n  lb = c(NA, 0, 0, 0), ub = c(NA, NA, 1, 1),\n  type = \"real\", \n  log_lik = log_lik_logit_p_gaussian,\n  predict = predict_logit_p_gaussian,\n  fitted = fitted_logit_p_gaussian)\n```\n\nAnd create few additional variables:\n```{r additional_vars_exp1, cache = TRUE}\ndata \u003c- data %\u003e% \n  mutate(\n    logit_p = qlogis(p),\n    p_lt0.05 = factor(p \u003c 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    p_eq0.05 = factor(p == 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    cat_p = recode_factor(true_p, \n      \"0.06\" = \"\u003e0.05\", \"0.1\" = \"\u003e0.05\", \"0.5\" = \"\u003e0.05\", \"0.8\" = \"\u003e0.05\",\n      .ordered = TRUE))\n```\n\n```{r, eval = FALSE}\nfit_exp1 \u003c- brm(bf(\n  confidence ~ \n    viz * p_lt0.05 * logit_p + \n    viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ viz + (1 | id)),\n  data = data,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, save_all_pars = TRUE, refresh = 0)\n```\n\n### Results\n\nFirst, let us check the parameter estimates of the model:\n\n```{r fit_exp1_read, cache = TRUE, echo = FALSE}\nfit_exp1 \u003c- readRDS(\"experiment1/results/fit_noexpertise.rds\")\n```\n```{r fit_exp1, cache = TRUE}\nfit_exp1\n```\n\nNow we look at some figures. First we draw some samples from posterior predictive distribution and see how well our simulated replications match with our data:\n```{r pp_check_exp1_a, cache = TRUE}\npp_check(fit_exp1, type = \"hist\", nsamples = 11)\n```\n\nWe see that the histograms of the replicated datasets are similar to observed one, perhaps slight exaggeration of the tails. Next, we look the median confidence of replicated datasets grouped with underlying $p$-value:\n\n```{r pp_check_exp1_b, cache = TRUE}\npp_check(fit_exp1, type = \"stat_grouped\", group = \"true_p\", stat = \"median\")\n```\n\nNow grouping based on visualization:\n```{r pp_check_exp1_c, cache = TRUE}\npp_check(fit_exp1, type = \"stat_grouped\", group = \"viz\", stat = \"mean\")\n```\n\nNoting the scale on the x-axis, our histograms look reasonable given our data, although there are some subgroups where our model is slightly over- or underestimating compared to our data, especially in the violin CI group (reasonable changes to our model, such as dropping some interaction terms, did not improve this). Same posterior checks for average participants (with random effects zeroed out) we get very good results:\n\n```{r pp_check_exp1_b_norandom, cache = TRUE}\npp_check(fit_exp1, type = \"stat_grouped\", group = \"true_p\", stat = \"median\", re_formula = NA)\npp_check(fit_exp1, type = \"stat_grouped\", group = \"viz\", stat = \"mean\", re_formula = NA)\n```\n\nNow we are ready to analyze the results. First, the posterior curves of the confidence given the underlying $p$-value:\n\n```{r, cache = TRUE}\ncomb_exp1 \u003c- fit_exp1$data %\u003e% \n  data_grid(viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction( \n        fit_exp1$data$logit_p, fit_exp1$data$p_lt0.05, \n        fit_exp1$data$p_eq0.05, fit_exp1$data$cat_p, \n        fit_exp1$data$true_p)))\n\nf_mu_exp1 \u003c- posterior_epred(fit_exp1, newdata = comb_exp1, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp1), \n  p = rep(comb_exp1$true_p, each = nrow(f_mu_exp1)),\n  viz = rep(comb_exp1$viz, each = nrow(f_mu_exp1)),\n  iter = 1:nrow(f_mu_exp1))\nlevels(d$viz) \u003c- c(\"Textual\", \"Classic CI\", \"Gradient CI\", \"Violin CI\")\n```\n\n```{r posterior_curves_exp1, cache = TRUE}\nsumr \u003c- d %\u003e% group_by(viz, p) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\ncols \u003c- c(\"Textual\" = \"#D55E00\", \"Classic CI\" = \"#0072B2\", \n  \"Gradient CI\" = \"#009E73\", \"Violin CI\" = \"#CC79A7\")\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\n\np1 \u003c- sumr %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.1, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5)))\n\n\np2 \u003c- sumr %\u003e% filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np \u003c- p1 + coord_cartesian(xlim = c(0.001, 0.9), ylim = c(0.045, 0.95)) + \n  annotation_custom(\n    ggplotGrob(p2), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\np\n```\n```{r, echo = FALSE, eval = FALSE}\nggsave(p, filename = \"experiment1/results/exp1_confidence.pdf\", \n  width = 2*8.5, height = 12.5, \n  unit = \"cm\", device = \"pdf\")\n```\n\nThe confidence level with traditional CI is most constant of all techniques when are within \"statistically significant region\" i.e. $p\u003c0.05$, but there is a large drop when moving to $p\u003e0.05$, even larger than with textual information with $p$-value, which behaves nearly identically with the Violin CI plot until $p=0.05$, when the confidence in $p$-value representation drops below all other techniques. The Gradient CI plot and Violin CI plot behave similarly, except the confidence level in case of Gradient CI plot is constantly below the Violin CI plot.\n\nThe probability curves of extreme answer show that traditional CI produces more easily extreme answers when $p\u003c0.05$ (so the extreme answer is likely of full confidence), whereas $p$-value is more likely to lead extreme answer (zero confidence) when $p\u003e0.05$. Differences between techniques seem nevertheless quite small compared to overall variation in the estimates.\n\n```{r extreme_exp1_plot, cache = TRUE}\nf_zoi_exp1_sumr \u003c- fitted(fit_exp1, newdata = comb_exp1, \n  re_formula = NA, dpar = \"zoi\")\ndf_01_exp1 \u003c- data.frame(\n  p = plogis(comb_exp1$logit_p), \n  viz = comb_exp1$viz, \n  f_zoi_exp1_sumr)\nlevels(df_01_exp1$viz) \u003c- \n  c(\"Textual\", \"Classic CI\", \"Gradient CI\", \"Violin CI\")\ny_ticks \u003c- c(0.0001, 0.01, seq(0.1,0.9,by=0.2))\n\np \u003c- df_01_exp1 %\u003e% \n  ggplot(aes(x = p, y = Estimate, colour = viz)) +\n  geom_linerange(aes(ymin = Q2.5, ymax = Q97.5),\n    position = position_dodge(width=0.19)) + \n  geom_line(alpha=0.5, position = position_dodge(width=0.19))  + \n  ylab(\"Probability of all-or-none answer\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  theme_classic() + \n  scale_y_continuous(trans = \"logit\",\n    breaks = y_ticks, labels = y_ticks, minor_breaks = NULL) + \n  scale_x_continuous(trans = \"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 10), legend.position = \"bottom\",   \n    axis.title.x = element_text(size = 12),\n    axis.text.y = element_text(size = 10), axis.title.y = element_text(size = 12),\n    legend.text=element_text(size = 10), strip.text.x = element_text(size = 10)) \np\n```\n\nFinally, we can compute the average drop in perceived confidence when moving from $p = 0.04$ to $p=0.06$:\n\n```{r drop1, cache = TRUE}\nd %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nLet's also visualize this:\n```{r, cache = TRUE}\np \u003c- d %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e% \n  ggplot(aes(x = difference, fill = viz, colour = viz)) + \n  geom_density(bw = 0.01, alpha = 0.6) +\n  theme_classic() + \n  scale_fill_manual(\"Representation\", values =  cols) + \n  scale_colour_manual(\"Representation\", values =  cols) + \n  ylab(\"Posterior density\") + \n  xlab(\"E[confidence(p=0.04) - confidence(p=0.06)]\") +\n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14),\n    axis.title.y = element_text(size = 14),\n    legend.text = element_text(size = 14)) \np\n```\n```{r, echo = FALSE, eval = FALSE}\nggsave(p, filename = \"experiment1/results/exp1_cliff.pdf\", \n  width = 2*8.5, height = 6.5, \n  unit = \"cm\", device = \"pdf\")\n```\n\nNote that the cliff effect between viz styles are not independent, i.e. if there is a large cliff effect with Violin CI then the cliff effect with $p$-value is likely larger as well. This can be seen from the posterior probabilities that cliff effect is larger with viz 1 (row variable) than with viz 2 (column variable):\n\n```{r 'postprob1', cache = TRUE}\npostprob \u003c- d %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  group_by(iter) %\u003e% \n  mutate(p_vs_ci = difference[viz == \"Textual\"] - difference[viz == \"Classic CI\"],\n    p_vs_gradient = difference[viz == \"Textual\"] - difference[viz == \"Gradient CI\"],\n    p_vs_violin = difference[viz == \"Textual\"] - difference[viz == \"Violin CI\"],\n    ci_vs_gradient = difference[viz == \"Classic CI\"] - difference[viz == \"Gradient CI\"],\n    ci_vs_violin = difference[viz == \"Classic CI\"] - difference[viz == \"Violin CI\"],\n    gradient_vs_violin = difference[viz == \"Gradient CI\"] - \n      difference[viz == \"Violin CI\"]) %\u003e%\n  ungroup() %\u003e% summarise(\n    \"P(p \u003e CI)\" = mean(p_vs_ci \u003e 0),\n    \"P(p \u003e gradient)\" = mean(p_vs_gradient \u003e 0),\n    \"P(p \u003e violin)\" = mean(p_vs_violin \u003e 0),\n    \"P(CI \u003e gradient)\" = mean(ci_vs_gradient \u003e 0),\n    \"P(CI \u003e violin)\" = mean(ci_vs_violin \u003e 0),\n    \"P(gradient \u003e violin)\" = mean(gradient_vs_violin \u003e 0),\n    \"P(p \u003e CI)\" = mean(p_vs_ci \u003e 0))\nround(t(as.data.frame(postprob)), 2)\n```\n\n### Results for the model with expertise\n\nNow we consider expanded model with with expertise as predictor:\n\n```{r, eval = FALSE, cache = TRUE}\nfit_expertise \u003c- brm(bf(\n  confidence ~ \n    expertise * viz * p_lt0.05 * logit_p + \n    expertise * viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    expertise * viz + viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ expertise * viz + (1 | id)),\n  data = data,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, save_all_pars = TRUE, refresh = 0)\n```\n```{r, eval = TRUE, cache = TRUE, echo = FALSE}\nfit_expertise \u003c- readRDS(\"experiment1/results/fit_expertise.rds\")\n```\n```{r, cache = TRUE}\ncomb_exp1 \u003c- fit_expertise$data %\u003e% \n  data_grid(expertise, viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(expertise, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction(fit_expertise$data$expertise, \n        fit_expertise$data$logit_p, fit_expertise$data$p_lt0.05, \n        fit_expertise$data$p_eq0.05, fit_expertise$data$cat_p, \n        fit_expertise$data$true_p)))\n\nf_mu_exp1 \u003c- posterior_epred(fit_expertise, newdata = comb_exp1, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp1), \n  p = rep(comb_exp1$true_p, each = nrow(f_mu_exp1)),\n  viz = rep(comb_exp1$viz, each = nrow(f_mu_exp1)),\n  expertise = rep(comb_exp1$expertise, each = nrow(f_mu_exp1)),\n  iter = 1:nrow(f_mu_exp1))\n\nlevels(d$viz) \u003c- c(\"Textual\", \"Classic CI\", \"Gradient CI\", \"Violin CI\")\n```\n\nHere are posterior curves for the four different groups:\n```{r 'posterior_curves_exp1_expertise', cache = TRUE}\nsumr \u003c- d %\u003e% group_by(viz, p, expertise) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\n\np11 \u003c- sumr %\u003e% filter(expertise == \"Stats/ML\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.margin = margin(t = -0.1, b = 0, unit = \"cm\"),\n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), \n    ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np21 \u003c- sumr %\u003e% filter(expertise == \"Stats/ML\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\nyrange \u003c- c(min(sumr$Q2.5)-0.001, max(sumr$Q97.5) +0.001)\np1 \u003c- p11 + coord_cartesian(xlim = c(0.001, 0.9), \n  ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p21), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\np12 \u003c- sumr %\u003e% filter(expertise == \"VIS/HCI\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np22 \u003c- sumr %\u003e% filter(expertise == \"VIS/HCI\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n   scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np2 \u003c- p12 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p22), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\np13 \u003c- sumr %\u003e% filter(expertise == \"Social science and humanities\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np23 \u003c- sumr %\u003e% filter(expertise == \"Social science and humanities\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np3 \u003c- p13 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p23), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\n\np14 \u003c- sumr %\u003e% filter(expertise == \"Physical and life sciences\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np24 \u003c- sumr %\u003e% filter(expertise == \"Physical and life sciences\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np4 \u003c- p14 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p24), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\n\nlibrary(patchwork)\np \u003c- (p1 + ggtitle(\"Stats/ML\")) + (p2 + ggtitle(\"VIS/HCI\")) + \n  (p3 + ggtitle(\"Social sciences and humanities\")) + \n  (p4 + ggtitle(\"Physical and life sciences\"))\np\n```\n\n\nThere are some differences between confidence curves between groups: In Physical and life sciences the visualization affects only little on the confidence curves; gradient CI and violin CI produce very linear curves in VIS/HCI group; and there is very large drop in confidence in case of classic CI in Stats/ML group. However, the ordering in terms of cliff effect is same in all groups.\n\nWe can also draw same figure when averaging over the groups:\n\n```{r posterior_curves_exp1_marginal, cache = TRUE}\nsumr \u003c- d %\u003e% group_by(viz, p) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\np1 \u003c- sumr %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5)))\n\n\np2 \u003c- sumr %\u003e% filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np \u003c- p1 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p2), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\np\n\n```\n```{r, echo = FALSE, eval = FALSE}\nggsave(p, filename = \"experiment1/results/exp1_confidence_marginal.pdf\", \n  width = 2*8.5, height = 12.5, \n  unit = \"cm\", device = \"pdf\")\n```\n\nWe see that the results are very similar to the model without the expertise variable, except naturally the credible intervals in the above figure are somewhat wider when we average over the expertise groups with different overall levels (in model without expertise, these differences are captured by the participant-level effects which are then zeroed out when considering average participant).\n\nNow the potential cliff effect:\n```{r, cache = TRUE}\nd %\u003e% group_by(viz, iter,expertise) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e% \n  ggplot(aes(x = difference, fill = viz, colour = viz)) + \n  geom_density(bw = 0.01, alpha = 0.6) +\n  theme_classic() + \n  scale_fill_manual(\"Representation\", values =  cols) + \n  scale_color_manual(\"Representation\", values =  cols) + \n  ylab(\"Posterior density\") + \n  xlab(\"Cliff effect\") +\n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14)) +facet_wrap(~expertise)\n\nd %\u003e% group_by(expertise, viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nWe see some differences between the group-wise estimates (but note the standard deviation). For example the drop in confidence seems to be smallest in the VIS/HCI group with gradient and violin CIs (and $p$-value and classic CI perform relatively similar) and somewhat surprisingly the drops are largest in the Stats/ML group for all representation values. However, in all groups the classic CI has largest drop, with $p$-value following second (expect there is a virtually tie with the gradient CI in Phys./life sciences group), and relatively equal drops with gradient and violin CIs.\n\nWhen we average over these groups to obtain marginal means we see almost identical results compared to the model without expertise:\n\n```{r, cache = TRUE}\nd %\u003e% group_by(expertise, viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  group_by(viz) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nDensity plots of course show multimodality due to group differences:\n```{r, cache = TRUE}\nd %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e% \n  ggplot(aes(x = difference, fill = viz, colour = viz)) + \n  geom_density(bw = 0.01, alpha = 0.6) +\n  theme_classic() + \n  scale_fill_manual(\"Representation\", \n    values = cols[1:4]) + \n  scale_colour_manual(\"Representation\", \n    values = cols[1:4]) + \n  ylab(\"Posterior density\") + \n  xlab(\"Cliff effect\") +\n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14)) \n```\n\nWhen reflecting these results to the descriptive statistics of the data, especially the cliff effect for each expertise group and visualization style, it should be noted that especially in VIS/HCI case there are large proportion of answers with a clear \"negative drop\" of confidence around $p=0.05$, which could be considered \"equally wrong interpretation\" as the cliff effect itself. These cases also negate the big changes to other direction making the overall drop for these groups smaller. \n\n\u003c!-- Thus it could be interesting to study absolute changes of confidence, or alternatively clean these \"outliers\" (most of them are not really outliers as due to the experiment's design there is natural random variation in the answers) and reanalyse the data (which we did not do here as we wanted to stary true to our preregistration where we did not consider this). --\u003e\n\nFor example, here is the proportion of curves where the the change in confidence $\\delta \u003c -0.2$ (average drop over all viz and expertise groups was estimated as $0.2$: \n\n```{r, cache = TRUE}\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n    summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n    group_by(viz, expertise) %\u003e%\n    summarise(\n        negative_cliff = round(mean(difference \u003c -0.2), 2))\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n    summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n    group_by(expertise) %\u003e%\n    summarise(\n        negative_cliff = round(mean(difference \u003c -0.2), 2))\ndata %\u003e% group_by(id, viz, expertise) %\u003e% \n    summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n    group_by(viz) %\u003e%\n    summarise(\n        negative_cliff = round(mean(difference \u003c -0.2), 2))\n```\n\n\n### Reanalysis with cleaned data\n\nFinally we test how does the results depend on those confidence curves which have clearly positive slope or large increases in confidence when $p$-value increases.\n\nWe use simple linear model with logit-transformed $p$-value and trimmed logit-transformed confidence, and check whether the corresponding coefficient is clearly positive (arbitrarily chose as 0.1), and in addition to this we remove those curves where the difference between two consecutive confidence values are larger than 0.2 (this should of course be negative):\n\n```{r cleaned1, cache = TRUE, eval = FALSE}\ndata \u003c- readRDS(\"experiment1/data/exp1_data.rds\")\noutliers_slope \u003c- data %\u003e% group_by(id, viz) %\u003e%\n  mutate(p_logit = qlogis(p), c_logit = qlogis(\n    ifelse(confidence == 0, 0.001, ifelse(confidence == 1, 0.999, confidence)))) %\u003e%\n  summarize(\n    slope = coef(lm(c_logit ~ p_logit))[2]) %\u003e%\n  filter(slope \u003e 0.1)\n\noutliers_diff \u003c- data %\u003e% group_by(id, viz) %\u003e% \n  arrange(p, .by_group = TRUE) %\u003e%\n  mutate(diff = c(0,diff(confidence)), neg_diff = any(diff \u003e 0.2)) %\u003e%\n  filter(neg_diff)\n\ndata_cleaned \u003c- data %\u003e%\n  filter(!(interaction(id,viz) %in% \n      interaction(outliers_slope$id, outliers_slope$viz))) %\u003e%\n  filter(!(interaction(id,viz) %in% \n      interaction(outliers_diff$id, outliers_diff$viz))) \n\ndata_cleaned \u003c- data_cleaned %\u003e% \n  mutate(\n    logit_p = qlogis(p),\n    p_lt0.05 = factor(p \u003c 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    p_eq0.05 = factor(p == 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    cat_p = recode_factor(true_p, \n      \"0.06\" = \"\u003e0.05\", \"0.1\" = \"\u003e0.05\", \"0.5\" = \"\u003e0.05\", \"0.8\" = \"\u003e0.05\",\n      .ordered = TRUE))\n\nfit_exp1 \u003c- brm(bf(\n  confidence ~ \n    viz * p_lt0.05 * logit_p + \n    viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ viz + (1 | id)),\n  data = data_cleaned,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, refresh = 0)\n```\n\n```{r, echo = FALSE}\nfit_exp1 \u003c- readRDS(\"experiment1/results/fit_cleaned.rds\")\n```\n\n```{r cleaned_curves, cache = TRUE}\ncomb_exp1 \u003c- fit_exp1$data %\u003e% \n  data_grid(viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction( \n        fit_exp1$data$logit_p, fit_exp1$data$p_lt0.05, \n        fit_exp1$data$p_eq0.05, fit_exp1$data$cat_p, \n        fit_exp1$data$true_p)))\n\nf_mu_exp1 \u003c- posterior_epred(fit_exp1, newdata = comb_exp1, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp1), \n  p = rep(comb_exp1$true_p, each = nrow(f_mu_exp1)),\n  viz = rep(comb_exp1$viz, each = nrow(f_mu_exp1)),\n  iter = 1:nrow(f_mu_exp1))\nlevels(d$viz) \u003c- c(\"Textual\", \"Classic CI\", \"Gradient CI\", \"Violin CI\")\n\nsumr \u003c- d %\u003e% group_by(viz, p) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\ncols \u003c- c(\"Textual\" = \"#D55E00\", \"Classic CI\" = \"#0072B2\", \n  \"Gradient CI\" = \"#009E73\", \"Violin CI\" = \"#CC79A7\")\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\n\np1 \u003c- sumr %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.1, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5)))\n\n\np2 \u003c- sumr %\u003e% filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np \u003c- p1 + coord_cartesian(xlim = c(0.001, 0.9), ylim = c(0.045, 0.95)) + \n  annotation_custom(\n    ggplotGrob(p2), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\np\n```\n```{r, cache=TRUE}\nd %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nOverall, the results are in line with the analysis of to full data, except that the average $\\delta$ is larger in all groups.\n    \n### Subjective rankings of the representation styles\n\nNow we focus on analysis the subjective rankings of the technique. Read the feedback data and merge it with the previous data which contains the expertise information: \n\n```{r create_rankdata_exp1, eval = FALSE, cache = TRUE}\nfiles \u003c- list.files(path, pattern = \"subjective\", full.names = TRUE)\nn \u003c- length(files)\n\nrankdata \u003c- data.frame(id = rep(1:n, each=4),\n  viz = factor(rep(c(\"p\", \"ci\", \"violin\", \"gradient\")), \n    levels=c(\"p\", \"ci\", \"violin\", \"gradient\")),\n  rank = factor(NA, levels=1:4))\n\nfor(i in 1:n) {\n  fb \u003c- fromJSON(files[i])\n  rankdata$id[4*(i-1) + 1:4] \u003c- strsplit(strsplit(files[i], \"subjective\")[[1]], \".txt\")[[2]]\n  rankdata$rank[4*(i-1) + 1:4] \u003c- factor(fb$rank)\n}\n\nrankdata$viz \u003c- recode_factor(rankdata$viz, \"p\" = \"p\", \"ci\" = \"CI\",\n  \"gradient\" = \"gradient\", \"violin\" = \"violin\")\nrankdata$rank \u003c- factor(rankdata$rank, ordered = TRUE)\nrankdata$id \u003c- factor(rankdata$id, levels = levels(data$id))\nranks_exp1 \u003c- distinct(inner_join(rankdata, data[,c(\"id\", \"viz\", \"expertise\")]))\n```\n```{r, echo=FALSE, cache = TRUE}\nranks_exp1 \u003c- readRDS(\"experiment1/data/exp1_rankdata.rds\")\nfit_rank1 \u003c- readRDS(\"experiment1/results/fit_rank1.rds\")\n```\n\nFor analysing the subjective rankings of the representation styles, we use a Bayesian ordinal regression model. We test two models, one with expertise and another without it:\n```{r fit_models_rank_exp1, eval=FALSE, cache = TRUE}\nfit_rank1 \u003c- brm(rank ~ viz + (1 | id), family=cumulative, \n  data = ranks_exp1, refresh = 0)\nsaveRDS(fit_rank1, file = \"experiment1/results/fit_rank1.rds\")\n```\n\nPlot ranking probabilities:\n```{r rank_exp1_plot, cache = TRUE}\ncolsrank \u003c- scales::brewer_pal(palette = \"PiYG\",\n  direction = -1)(4)\n\neffects_exp1 \u003c- conditional_effects(fit_rank1, effects = \"viz\", \n  plot = FALSE, categorical = TRUE, reformula = NA)\n\np \u003c- ggplot(effects_exp1[[1]], aes(x = viz, y = estimate__, colour = cats__)) + \n  geom_point(position=position_dodge(0.5)) + \n  geom_errorbar(width=0.25, aes(ymin=lower__, ymax = upper__), \n    position = position_dodge(0.5)) + \n  theme_classic() + \n  ylab(\"Ranking \\n probability\") + \n  xlab(\"Representation\") +\n  scale_x_discrete(labels =c(\"Textual\", \"Classic CI\", \"Gradient CI\", \"Violin CI\")) +\n  scale_color_manual(\"Rank\", \n    values = colsrank,\n    labels = c(\"1 (best)\", \"2\", \"3\", \"4 (worst)\")) + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12,hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14),\n    axis.title.y = element_text(size = 14),\n    legend.text = element_text(size = 14)) \np\n```\n```{r, eval = FALSE, echo = FALSE}\nggsave(p, file=\"experiment1/results/ranks1.pdf\",  \n  width = 2*8.5, height = 6, \n  unit = \"cm\", device = \"pdf\")\n```\n\nWe see that the $p$-values are likely to be ranked very low, while violin CI and classic CI are the most preferred options, and gradient CI seems to divide opinions most.\n\n## Two-sample experiment\n\nLet us turn our attention to the second experiment, for which we essentially use the same workflow as for the first experiment.\n\n### Creating the dataset\n\n```{r create_data_exp2, eval = FALSE}\npath \u003c- \"experiment2/data\"\nanswers \u003c- list.files(path, pattern=\"answers\", full.names = TRUE)\nn \u003c- length(answers)\n\n# create a data frame for the results\ndata_raw \u003c- data.frame(id = rep(1:n, each = 32), viz = NA, replication = NA, value = NA,\n  expertise = NA, degree = NA, age = NA, experience = NA, tools = NA)\n\n# read in answers, not optimal way will do\nfor(i in 1:n){\n  x \u003c- strsplit(fromJSON(answers[i]), \",\")\n  dem \u003c- fromJSON(paste0(path,  \"/demography\", x[[1]][1], \".txt\"))\n  for(j in 1:32) {\n    data_raw[32*(i-1) + j, c(\"id\", \"viz\", \"replication\", \"value\")] \u003c- x[[j]]\n    data_raw[32*(i-1) + j, c(\"expertise\", \"degree\", \"age\", \"experience\", \"tools\")] \u003c- \n      dem[c(\"expertise\", \"level\", \"age\", \"experience\", \"tools\")]\n  }\n}\nsaveRDS(data_raw, file = \"experiment2/data/data_raw.rds\")\n# remove person who didn't answer on the demography part\ndata_raw \u003c- data_raw[data_raw$expertise != \"\",]\n\ntrue_p \u003c- c(0.001, 0.01, 0.04, 0.05, 0.06, 0.1, 0.5, 0.8)\n\ndata2 \u003c- data_raw %\u003e% mutate(n = factor(ifelse(as.numeric(id) %% 8 \u003c 4, 50, 200)),\n  id = factor(id),\n  viz = relevel(factor(viz, labels = c(\"CI\", \n    \"Gradient\", \n    \"Continuous Violin\", \n    \"Discrete Violin\")),\n    \"CI\"),\n  replication = as.numeric(replication),\n  value = as.numeric(value),\n  p = true_p[replication],\n  true_p = factor(p), # for monotonic but non-linear effect on confidence\n  confidence = (value - 1) / 99,\n  expertise = factor(expertise)) %\u003e% arrange(id, viz)\n\n# Classify the expertise\ndata2$expertise \u003c- recode_factor(data2$expertise, \n  \"Statistics\" = \"Stats/ML\",\n  \"machine learning, statistics\" = \"Stats/ML\",\n  \"Human Factors, experiment design\" = \"Stats/ML\",\n  \"Consulting\" = \"Stats/ML\",\n  \"Computer vision\" = \"Stats/ML\",\n  \"Meta-research\"  = \"Stats/ML\",\n  \"Epidemiology\" = \"Stats/ML\",\n  \n  \"infovis\" = \"VIS/HCI\",\n  \"HCI and VIS\" = \"VIS/HCI\",\n  \"HCI\" = \"VIS/HCI\",\n  \"vis\" = \"VIS/HCI\",\n  \"Vis and HCI\" = \"VIS/HCI\", \n  \"Visualisation\" = \"VIS/HCI\",\n  \"Visualization\" = \"VIS/HCI\",\n  \n  \"sociology\" = \"Social science and humanities\",\n  \"Sociology\" = \"Social science and humanities\",\n  \"Psychology\" = \"Social science and humanities\",\n  \"psychology\" = \"Social science and humanities\",\n  \"health economics\" = \"Social science and humanities\",\n  \"Sport psychology\" = \"Social science and humanities\",\n  \"economics\" = \"Social science and humanities\",\n  \n  \"Psychology / Neuroscience\" = \"Physical and life sciences\",\n  \"Ecology\" = \"Physical and life sciences\",\n  \"Biology\" = \"Physical and life sciences\",\n  \"Biology \" = \"Physical and life sciences\",\n  \"Developmental Biology\" = \"Physical and life sciences\",\n  \"Microbiology\" = \"Physical and life sciences\"\n)\ndata2$expertise \u003c- relevel(data2$expertise, \"Stats/ML\")\n```\n```{r, echo=FALSE, cache = TRUE}\ndata2 \u003c- readRDS(\"experiment2/data/exp2_data.rds\")\n```\n\n### Descriptive statistics\n\nAs in first experiment, we first look at some descriptive statistics. \n```{r desc2, cache = TRUE}\nids \u003c- which(!duplicated(data2$id))\nbarplot(table(data2$expertise[ids]))\nbarplot(table(data2$degree[ids]))\nhist(as.numeric(data2$age[ids]))\n```\n\nAgain we now focus on the cliff effect as difference between confidence when $p$-value=0.04 versus $p$-value=0.06:\n```{r cliff_effect_exp2, cache = TRUE}\ndata2 %\u003e% group_by(id, viz) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz) %\u003e%\n  summarise(\n    mean = mean(difference), \n    median = median(difference),\n    sd = sd(difference), \n    se = sd(difference) / sqrt(length(difference)),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5%\" = quantile(difference, 0.975))\n\ndata2 %\u003e% group_by(id, viz) %\u003e% \n  summarize(difference = confidence[true_p==0.04] - confidence[true_p==0.06]) %\u003e%\n  ggplot(aes(x = viz, y = difference)) + \n  geom_violin() +\n  geom_point(alpha = 0.5, position = position_jitter(0.1)) +\n  scale_y_continuous(\"Difference in confidence when p-value is 0.06 vs 0.04\") +\n  scale_x_discrete(\"Representation\") +\n  theme_classic() \n```\n\nInterestingly, while the cliff effect is again largest with classic CI, there are some cases where the discrete Violin CI has lead to very large drop in confidence. Overall the cliff effect seems to be much smaller than in the one-sample case (there the average drop was around 0.1-0.3 depending on the technique).\n\nNow same but with subgrouping using sample size:\n```{r cliff_effect_n_exp2, cache=TRUE}\ndata2 %\u003e% group_by(id, viz, n) %\u003e% \n  summarize(diff = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz, n) %\u003e%\n  summarise(\n    mean = mean(diff), \n    sd = sd(diff), \n    se = sd(diff) / sqrt(length(diff)),\n    \"2.5%\" = quantile(diff, 0.025), \n    \"97.5%\" = quantile(diff, 0.975))\n```\nand expertise:\n```{r cliff_effect_expertise_exp2, cache=TRUE}\ndata2 %\u003e% group_by(id, viz, expertise) %\u003e% \n  summarize(diff = confidence[true_p==0.04] - confidence[true_p==0.06])  %\u003e% \n  group_by(viz, expertise) %\u003e%\n  summarise(\n    mean = mean(diff), \n    sd = sd(diff), \n    se = sd(diff) / sqrt(length(diff)),\n    \"2.5%\" = quantile(diff, 0.025), \n    \"97.5%\" = quantile(diff, 0.975))\n\ndata2 %\u003e% group_by(id, viz,expertise) %\u003e% \n  summarize(\n    difference = confidence[true_p==0.04] - confidence[true_p==0.06]) %\u003e%\n  ggplot(aes(x=viz, y = difference)) + geom_violin() + theme_classic() + \n  scale_y_continuous(\"Difference in confidence when p-value is 0.04 vs 0.06\") +\n  scale_x_discrete(\"Representation\") +\n  geom_point(aes(colour = expertise), position=position_jitter(0.1))\n```\n\nIt is difficult to say anything definite but there doesn't seem to be clear differences between samples sizes or expertise, although again it is VIS/HCI group which can be \"blamed\" for extreme changes in violin cases.\n\nLet's check how the much extreme answers (full or zero confidence) there are in different groups:\n```{r extreme_exp2, cache=TRUE}\ndata2 %\u003e% group_by(id, viz, n) %\u003e% \n  mutate(extreme = confidence %in% c(0, 1))  %\u003e% \n  group_by(viz, n) %\u003e%\n  summarise(\n    mean = mean(extreme),\n    sd = sd(extreme), \n    se = sd(extreme) / sqrt(length(extreme)))\n\ndata2 %\u003e% group_by(id, viz, expertise) %\u003e% \n  mutate(extreme = confidence %in% c(0, 1))  %\u003e% \n  group_by(viz, expertise) %\u003e%\n  summarise(\n    mean = mean(extreme),\n    sd = sd(extreme), \n    se = sd(extreme) / sqrt(length(extreme)))\n```\nCompared to first experiment, here Stats/ML group performs best.\n\n### Model\n\nAgain, create some additional variables:\n```{r additional_vars_exp2, cache=TRUE}\ndata2 \u003c- data2 %\u003e% \n  mutate(\n    logit_p = qlogis(p),\n    p_lt0.05 = factor(p \u003c 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    p_eq0.05 = factor(p == 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    cat_p = recode_factor(true_p, \"0.06\" = \"\u003e0.05\", \"0.1\" = \"\u003e0.05\", \"0.5\" = \"\u003e0.05\", \"0.8\" = \"\u003e0.05\",\n      .ordered = TRUE))\n```\n\nAnd fit the same models as in first experiment:\n```{r eval = FALSE, cache = TRUE}\nfit_exp2 \u003c- brm(bf(\n  confidence ~ \n    viz * p_lt0.05 * logit_p + \n    viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ viz + (1 | id)),\n  data = data2,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, save_all_pars = TRUE, refresh = 0)\n```\n```{r, eval = TRUE, cache = TRUE, echo = FALSE}\nfit_exp2 \u003c- readRDS(\"experiment2/results/fit_noexpertise.rds\")\n```\nAnd same with expertise:\n```{r, eval = FALSE, cache = TRUE}\nfit_expertise \u003c- brm(bf(\n  confidence ~ \n    expertise * viz * p_lt0.05 * logit_p + \n    expertise * viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    expertise * viz + expertise * true_p + viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ expertise * viz + (1 | id)),\n  data = data,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, save_all_pars = TRUE, refresh = 0)\n```\n```{r, eval = TRUE, cache = TRUE, echo = FALSE}\nfit_expertise \u003c- readRDS(\"experiment2/results/fit_expertise.rds\")\n```\n\n\n### Results\n\n```{r fit_exp2, cache=TRUE}\nfit_exp2\n```\n\nNow we look at some figures. First we draw some samples from posterior predictive distribution and see how well our simulated replications match with our data:\n```{r pp_check_exp2, cache=TRUE}\npp_check(fit_exp2, type = \"hist\", nsamples = 11)\npp_check(fit_exp2, type = \"stat_grouped\", group = \"true_p\", stat = \"median\")\npp_check(fit_exp2, type = \"stat_grouped\", group = \"viz\", stat = \"mean\")\n```\n\nNote the difference compared to the first experiment: There is much less extremely confident answers than in the first case which was pretty symmetrical between the zero and full confidence answers. These posterior predictive samples are nicely in line with the data (it is feasible that the data could have been generated by this model).\n\nNow we are ready to analyze the results. First, the posterior curves of the confidence given the underlying $p$-value:\n```{r, cache = TRUE}\ncomb_exp2 \u003c- fit_exp2$data %\u003e% \n  data_grid(viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction( \n        fit_exp2$data$logit_p, fit_exp2$data$p_lt0.05, \n        fit_exp2$data$p_eq0.05, fit_exp2$data$cat_p, \n        fit_exp2$data$true_p)))\n\nf_mu_exp2 \u003c- posterior_epred(fit_exp2, newdata = comb_exp2, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp2), \n  p = rep(comb_exp2$true_p, each = nrow(f_mu_exp2)),\n  viz = rep(comb_exp2$viz, each = nrow(f_mu_exp2)),\n  iter = 1:nrow(f_mu_exp2))\n\nlevels(d$viz) \u003c- c(\"Classic CI\", \"Gradient CI\", \"Cont. violin CI\", \"Disc. violin CI\")\ncols  \u003c- c(\"Classic CI\" = \"#0072B2\", \n  \"Gradient CI\" = \"#009E73\", \"Cont. violin CI\" = \"#CC79A7\",\n  \"Disc. violin CI\" = \"#E69F00\")\n```\n\n```{r, cache = TRUE}\nsumr \u003c- d %\u003e% group_by(viz, p) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\np1 \u003c- sumr %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values = cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5)))\n\n\np2 \u003c- sumr %\u003e% filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values = cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np \u003c- p1 + coord_cartesian(xlim = c(0.001, 0.9), ylim = c(0.045, 0.95)) + \n  annotation_custom(\n    ggplotGrob(p2), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\np\n\n```\n```{r, echo = FALSE, eval = FALSE}\nggsave(p, filename = \"experiment2/results/exp2_confidence.pdf\", \n  width = 2*8.5, height = 12.5, \n  unit = \"cm\", device = \"pdf\")\n```\n\n\nAnd the probability of extreme answer:\n```{r extreme_exp2_plot, cache=TRUE}\n\nf_zoi_exp2 \u003c- fitted(fit_exp2, newdata = comb_exp2, re_formula = NA, dpar = \"zoi\")\ndf_01_exp2 \u003c- data.frame(\n  p = plogis(comb_exp2$logit_p),\n  viz = comb_exp2$viz,\n  f_zoi_exp2)\nlevels(df_01_exp2$viz) \u003c- levels(d$viz)\ny_ticks \u003c- c(0.001, 0.01, seq(0.1,0.9,by=0.2))\n\np \u003c- df_01_exp2 %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) +\n  geom_linerange(aes(ymin = Q2.5, ymax = Q97.5),\n    position = position_dodge(width=0.19)) +\n  geom_line(alpha=0.5, position = position_dodge(width=0.19))  +\n  ylab(\"Probability of all-or-none answer\") + xlab(\"p-value\") +\n  scale_color_manual(\"Representation\", values = cols) + \n  theme_classic() +\n  scale_y_continuous(trans = \"logit\",\n    breaks = y_ticks, labels = y_ticks, minor_breaks = NULL) +\n  scale_x_continuous(trans = \"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) +\n  theme(axis.text.x = element_text(angle = 90, hjust = 1, size = 10), legend.position = \"bottom\",\n    axis.title.x = element_text(size = 12),\n    axis.text.y = element_text(size = 10), axis.title.y = element_text(size = 12),\n    legend.text=element_text(size = 10), strip.text.x = element_text(size = 10))\np\n\n```\n\n\nAgain we can compute the average drop in perceived confidence when moving from $p = 0.04$ to $p=0.06$:\n\n```{r drop2, cache=TRUE}\nd %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nThere is a peculiar rise in confidence level in case of continuous Violin CI when the underlying $p$-value is 0.05, but overall, compared to the first experiment the results here do not show strong differences in cliff effect or dichotomous thinking, and actually is no clear signs of these phenomena in this experiment:\n\n```{r, cache=TRUE}\np \u003c- d %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e% \n  ggplot(aes(x = difference, fill = viz, colour = viz)) + \n  geom_density(bw = 0.01, alpha = 0.6) +\n  theme_classic() + \n  scale_fill_manual(\"Representation\", values = cols) + \n  scale_colour_manual(\"Representation\", values = cols) + \n  ylab(\"Posterior density\") + \n  xlab(\"E[confidence(p=0.04) - confidence(p=0.06)]\") +\n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14),\n    axis.title.y = element_text(size = 14),\n    legend.text = element_text(size = 14)) \np \n\n```\n\n```{r, echo = FALSE, eval = FALSE}\nggsave(p, filename = \"experiment2/results/exp2_cliff.pdf\", \n  width = 2*8.5, height = 6.5, \n  unit = \"cm\", device = \"pdf\")\n```\n\n```{r, cache=TRUE}\npostprob \u003c- d %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  group_by(iter) %\u003e% \n  mutate(ci_vs_gradient = difference[viz == \"Classic CI\"] - \n      difference[viz == \"Gradient CI\"],\n    ci_vs_cviolin = difference[viz == \"Classic CI\"] - \n      difference[viz == \"Cont. violin CI\"],\n    ci_vs_dviolin = difference[viz == \"Classic CI\"] - \n      difference[viz == \"Disc. violin CI\"],\n    gradient_vs_cviolin = difference[viz == \"Gradient CI\"] - \n      difference[viz == \"Cont. violin CI\"],\n    gradient_vs_dviolin = difference[viz == \"Gradient CI\"] - \n      difference[viz == \"Disc. violin CI\"],\n    cviolin_vs_dviolin = difference[viz == \"Cont. violin CI\"] - \n      difference[viz == \"Disc. violin CI\"]) %\u003e%\n  ungroup() %\u003e% summarise(\n    \"P(CI \u003e gradient)\" = mean(ci_vs_gradient \u003e 0),\n    \"P(CI \u003e cviolin)\" = mean(ci_vs_cviolin \u003e 0),\n    \"P(CI \u003e dviolin)\" = mean(ci_vs_dviolin \u003e 0),\n    \"P(gradient \u003e cont violin)\" = mean(gradient_vs_cviolin \u003e 0),\n    \"P(gradient \u003e disc violin)\" = mean(gradient_vs_dviolin \u003e 0),\n    \"P(cont violin \u003e disc violin)\" = mean(cviolin_vs_dviolin \u003e 0))\nround(t(as.data.frame(postprob)), 2)\n```\n\n### Results for the model with expertise\n\nNow we consider expanded model with with expertise as predictor:\n\n```{r, eval = FALSE, cache = TRUE}\nfit_expertise \u003c- brm(bf(\n  confidence ~ \n    expertise * viz * p_lt0.05 * logit_p + \n    expertise * viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    expertise * viz + viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ expertise * viz + (1 | id)),\n  data = data2,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, save_all_pars = TRUE, refresh = 0)\n```\n```{r, eval = TRUE, cache = TRUE, echo = FALSE}\nfit_expertise \u003c- readRDS(\"experiment2/results/fit_expertise.rds\")\n```\n```{r, cache = TRUE}\ncomb_exp2 \u003c- fit_expertise$data %\u003e% \n  data_grid(expertise, viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(expertise, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction(fit_expertise$data$expertise, \n        fit_expertise$data$logit_p, fit_expertise$data$p_lt0.05, \n        fit_expertise$data$p_eq0.05, fit_expertise$data$cat_p, \n        fit_expertise$data$true_p)))\n\nf_mu_exp2 \u003c- posterior_epred(fit_expertise, newdata = comb_exp2, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp2), \n  p = rep(comb_exp2$true_p, each = nrow(f_mu_exp2)),\n  viz = rep(comb_exp2$viz, each = nrow(f_mu_exp2)),\n  expertise = rep(comb_exp2$expertise, each = nrow(f_mu_exp2)),\n  iter = 1:nrow(f_mu_exp2))\n\nlevels(d$viz) \u003c- c(\"Classic CI\", \"Gradient CI\", \"Cont. violin CI\", \"Disc. violin CI\")\ncols  \u003c- c(\"Classic CI\" = \"#0072B2\", \n  \"Gradient CI\" = \"#009E73\", \"Cont. violin CI\" = \"#CC79A7\",\n  \"Disc. violin CI\" = \"#E69F00\")\n```\n\nHere are posterior curves for the four different groups:\n```{r 'posterior_curves_exp2_expertise', cache = TRUE}\nsumr \u003c- d %\u003e% group_by(viz, p, expertise) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\n\np11 \u003c- sumr %\u003e% filter(expertise == \"Stats/ML\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.margin = margin(t = -0.1, b = 0, unit = \"cm\"),\n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), \n    ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np21 \u003c- sumr %\u003e% filter(expertise == \"Stats/ML\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\nyrange \u003c- c(min(sumr$Q2.5)-0.001, max(sumr$Q97.5) +0.001)\np1 \u003c- p11 + coord_cartesian(xlim = c(0.001, 0.9), \n  ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p21), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\np12 \u003c- sumr %\u003e% filter(expertise == \"VIS/HCI\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np22 \u003c- sumr %\u003e% filter(expertise == \"VIS/HCI\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n   scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np2 \u003c- p12 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p22), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\np13 \u003c- sumr %\u003e% filter(expertise == \"Social science and humanities\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np23 \u003c- sumr %\u003e% filter(expertise == \"Social science and humanities\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np3 \u003c- p13 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p23), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\n\np14 \u003c- sumr %\u003e% filter(expertise == \"Physical and life sciences\") %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, margin = margin(t = -0.1, r = 0, b = -0.3, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5))) \n\n\np24 \u003c- sumr %\u003e% filter(expertise == \"Physical and life sciences\") %\u003e% \n  filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np4 \u003c- p14 + coord_cartesian(xlim = c(0.001, 0.9), ylim = yrange) + \n  annotation_custom(\n    ggplotGrob(p24), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\n\n\nlibrary(patchwork)\np \u003c- (p1 + ggtitle(\"Stats/ML\")) + (p2 + ggtitle(\"VIS/HCI\")) + \n  (p3 + ggtitle(\"Social sciences and humanities\")) + \n  (p4 + ggtitle(\"Physical and life sciences\"))\np\n```\n\nAnd the expertise-specific cliff effects:\n```{r, cache = TRUE}\nd %\u003e% group_by(expertise, viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nAs with the model without expertise, we see no clear signs of cliff effect here.\n\n### Reanalysis with cleaned data\n\nFinally we again test how does the results depend on those confidence curves which have clearly positive slope or large increases in confidence when $p$-value increases.\n\nWe use simple linear model with logit-transformed $p$-value and trimmed logit-transformed confidence, and check whether the corresponding coefficient is clearly positive (arbitrarily chose as 0.1), and in addition to this we remove those curves where the difference between two consecutive confidence values are larger than 0.2 (this should of course be negative):\n\n```{r cleaned2, cache = TRUE, eval = FALSE}\ndata \u003c- readRDS(\"experiment2/data/exp2_data.rds\")\noutliers_slope \u003c- data %\u003e% group_by(id, viz) %\u003e%\n  mutate(p_logit = qlogis(p), c_logit = qlogis(\n    ifelse(confidence == 0, 0.001, ifelse(confidence == 1, 0.999, confidence)))) %\u003e%\n  summarize(\n    slope = coef(lm(c_logit ~ p_logit))[2]) %\u003e%\n  filter(slope \u003e 0.1)\n\noutliers_diff \u003c- data %\u003e% group_by(id, viz) %\u003e% \n  arrange(p, .by_group = TRUE) %\u003e%\n  mutate(diff = c(0,diff(confidence)), neg_diff = any(diff \u003e 0.2)) %\u003e%\n  filter(neg_diff)\n\ndata_cleaned \u003c- data %\u003e%\n  filter(!(interaction(id,viz) %in% \n      interaction(outliers_slope$id, outliers_slope$viz))) %\u003e%\n  filter(!(interaction(id,viz) %in% \n      interaction(outliers_diff$id, outliers_diff$viz))) \n\ndata_cleaned \u003c- data_cleaned %\u003e% \n  mutate(\n    logit_p = qlogis(p),\n    p_lt0.05 = factor(p \u003c 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    p_eq0.05 = factor(p == 0.05, levels = c(TRUE, FALSE), labels = c(\"Yes\", \"No\")),\n    cat_p = recode_factor(true_p, \n      \"0.06\" = \"\u003e0.05\", \"0.1\" = \"\u003e0.05\", \"0.5\" = \"\u003e0.05\", \"0.8\" = \"\u003e0.05\",\n      .ordered = TRUE))\n\nfit_exp2 \u003c- brm(bf(\n  confidence ~ \n    viz * p_lt0.05 * logit_p + \n    viz * p_eq0.05 +\n    (viz + p_lt0.05 * logit_p + p_eq0.05 | id),\n  zoi ~ \n    viz * true_p + (viz | id),\n  coi ~ mo(cat_p),\n  sigma ~ viz + (1 | id)),\n  data = data_cleaned,\n  family = logit_p_gaussian,\n  stanvars = stanvar(scode = stan_funs, block = \"functions\"),\n  chains = 4, cores = 4, iter = 2000, init = 0, \n  save_warmup = FALSE, refresh = 0)\n```\n```{r, echo = FALSE}\nfit_exp2 \u003c- readRDS(\"experiment2/results/fit_cleaned.rds\")\n```\n\n```{r cleaned_curves2, cache = TRUE}\ncomb_exp2 \u003c- fit_exp2$data %\u003e% \n  data_grid(viz, logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %\u003e% \n  filter(interaction(logit_p, p_lt0.05, p_eq0.05, cat_p, true_p) %in% \n      unique(interaction( \n        fit_exp2$data$logit_p, fit_exp2$data$p_lt0.05, \n        fit_exp2$data$p_eq0.05, fit_exp2$data$cat_p, \n        fit_exp2$data$true_p)))\n\nf_mu_exp2 \u003c- posterior_epred(fit_exp2, newdata = comb_exp2, re_formula = NA)\n\nd \u003c- data.frame(value = c(f_mu_exp2), \n  p = rep(comb_exp2$true_p, each = nrow(f_mu_exp2)),\n  viz = rep(comb_exp2$viz, each = nrow(f_mu_exp2)),\n  iter = 1:nrow(f_mu_exp2))\n\nlevels(d$viz) \u003c- c(\"Classic CI\", \"Gradient CI\", \"Cont. violin CI\", \"Disc. violin CI\")\n\nsumr \u003c- d %\u003e% group_by(viz, p) %\u003e%\n  summarise(Estimate = mean(value), \n    Q2.5 = quantile(value, 0.025), \n    Q97.5 = quantile(value, 0.975)) %\u003e%\n  mutate(p = as.numeric(levels(p))[p])\n\ncols  \u003c- c(\"Classic CI\" = \"#0072B2\", \n  \"Gradient CI\" = \"#009E73\", \"Cont. violin CI\" = \"#CC79A7\",\n  \"Disc. violin CI\" = \"#E69F00\")\nx_ticks \u003c- c(0.001, 0.01, 0.04, 0.06, 0.1, 0.5, 0.8)\ny_ticks \u003c- c(0.05, seq(0.1, 0.9, by = 0.1), 0.95)\ndodge \u003c- 0.19\n\np1 \u003c- sumr %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(dodge), size = 0.1) +\n  geom_linerange(data = sumr %\u003e% filter(p \u003c 0.03 | p \u003e 0.07),\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(dodge), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(dodge), size = 0.7, show.legend = FALSE) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks, \n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = x_ticks, labels = x_ticks, minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12, angle = 45, hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14, \n      margin = margin(t = -0.1, r = 0, b = -0.1, l = 0, unit = \"cm\")),\n    axis.title.y = element_text(size = 14, \n      margin = margin(t = 0, r = -0.1, b = 0, l = -0.1, unit = \"cm\")),\n    legend.text = element_text(size = 14))  + \n  geom_rect(xmin = qlogis(0.03), xmax = qlogis(0.07), ymin = qlogis(0.31), ymax = qlogis(0.82), \n    color = \"grey70\", alpha = 0, linetype = \"dashed\", size = 0.1) + \n  guides(colour = guide_legend(override.aes = list(size = 1.5)))\n\n\np2 \u003c- sumr %\u003e% filter(p \u003e 0.02 \u0026 p \u003c 0.09) %\u003e%\n  ggplot(aes(x = p, y = Estimate, colour = viz)) + \n  geom_line(position = position_dodge(0.1), size = 0.1) +\n  geom_linerange(\n    aes(ymin = Q2.5, ymax = Q97.5), \n    position = position_dodge(0.1), size = 0.3,\n    show.legend = FALSE) + \n  geom_point(position = position_dodge(0.1), size = 0.7) +\n  ylab(\"Confidence\") + xlab(\"p-value\") + \n  scale_color_manual(\"Representation\", values =  cols) + \n  scale_y_continuous(trans=\"logit\", breaks = y_ticks,\n    minor_breaks = NULL, labels = y_ticks) + \n  scale_x_continuous(trans=\"logit\",\n    breaks = c(0.04, 0.05, 0.06), \n    labels = c(0.04, 0.05, 0.06), \n    minor_breaks = NULL) + \n  theme_classic() + \n  theme(legend.position = \"none\",  \n    axis.title.x = element_blank(), axis.title.y = element_blank(),\n    plot.background = element_blank(),\n    plot.margin=unit(c(-4,-9,0,0), \"mm\"),\n    axis.text.x = element_text(size = 12), \n    axis.text.y = element_text(size = 12)) \n\np \u003c- p1 + coord_cartesian(xlim = c(0.001, 0.9), ylim = c(0.045, 0.95)) + \n  annotation_custom(\n    ggplotGrob(p2), \n    xmin = qlogis(0.2), xmax = qlogis(0.9), ymin = qlogis(0.3), ymax = qlogis(0.95))\np\n```\n```{r, cache=TRUE}\nd %\u003e% group_by(viz, iter) %\u003e% \n  summarise(difference = value[p == \"0.04\"] - value[p == \"0.06\"]) %\u003e%\n  summarise(mean = mean(difference), sd = sd(difference),\n    \"2.5%\" = quantile(difference, 0.025), \n    \"97.5\" = quantile(difference, 0.975))\n```\n\nOverall, the results are very similar to the analysis with the full data.\n    \n    \n### Subjective rankings for second experiment\n\nRead the data:\n```{r create_rankdata_exp2, eval = FALSE, cache=TRUE}\npath \u003c- \"experiment2/data\"\nfiles \u003c- list.files(path, pattern = \"subjective\", full.names = TRUE)\nn \u003c- length(files)\nrankdata2 \u003c- data.frame(id = rep(1:n, each = 4),\n  viz = factor(rep(c(\"violin2\", \"ci\", \"violin\", \"gradient\")), \n    levels = c(\"violin2\", \"ci\", \"violin\", \"gradient\")),\n  rank = factor(NA, levels = 1:4))\nfor(i in 1:n) {\n  fb \u003c- fromJSON(files[i])\n  rankdata2$id[4*(i-1) + 1:4] \u003c- strsplit(strsplit(files[i], \"subjective\")[[1]], \".txt\")[[2]]\n  rankdata2$rank[4*(i-1) + 1:4] \u003c- factor(fb$rank)\n}\nrankdata2$viz \u003c- recode_factor(rankdata2$viz, \"ci\" = \"CI\", \n  \"gradient\" = \"Gradient\", \n  \"violin\" = \"Continuous Violin\", \n  \"violin2\" = \"Discrete Violin\")\nrankdata2$viz \u003c- relevel(rankdata2$viz, \"CI\")\nrankdata2$rank \u003c- factor(rankdata2$rank, ordered = TRUE)\nrankdata2$id \u003c- factor(rankdata2$id, levels = levels(data2$id))\nranks_exp2 \u003c- distinct(inner_join(rankdata2, data2[, c(\"id\", \"viz\", \"expertise\")]))\n```\n```{r, echo=FALSE, cache = TRUE}\nranks_exp2 \u003c- readRDS(\"experiment2/data/exp2_rankdata.rds\")\nfit_rank2 \u003c- readRDS(\"experiment2/results/fit_rank2.rds\")\n```\n\nAnd fit the same model as in the first experiment:\n```{r fit_rankmodel_exp2, cache = TRUE, eval = FALSE}\nfit_rank2 \u003c- brm(rank ~ viz + (1 | id), family = cumulative, \n  data = ranks_exp2, refresh = 0)\nsaveRDS(fit_rank2, file = \"experiment2/results/fit_rank2.rds\")\n```\n\nThe ranking probabilities:\n```{r rankmodel_exp2_plot, cache=TRUE}\neffects_exp2 \u003c- conditional_effects(fit_rank2, effects = \"viz\", \n  plot = FALSE, categorical = TRUE, \n  reformula=NA)\n\np \u003c- ggplot(effects_exp2[[1]], aes(x = viz, y = estimate__, colour = cats__)) + \n  geom_point(position=position_dodge(0.5)) + \n  geom_errorbar(width=0.25, aes(ymin=lower__, ymax = upper__), \n    position = position_dodge(0.5)) + \n  theme_classic() + \n  ylab(\"Ranking \\n probability\") + xlab(\"Representation\") +\n  scale_x_discrete(labels = \n      c(\"Classic CI\", \"Gradient CI\", \"Cont. violin CI\", \"Disc. violin CI\")) +\n  scale_color_manual(\"Rank\", \n    values = colsrank,\n    labels = c(\"1 (best)\", \"2\", \"3\", \"4 (worst)\")) + \n  theme(legend.position = \"bottom\", \n    legend.title = element_blank(),\n    axis.text.x = element_text(size = 12,hjust = 1, vjust = 1), \n    axis.text.y = element_text(size = 12),\n    axis.title.x = element_text(size = 14),\n    axis.title.y = element_text(size = 14),\n    legend.text = element_text(size = 14)) \np\n```\n```{r, eval = FALSE, echo = FALSE}\nggsave(p, file=\"experiment2/results/ranks2.pdf\",  \n  width = 2*8.5, height = 6, \n  unit = \"cm\", device = \"pdf\")\n```\n\nPreferences between different techniques seem to be quite similar, except there seems to be preferences towards discrete violin CI plot.","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fhelske%2Fstatvis","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Fhelske%2Fstatvis","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fhelske%2Fstatvis/lists"}