Belief Change Pilot

To-Do

• Run models with demographic covariates to improve precision
• Remove 3 Alex Prolific test responses
• Run models with indexes for credibility & stability
• Plot heterogeneity by social issue
• Remove 42/400 respondents who failed the attention check
• Figure out why there’s still 1 extra response
• Correct for multiple comparisons (maybe not necessary with the pilot?)
• Check for heterogeneous treatment effects by social issue (but maybe too small sample?)
• Calculate adjusted Cohen’s d for models that include the controls?

# Clear environment and set working directory
rm(list = ls())
setwd("~/Downloads/beliefchange")

# Load required libraries
library(tidyverse)

Warning: package 'purrr' was built under R version 4.3.3

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.2     ✔ tidyr     1.3.0
✔ purrr     1.0.4     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(psych)

Attaching package: 'psych'

The following objects are masked from 'package:ggplot2':

    %+%, alpha

library(broom)
library(gt)

Warning: package 'gt' was built under R version 4.3.3

library(lubridate)
library(effectsize)

Warning: package 'effectsize' was built under R version 4.3.3

Attaching package: 'effectsize'

The following object is masked from 'package:psych':

    phi

1. Load and preprocess raw data

raw <- read_csv("Belief Change Rate UPDATED_May 26, 2025_15.16.csv", col_names = FALSE)

Rows: 428 Columns: 107
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (107): X1, X2, X3, X4, X5, X6, X7, X8, X9, X10, X11, X12, X13, X14, X15,...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

varnames <- raw |> slice(1) |> unlist() |> as.character()
varlabels <- raw |> slice(2) |> unlist() |> as.character()

df <- raw |>
  slice(-1:-2) |>
  set_names(varnames) |>
  mutate(StartDate = mdy_hm(StartDate),
         socialissue = str_to_title(socialissue),
         across(matches("(_believe|_honest|_genuine|_stick|_revert)$"), as.numeric),
         attn_check_8 = as.numeric(attn_check_8)) |>
    filter(DistributionChannel == "anonymous",
           StartDate > mdy_hm("5/26/25 12:10"))

df <- df |>
  mutate(
    age_num         = as.numeric(age),
    gender_f        = factor(gender,
                             levels = c("1","2","3","4"),
                             labels = c("Man","Woman","Nonbinary/Agender","Other")),
    party_f         = factor(political_party,
                             levels = c("1","2","3","4"),
                             labels = c("Democrat","Republican","Independent","None"))
  )

2. Check DV value counts

dv_counts <- df |>
  select(matches("^(im|ca|gc|tr|cj)_(believe|honest|genuine|stick|revert)$")) |>
  pivot_longer(everything(), names_to = "variable", values_to = "value") |>
  mutate(value_label = case_when(
    is.na(value) ~ "missing",
    value %in% 1:7 ~ as.character(value),
    TRUE ~ "other"
  )) |>
  group_by(variable, value_label) |>
  summarise(count = n(), .groups = "drop") |>
  complete(
    variable,
    value_label = factor(c(as.character(1:7), "missing"), levels = c(as.character(1:7), "missing")),
    fill = list(count = 0)
  ) |>
  pivot_wider(names_from = value_label, values_from = count, names_sort = TRUE) |>
  mutate(total = rowSums(across(all_of(as.character(1:7))))) |>
  relocate(total, .after = variable) |>
  relocate(missing, .after = last_col())

# View count summary
dv_counts

# A tibble: 25 × 10
   variable   total   `1`   `2`   `3`   `4`   `5`   `6`   `7` missing
   <chr>      <dbl> <int> <int> <int> <int> <int> <int> <int>   <int>
 1 ca_believe   401    10    13    24    54   117   107    76       0
 2 ca_genuine   401     8    17    21    45   127   103    80       0
 3 ca_honest    401     8    11    23    55   106   113    85       0
 4 ca_revert    401    42    67    73    90    74    40    15       0
 5 ca_stick     401    20    28    43    89   113    72    36       0
 6 cj_believe   401    12    19    32    59   100    92    87       0
 7 cj_genuine   401    13    17    31    52   101   101    86       0
 8 cj_honest    401    12    14    28    61   100   101    85       0
 9 cj_revert    401    37    60    78    88    70    44    24       0
10 cj_stick     401    24    31    56    77    96    73    44       0
# ℹ 15 more rows

Everything looks good—no missing values.

df <- df |>
  mutate(
    cond = factor(cond,
                  levels = c("shortinfo", "longinfo", "shorttime", "longtime"))
  )

table(df$cond)

shortinfo  longinfo shorttime  longtime 
      101        98       101       101 

# ── Build per-respondent flags for each topic ──────────────────────────
issue_long <- df |>
  mutate(
    Immigration         = rowSums(pick(starts_with("im_"))) > 0,
    `Gun Control`       = rowSums(pick(starts_with("gc_"))) > 0,
    `Climate Action`    = rowSums(pick(starts_with("ca_"))) > 0,
    `Criminal Justice`  = rowSums(pick(starts_with("cj_"))) > 0,
    `Transgender Rights`= rowSums(pick(starts_with("tr_"))) > 0
  ) |>
  select(cond, `Immigration`:`Transgender Rights`) |>
  pivot_longer(-cond,
               names_to  = "socialissue_real",
               values_to = "seen") |>
  filter(seen)

# contingency table with exactly 5 rows per respondent
tab_real <- table(issue_long$socialissue_real, issue_long$cond)
tab_real

                    
                     shortinfo longinfo shorttime longtime
  Climate Action           101       98       101      101
  Criminal Justice         101       98       101      101
  Gun Control              101       98       101      101
  Immigration              101       98       101      101
  Transgender Rights       101       98       101      101

Remove people who failed the attention check

table(df$attn_check_8, useNA = "always")

  10   20   22   50   51   52   59   60   62   67   68   69   70   71   79   80 
   1    1    1    4    1    1    1    2    1    3    3    1    2    1    5    3 
  81   84   89   90   96   97   99  100 <NA> 
   1    1    1    3    1    1    4  358    0 

df <- df |>
  filter(attn_check_8 == 100)

3. Reshape for plotting/modeling

make_long_df <- function(df) {
  df |>
    select(cond, socialissue,          # keep old columns
           age_num, gender_f, party_f, # **new – covariates**
           matches("^(im|ca|gc|tr|cj)_(believe|honest|genuine|stick|revert)$")) |>
    pivot_longer(
      cols = -c(cond, socialissue, age_num, gender_f, party_f),
      names_to = c("type", "dimension"),
      names_sep = "_",
      values_to = "value"
    ) |>
    mutate(
      cond   = factor(cond,
                      levels = c("shortinfo","longinfo","shorttime","longtime"),
                      labels = c("Small Amount of Info","Large Amount of Info",
                                 "Small Reflection Time","Large Reflection Time")),
      group  = if_else(str_detect(cond, "Info"), "Amount of Info", "Reflection Time"),
      level  = factor(if_else(str_detect(cond, "Small"), "Small", "Large"),
                      levels = c("Small","Large")),
      dimension = factor(dimension,
                         levels = c("believe","genuine","honest","stick","revert"),
                         labels = c("Believability","Genuineness","Honesty",
                                    "Stick to New View","Revert to Old View")),
      socialissue = factor(socialissue,
                           levels = c("Climate Action","Criminal Justice",
                                      "Gun Control","Immigration","Transgender Rights"))
    )
}

df_long <- make_long_df(df)

4. Histograms

means_df <- df_long |> 
  group_by(group, dimension, level) |>
  summarise(median_value =  mean(value, na.rm = TRUE), .groups = "drop")

ggplot(df_long, aes(x = as.numeric(value), fill = level, color = level)) +
  geom_bar(position = "identity", alpha = 0.5, linewidth = 0.5, stat = "count") +
  geom_vline(
    data = means_df,
    aes(xintercept = median_value, color = level),
    linetype = "dashed",
    linewidth = 0.8,
    show.legend = FALSE
  ) +
  facet_grid(group ~ dimension, drop = FALSE) +
  labs(
    x = "Response (1–7 Scale)",
    y = "Count",
    title = "Perceived Credibility and Stability of Belief Change by Condition",
    subtitle = "Dashed vertical lines indicate mean response by condition.",
    fill = "Condition",
    color = "Condition"
  ) +
  theme_minimal(base_size = 12) +
  scale_x_continuous(breaks = 1:7)

5. Regressions and tables

# ------------------------------------------------------------------------
# 1.  Fit one lm per outcome within each condition group -----------------
run_models <- function(data_long) {
  set_names(levels(data_long$dimension)) |>
    map(\(dv)
      data_long |>
        filter(dimension == dv) |>
        mutate(level = factor(level),
               value = as.numeric(value)) |>
        lm(value ~ level, data = _))
}

models_info <- run_models(df_long |> filter(group == "Amount of Info"))
models_time <- run_models(df_long |> filter(group == "Reflection Time"))

# ------------------------------------------------------------------------
# 2.  Tidy, attach Intercept & Cohen’s d  --------------------------------
summarize_models <- function(models, group_lbl, data_grp) {
  map_df(names(models), \(dv) {
    
    # Cohen’s d  (Large – Small, so relevel puts Large first)
    d_val <- effectsize::cohens_d(
      value ~ relevel(level, ref = "Large"),
      data  = data_grp |>
              filter(dimension == dv) |>
              mutate(level = factor(level),
                     value = as.numeric(value))
    )$Cohens_d
    
    # tidy lm
    td <- tidy(models[[dv]], conf.int = TRUE)
    
    intercept_row <- td |> filter(term == "(Intercept)")
    slope_row     <- td |> filter(term == "levelLarge")
    
    slope_row |>
      transmute(
        Group                   = group_lbl,
        Outcome                 = dv,
        `Intercept (Control Avg)` = round(intercept_row$estimate, 2),
        estimate, conf.low, conf.high, std.error, p.value
      ) |>
      mutate(`Cohen's d` = round(d_val, 2))
  })
}

summary_table <- bind_rows(
  summarize_models(models_info, "Amount of Info",
                   df_long |> filter(group == "Amount of Info")),
  summarize_models(models_time, "Reflection Time",
                   df_long |> filter(group == "Reflection Time"))
) |>
  mutate(
    Stars = case_when(
      p.value < .001 ~ "***",
      p.value < .01  ~ "**",
      p.value < .05  ~ "*",
      TRUE           ~ ""
    ),
    `Estimate` = paste0(round(estimate, 2), " ", Stars),
    `95% CI`        = paste0("[", round(conf.low, 2), ", ", round(conf.high, 2), "]"),
    `Std. Error`    = round(std.error, 2),
    `p-value`       = round(p.value, 5)
  ) |>
  select(Group, Outcome, `Intercept (Control Avg)`, `Estimate`,
         `95% CI`, `Std. Error`, `p-value`, `Cohen's d`)

# ------------------------------------------------------------------------
# 3.  Build & render gt tables ------------------------------------------
make_gt_table <- function(df, title_txt) {
  df |>
    select(-Group) |>
    gt() |>
    tab_header(
      title    = title_txt,
      subtitle = "Linear regression estimates with 95% confidence intervals"
    ) |>
    cols_label(
  Outcome                 = "Outcome",
  `Intercept (Control Avg)` = "Intercept (Control Avg)",
  Estimate                = "Estimate",        # <- now matches column name
  `95% CI`                = "95% CI",
  `Std. Error`            = "Std. Error",
  `p-value`               = "p-value",
  `Cohen's d`             = "Cohen's d"
) |>
    tab_source_note(
      md("\\*p < .05, \\*\\*p < .01, \\*\\*\\*p < .001")
    ) |>
    tab_options(table.font.size = "small")
}

gt_info <- summary_table |> 
  filter(Group == "Amount of Info") |>
  make_gt_table("Large vs. Small Amount of Information — Credibility & Stability Outcomes")

gt_time <- summary_table |> 
  filter(Group == "Reflection Time") |>
  make_gt_table("Large vs. Small Reflection Time — Credibility & Stability Outcomes")

# -------------------------------------------------
# 1.  Helpers: lm() + summary with controls
# -------------------------------------------------
run_models_cov <- function(data_long) {
  set_names(levels(data_long$dimension)) |>
    map(\(dv)
        data_long |>
          filter(dimension == dv) |>
          mutate(level = factor(level),
                 value = as.numeric(value)) |>
          lm(value ~ level + age_num + gender_f + party_f, data = _))
}

summarize_models_cov <- function(models, group_lbl, data_grp) {
  map_df(names(models), \(dv) {
    
    d_val <- effectsize::cohens_d(
      value ~ relevel(level, ref = "Large"),
      data  = data_grp |>
              filter(dimension == dv) |>
              mutate(level = factor(level),
                     value = as.numeric(value))
    )$Cohens_d
    
    td <- tidy(models[[dv]], conf.int = TRUE)
    
    int  <- td |> filter(term == "(Intercept)")
    slope<- td |> filter(term == "levelLarge")
    
    slope |>
      transmute(
        Group                   = group_lbl,
        Outcome                 = dv,
        `Intercept (Control Avg)` = round(int$estimate, 2),
        estimate, conf.low, conf.high, std.error, p.value
      ) |>
      mutate(`Cohen's d` = round(d_val, 2))
  })
}
format_table <- function(tbl_raw) {
  tbl_raw |>
    mutate(
      Stars = case_when(
        p.value < .001 ~ "***",
        p.value < .01  ~ "**",
        p.value < .05  ~ "*",
        TRUE           ~ ""
      ),
      Estimate        = paste0(round(estimate, 2), " ", Stars),   # <- retain name
      `95% CI`        = paste0("[", round(conf.low, 2), ", ", round(conf.high, 2), "]"),
      `Std. Error`    = round(std.error, 2),
      `p-value`       = round(p.value, 3)
    ) |>
    select(Group, Outcome, `Intercept (Control Avg)`, Estimate,
           `95% CI`, `Std. Error`, `p-value`, `Cohen's d`)
}

# -------------------------------------------------
# 2.  ITEM-LEVEL tables with controls
# -------------------------------------------------
models_info_ctl <- run_models_cov(df_long |> filter(group == "Amount of Info"))
models_time_ctl <- run_models_cov(df_long |> filter(group == "Reflection Time"))

item_ctl_tbl <- bind_rows(
  summarize_models_cov(models_info_ctl, "Amount of Info",
                       df_long |> filter(group == "Amount of Info")),
  summarize_models_cov(models_time_ctl, "Reflection Time",
                       df_long |> filter(group == "Reflection Time"))
) |> format_table()

gt_info_ctl <- item_ctl_tbl |> 
  filter(Group == "Amount of Info") |>
  make_gt_table("INFO condition (with age, gender, party controls)")

gt_time_ctl <- item_ctl_tbl |> 
  filter(Group == "Reflection Time") |>
  make_gt_table("TIME condition (with age, gender, party controls)")

# Display in Quarto
gt_info

Large vs. Small Amount of Information — Credibility & Stability Outcomes
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Believability	4.76	0.6 ***	[0.4, 0.8]	0.10	0e+00	0.39
Genuineness	4.87	0.47 ***	[0.27, 0.67]	0.10	0e+00	0.31
Honesty	4.90	0.56 ***	[0.36, 0.76]	0.10	0e+00	0.37
Stick to New View	4.08	0.45 ***	[0.23, 0.67]	0.11	5e-05	0.27
Revert to Old View	4.15	-0.44 ***	[-0.65, -0.22]	0.11	7e-05	-0.27
*p < .05, **p < .01, ***p < .001

gt_info_ctl

INFO condition (with age, gender, party controls)
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Believability	4.61	0.63 ***	[0.43, 0.84]	0.10	0	0.39
Genuineness	4.76	0.5 ***	[0.3, 0.7]	0.10	0	0.31
Honesty	4.73	0.59 ***	[0.39, 0.78]	0.10	0	0.37
Stick to New View	4.08	0.43 ***	[0.21, 0.65]	0.11	0	0.27
Revert to Old View	4.07	-0.46 ***	[-0.67, -0.24]	0.11	0	-0.27
*p < .05, **p < .01, ***p < .001

gt_time

Large vs. Small Reflection Time — Credibility & Stability Outcomes
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Believability	4.78	0.48 ***	[0.27, 0.69]	0.11	0.00001	0.31
Genuineness	4.89	0.35 **	[0.14, 0.55]	0.11	0.00102	0.22
Honesty	4.91	0.42 ***	[0.21, 0.62]	0.10	0.00007	0.27
Stick to New View	4.29	0.2	[-0.02, 0.41]	0.11	0.07355	0.12
Revert to Old View	3.69	-0.06	[-0.27, 0.15]	0.11	0.54818	-0.04
*p < .05, **p < .01, ***p < .001

gt_time_ctl

TIME condition (with age, gender, party controls)
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Believability	4.24	0.52 ***	[0.31, 0.73]	0.11	0.000	0.31
Genuineness	4.19	0.39 ***	[0.18, 0.6]	0.10	0.000	0.22
Honesty	4.39	0.46 ***	[0.25, 0.66]	0.10	0.000	0.27
Stick to New View	3.86	0.23 *	[0.01, 0.44]	0.11	0.038	0.12
Revert to Old View	3.87	-0.06	[-0.27, 0.15]	0.11	0.574	-0.04
*p < .05, **p < .01, ***p < .001

6. Appendix

6a. Seperating by social issue

Though less precision given smaller sample sizes.

### 6a  Heterogeneity by *actual* social issue
# (each respondent contributes all five issues)

# ❶ Map the `type` prefix → issue label — done once
issue_labs <- c(
  im = "Immigration",
  gc = "Gun Control",
  ca = "Climate Action",
  cj = "Criminal Justice",
  tr = "Transgender Rights"
)

df_long_by_issue <- df_long |>
  mutate(socialissue_real = recode(type, !!!issue_labs))

# ❷ Means for dashed lines
means_by_issue <- df_long_by_issue |>
  group_by(group, socialissue_real, dimension, level) |>
  summarise(mean_value = mean(value), .groups = "drop")

# ❸ Plot · Amount-of-Info
ggplot(df_long_by_issue |> filter(group == "Amount of Info"),
       aes(x = value, fill = level, colour = level)) +
  geom_bar(position = "identity", alpha = .5, linewidth = .4, binwidth = 1) +
  geom_vline(data = means_by_issue |> filter(group == "Amount of Info"),
             aes(xintercept = mean_value, colour = level),
             linetype = "dashed", linewidth = .8, show.legend = FALSE) +
  facet_grid(socialissue_real ~ dimension) +
  labs(title = "Ratings by Issue (Amount-of-Info Conditions)",
       subtitle = "Dashed lines = group means",
       x = "Response (1–7)", y = "Count",
       fill = "Condition", colour = "Condition") +
  theme_minimal(base_size = 11) +
  scale_x_continuous(breaks = 1:7)

Warning in geom_bar(position = "identity", alpha = 0.5, linewidth = 0.4, :
Ignoring unknown parameters: `binwidth`

# ❹ Plot · Reflection-Time
ggplot(df_long_by_issue |> filter(group == "Reflection Time"),
       aes(x = value, fill = level, colour = level)) +
  geom_bar(position = "identity", alpha = .5, linewidth = .4, binwidth = 1) +
  geom_vline(data = means_by_issue |> filter(group == "Reflection Time"),
             aes(xintercept = mean_value, colour = level),
             linetype = "dashed", linewidth = .8, show.legend = FALSE) +
  facet_grid(socialissue_real ~ dimension) +
  labs(title = "Ratings by Issue (Reflection-Time Conditions)",
       subtitle = "Dashed lines = group means",
       x = "Response (1–7)", y = "Count",
       fill = "Condition", colour = "Condition") +
  theme_minimal(base_size = 11) +
  scale_x_continuous(breaks = 1:7)

Warning in geom_bar(position = "identity", alpha = 0.5, linewidth = 0.4, :
Ignoring unknown parameters: `binwidth`

6b. Cronbach’s Alpha

# ---- Credibility index -------------------------------------------------
cred_items <- df |>
  select(matches("_(genuine|honest|believe)$"))

# ---- Stability index ---------------------------------------------------
stab_items <- df |>
  select(matches("_(stick|revert)$"))

table(stab_items$im_revert, useNA = "always")

   1    2    3    4    5    6    7 <NA> 
  31   53   65   84   80   32   13    0 

stab_items <- stab_items |>
  mutate(across(ends_with("_revert"), ~ 8 - .))   # 1–7 scale → reverse

table(stab_items$im_revert, useNA = "always")

   1    2    3    4    5    6    7 <NA> 
  13   32   80   84   65   53   31    0 

cred_alpha <- alpha(cred_items)
stab_alpha <- alpha(stab_items)

cred_alpha$total[["raw_alpha"]]  # quick numeric output

[1] 0.9578552

stab_alpha$total[["raw_alpha"]]

[1] 0.8358806

# Full printed report (includes item-total correlations, α if item dropped):
print(cred_alpha)

Reliability analysis   
Call: alpha(x = cred_items)

  raw_alpha std.alpha G6(smc) average_r S/N    ase mean  sd median_r
      0.96      0.96    0.98       0.6  23 0.0034  5.1 1.2     0.57

    95% confidence boundaries 
         lower alpha upper
Feldt     0.95  0.96  0.96
Duhachek  0.95  0.96  0.96

 Reliability if an item is dropped:
           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
im_believe      0.95      0.95    0.98      0.60  21   0.0036 0.014  0.57
im_honest       0.95      0.95    0.98      0.60  21   0.0037 0.014  0.57
im_genuine      0.95      0.95    0.98      0.60  21   0.0036 0.014  0.57
gc_believe      0.95      0.96    0.98      0.60  21   0.0036 0.014  0.58
gc_honest       0.95      0.96    0.98      0.60  21   0.0036 0.014  0.57
gc_genuine      0.96      0.96    0.98      0.61  21   0.0036 0.014  0.58
ca_believe      0.96      0.96    0.98      0.61  22   0.0036 0.013  0.58
ca_honest       0.96      0.96    0.98      0.61  22   0.0036 0.013  0.58
ca_genuine      0.96      0.96    0.98      0.61  22   0.0035 0.013  0.58
cj_believe      0.95      0.95    0.98      0.60  21   0.0036 0.013  0.57
cj_honest       0.95      0.95    0.98      0.60  21   0.0037 0.014  0.57
cj_genuine      0.95      0.96    0.98      0.60  21   0.0036 0.014  0.57
tr_believe      0.96      0.96    0.98      0.61  22   0.0036 0.014  0.58
tr_honest       0.96      0.96    0.98      0.61  22   0.0036 0.013  0.58
tr_genuine      0.96      0.96    0.98      0.61  22   0.0036 0.013  0.58

 Item statistics 
             n raw.r std.r r.cor r.drop mean  sd
im_believe 358  0.82  0.82  0.81   0.78  5.1 1.5
im_honest  358  0.83  0.84  0.83   0.81  5.2 1.5
im_genuine 358  0.81  0.81  0.80   0.77  5.1 1.5
gc_believe 358  0.81  0.80  0.79   0.77  4.9 1.7
gc_honest  358  0.80  0.79  0.79   0.76  5.0 1.7
gc_genuine 358  0.79  0.79  0.78   0.75  4.9 1.7
ca_believe 358  0.77  0.78  0.77   0.74  5.2 1.4
ca_honest  358  0.77  0.78  0.77   0.73  5.3 1.4
ca_genuine 358  0.74  0.75  0.74   0.70  5.3 1.4
cj_believe 358  0.81  0.81  0.81   0.78  5.1 1.6
cj_honest  358  0.82  0.82  0.81   0.79  5.2 1.5
cj_genuine 358  0.80  0.79  0.79   0.76  5.1 1.6
tr_believe 358  0.78  0.77  0.76   0.74  4.9 1.6
tr_honest  358  0.78  0.78  0.77   0.75  5.0 1.6
tr_genuine 358  0.79  0.78  0.78   0.75  4.9 1.6

Non missing response frequency for each item
              1    2    3    4    5    6    7 miss
im_believe 0.03 0.04 0.10 0.12 0.28 0.23 0.20    0
im_honest  0.02 0.04 0.08 0.13 0.27 0.25 0.21    0
im_genuine 0.02 0.05 0.07 0.14 0.26 0.27 0.20    0
gc_believe 0.05 0.06 0.10 0.13 0.26 0.21 0.19    0
gc_honest  0.04 0.05 0.09 0.14 0.23 0.22 0.23    0
gc_genuine 0.04 0.06 0.10 0.15 0.22 0.24 0.19    0
ca_believe 0.02 0.04 0.06 0.13 0.30 0.25 0.20    0
ca_honest  0.02 0.03 0.06 0.13 0.27 0.27 0.22    0
ca_genuine 0.02 0.04 0.06 0.10 0.32 0.25 0.21    0
cj_believe 0.03 0.05 0.08 0.13 0.25 0.23 0.22    0
cj_honest  0.03 0.04 0.08 0.15 0.23 0.25 0.22    0
cj_genuine 0.03 0.04 0.08 0.12 0.24 0.25 0.23    0
tr_believe 0.05 0.04 0.09 0.16 0.24 0.24 0.16    0
tr_honest  0.04 0.06 0.07 0.15 0.22 0.26 0.20    0
tr_genuine 0.04 0.06 0.08 0.17 0.25 0.22 0.18    0

print(stab_alpha)

Reliability analysis   
Call: alpha(x = stab_items)

  raw_alpha std.alpha G6(smc) average_r S/N   ase mean sd median_r
      0.84      0.84    0.88      0.34 5.1 0.013  4.3  1     0.32

    95% confidence boundaries 
         lower alpha upper
Feldt     0.81  0.84  0.86
Duhachek  0.81  0.84  0.86

 Reliability if an item is dropped:
          raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
im_stick       0.82      0.82    0.86      0.33 4.5    0.015 0.016  0.32
im_revert      0.81      0.81    0.86      0.33 4.4    0.015 0.016  0.32
gc_stick       0.81      0.82    0.86      0.33 4.4    0.015 0.016  0.32
gc_revert      0.81      0.81    0.86      0.33 4.4    0.015 0.016  0.32
ca_stick       0.82      0.82    0.86      0.34 4.7    0.014 0.017  0.35
ca_revert      0.83      0.83    0.86      0.35 4.8    0.014 0.015  0.34
cj_stick       0.82      0.82    0.86      0.34 4.6    0.014 0.018  0.33
cj_revert      0.83      0.83    0.87      0.35 4.8    0.014 0.017  0.34
tr_stick       0.83      0.83    0.86      0.35 4.8    0.014 0.015  0.33
tr_revert      0.82      0.82    0.86      0.34 4.6    0.014 0.018  0.33

 Item statistics 
            n raw.r std.r r.cor r.drop mean  sd
im_stick  358  0.67  0.68  0.64   0.57  4.4 1.6
im_revert 358  0.69  0.69  0.66   0.59  4.2 1.6
gc_stick  358  0.69  0.69  0.66   0.59  4.2 1.7
gc_revert 358  0.69  0.69  0.66   0.59  4.1 1.7
ca_stick  358  0.60  0.61  0.56   0.49  4.5 1.5
ca_revert 358  0.57  0.58  0.53   0.45  4.3 1.6
cj_stick  358  0.63  0.63  0.58   0.52  4.4 1.7
cj_revert 358  0.59  0.59  0.54   0.47  4.3 1.7
tr_stick  358  0.59  0.58  0.54   0.46  4.2 1.7
tr_revert 358  0.63  0.63  0.59   0.52  4.1 1.7

Non missing response frequency for each item
             1    2    3    4    5    6    7 miss
im_stick  0.05 0.08 0.13 0.23 0.23 0.18 0.09    0
im_revert 0.04 0.09 0.22 0.23 0.18 0.15 0.09    0
gc_stick  0.07 0.13 0.13 0.21 0.20 0.16 0.10    0
gc_revert 0.07 0.11 0.19 0.22 0.18 0.15 0.08    0
ca_stick  0.05 0.07 0.11 0.22 0.29 0.17 0.09    0
ca_revert 0.04 0.10 0.17 0.23 0.18 0.17 0.10    0
cj_stick  0.06 0.08 0.15 0.19 0.23 0.18 0.11    0
cj_revert 0.06 0.11 0.16 0.22 0.21 0.16 0.09    0
tr_stick  0.08 0.12 0.12 0.25 0.20 0.15 0.08    0
tr_revert 0.07 0.12 0.16 0.25 0.19 0.12 0.09    0

6c. Create Indexes for Credibility & Stability

df <- df |>
  mutate(
    cred_index = rowMeans(cred_items),
    stab_index = rowMeans(stab_items)
  )

# ---- Reshape to long format with indices ---------------------------

df_long_idx <- df |>
  select(cond, age_num, gender_f, party_f, cred_index, stab_index) |>
  pivot_longer(
    cols      = c(cred_index, stab_index),
    names_to  = "dimension",
    values_to = "value"
  ) |>
  mutate(
    cond  = factor(cond,
                   levels = c("shortinfo","longinfo","shorttime","longtime"),
                   labels = c("Small Amount of Info","Large Amount of Info",
                              "Small Reflection Time","Large Reflection Time")),
    group = if_else(str_detect(cond, "Info"), "Amount of Info", "Reflection Time"),
    level = factor(if_else(str_detect(cond, "Small"), "Small", "Large"),
                   levels = c("Small","Large")),
    dimension = factor(dimension,
                       levels = c("cred_index","stab_index"),
                       labels = c("Credibility Index","Stability Index"))
  )

# ---- Plot histograms of the indices ---------------------------------

# compute means for dashed lines
means_idx <- df_long_idx |>
  group_by(group, dimension, level) |>
  summarise(mean_value = mean(value, na.rm = TRUE), .groups = "drop")

ggplot(df_long_idx, aes(x = value, fill = level, color = level)) +
  geom_density(alpha = 0.5, linewidth = 1) +
  geom_vline(
    data = means_idx,
    aes(xintercept = mean_value, color = level),
    linetype  = "dashed", linewidth = 0.8, show.legend = FALSE
  ) +
  facet_grid(group ~ dimension, drop = FALSE) +
  scale_x_continuous(breaks = 1:7, limits = c(1, 7)) +
  labs(
    title    = "Credibility and Stability Indices by Experimental Condition",
    subtitle = "Smoothed densities with dashed vertical lines for group means.",
    x        = "Index Score (1–7)",
    y        = "Density",
    fill     = "Condition",
    color    = "Condition"
  ) +
  theme_minimal(base_size = 12)

6d. Indexes Regression Tables

# A. fit one lm per index within each group -----------------------
run_models_idx <- function(data_idx) {
  set_names(levels(data_idx$dimension)) |>
    map(\(dv)
      data_idx |>
        filter(dimension == dv) |>
        mutate(level = factor(level),
               value = as.numeric(value)) |>
        lm(value ~ level, data = _))
}

models_info_idx <- run_models_idx(df_long_idx |> filter(group == "Amount of Info"))
models_time_idx <- run_models_idx(df_long_idx |> filter(group == "Reflection Time"))

# B. summarise, add intercept & Cohen’s d -------------------------
summary_idx_raw <- bind_rows(
  summarize_models(models_info_idx, "Amount of Info",
                   df_long_idx |> filter(group == "Amount of Info")),
  summarize_models(models_time_idx, "Reflection Time",
                   df_long_idx |> filter(group == "Reflection Time"))
)

summary_idx <- summary_idx_raw |>
  mutate(
    Stars = case_when(
      p.value < .001 ~ "***",
      p.value < .01  ~ "**",
      p.value < .05  ~ "*",
      TRUE           ~ ""
    ),
    `Estimate` = paste0(round(estimate, 2), " ", Stars),
    `95% CI`        = paste0("[", round(conf.low, 2), ", ", round(conf.high, 2), "]"),
    `Std. Error`    = round(std.error, 2),
    `p-value`       = round(p.value, 3)
  ) |>
  select(Group, Outcome, `Intercept (Control Avg)`, `Estimate`,
         `95% CI`, `Std. Error`, `p-value`, `Cohen's d`)

# C. build & render index tables ---------------------------------
gt_info_idx <- summary_idx |>
  filter(Group == "Amount of Info") |>
  make_gt_table(
    "Large vs. Small Amount of Information on Credibility & Stability Indices"
  )

gt_time_idx <- summary_idx |>
  filter(Group == "Reflection Time") |>
  make_gt_table(
    "Large vs. Small Reflection Time on Credibility & Stability Indices"
  )

# -------------------------------------------------
# 3.  INDEX-LEVEL tables with controls
# -------------------------------------------------
models_info_idx_ctl <- run_models_cov(df_long_idx |> filter(group == "Amount of Info"))
models_time_idx_ctl <- run_models_cov(df_long_idx |> filter(group == "Reflection Time"))

idx_ctl_tbl <- bind_rows(
  summarize_models_cov(models_info_idx_ctl, "Amount of Info",
                       df_long_idx |> filter(group == "Amount of Info")),
  summarize_models_cov(models_time_idx_ctl, "Reflection Time",
                       df_long_idx |> filter(group == "Reflection Time"))
) |> format_table()

gt_info_idx_ctl <- idx_ctl_tbl |> 
  filter(Group == "Amount of Info") |>
  make_gt_table("INFO condition – Cred/Stab Indices (controls)")

gt_time_idx_ctl <- idx_ctl_tbl |> 
  filter(Group == "Reflection Time") |>
  make_gt_table("TIME condition – Cred/Stab Indices (controls)")

gt_info_idx

Large vs. Small Amount of Information on Credibility & Stability Indices
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Credibility Index	4.84	0.55 **	[0.19, 0.91]	0.18	0.003	0.45
Stability Index	3.96	0.44 **	[0.13, 0.75]	0.16	0.005	0.42
*p < .05, **p < .01, ***p < .001

gt_info_idx_ctl

INFO condition – Cred/Stab Indices (controls)
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Credibility Index	4.70	0.57 **	[0.21, 0.93]	0.18	0.002	0.45
Stability Index	4.01	0.44 **	[0.13, 0.76]	0.16	0.006	0.42
*p < .05, **p < .01, ***p < .001

gt_time_idx

Large vs. Small Reflection Time on Credibility & Stability Indices
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Credibility Index	4.86	0.41 *	[0.06, 0.77]	0.18	0.024	0.34
Stability Index	4.30	0.13	[-0.17, 0.43]	0.15	0.386	0.13
*p < .05, **p < .01, ***p < .001

gt_time_idx_ctl

TIME condition – Cred/Stab Indices (controls)
Linear regression estimates with 95% confidence intervals
Outcome	Intercept (Control Avg)	Estimate	95% CI	Std. Error	p-value	Cohen's d
Credibility Index	4.27	0.46 *	[0.09, 0.82]	0.18	0.014	0.34
Stability Index	3.99	0.14	[-0.16, 0.45]	0.15	0.344	0.13
*p < .05, **p < .01, ***p < .001