Overview

This document reproduces all analyses reported in the paper across three studies (N = 549 total). Data are hosted on OSF at https://osf.io/tv7xb/.


Setup

library(dplyr)
library(ggplot2)
library(patchwork)
library(emmeans)
library(psych)
# ── Response-scale maps ──────────────────────────────────────────────────────
agree_map <- c(
  "Strognly disagree"          = 1,   # typo present in raw data
  "Strongly disagree"          = 1,
  "Somewhat disagree"          = 2,
  "Neither agree nor disagree" = 3,
  "Somewhat agree"             = 4,
  "Strongly agree"             = 5
)

likely_map <- c(
  "Extremely unlikely"          = 1,
  "Somewhat unlikely"           = 2,
  "Neither likely nor unlikely" = 3,
  "Somewhat likely"             = 4,
  "Extremely likely"            = 5
)

wtp_map <- c(
  "Nothing more" = 0,
  "$0.50 more"   = 0.5,
  "$1.00 more"   = 1,
  "$1.50 more"   = 1.5,
  "$2.00 more"   = 2,
  "$2.50 more"   = 2.5,
  "$3.00 more"   = 3,
  "$3.50 more"   = 3.5,
  "$4.00 more"   = 4,
  "$4.50 more"   = 4.5,
  "$5.00+ more"  = 5
)

yes_no_map <- c(
  "Definitely no"  = 1,
  "Probably no"    = 2,
  "Not sure"       = 3,
  "Probably yes"   = 4,
  "Definitely yes" = 5
)

# ── Utility: replace "-99" with NA ──────────────────────────────────────────
na_99 <- function(x) {
  x <- as.character(x)
  x[x == "-99"] <- NA
  x
}
as_num_na99 <- function(x) as.numeric(na_99(x))

# ── Shared Likert histogram theme & plot function ────────────────────────────
theme_apa_hist <- function(base_size = 14) {
  theme_classic(base_size = base_size) %+replace%
    theme(
      panel.grid       = element_blank(),
      axis.line        = element_line(color = "black", linewidth = 0.8),
      plot.title       = element_text(hjust = 0.5, face = "plain",
                                      size = base_size + 1,
                                      margin = margin(b = 10)),
      axis.title.y     = element_text(angle = 90, margin = margin(r = 10)),
      axis.title.x     = element_text(margin = margin(t = 8)),
      plot.margin      = margin(6, 8, 6, 8)
    )
}

likert_labels <- c(
  "Strongly\ndisagree", "Somewhat\ndisagree",
  "Neither agree\nnor disagree", "Somewhat\nagree", "Strongly\nagree"
)

plot_likert_hist <- function(df, var, title, show_x = FALSE) {
  df2 <- df |>
    transmute(x = .data[[var]]) |>
    filter(!is.na(x), x >= 1, x <= 5)
  
  n <- nrow(df2)
  
  ggplot(df2, aes(x = x, y = after_stat(count) / n * 100)) +
    geom_bar(width = 1, color = "black", fill = "grey75", linewidth = 0.5) +
    scale_x_continuous(
      breaks = 1:5,
      labels = if (show_x) likert_labels else NULL,
      expand = c(0, 0)
    ) +
    scale_y_continuous(
      limits = c(0, 60),
      expand = expansion(mult = c(0, 0.05)),
      labels = function(x) paste0(x, "%")
    ) +
    labs(
      title = title,
      x     = if (show_x) "Response" else NULL,
      y     = "Percentage"
    ) +
    theme_apa_hist()
}

Study 1

Goal: Test how often consumers infer that a GLP-1 “support” smoothie powder literally contains GLP-1 as an ingredient.

Data import & cleaning

# ── Replace these URLs with your OSF download links ─────────────────────────
# Pattern: https://osf.io/FILEID/download
# S1 file is stored under https://osf.io/tv7xb/files/t7cyn — locate the
# individual file permalink on OSF and append /download.
# Example placeholder (update before publishing):
s1_url <- "https://osf.io/t7cyn/download"

dat1 <- read.csv(s1_url, comment.char = "#")

# Drop extra header rows and test responses
dat1 <- dat1[-c(1:10), ]

# Keep only participants who passed the attention check
dat1 <- subset(dat1, product.type == "Smoothie Supplement Powder")

Descriptive statistics (Table 1)

x     <- dat1$contains.glp1
blank <- is.na(x) | x == ""

has_glp1      <- grepl("\\bGLP-1\\b", x)
count_selected <- ifelse(blank, 0, lengths(strsplit(x, ",")))
N             <- length(x)

tab1 <- data.frame(
  Group = c(
    "Selected GLP-1 as an ingredient",
    "Selected GLP-1 as the *only* ingredient",
    "Selected GLP-1 with other ingredients",
    "Selected other ingredients but not GLP-1"
  ),
  n = c(
    sum(has_glp1),
    sum(has_glp1 & count_selected == 1),
    sum(has_glp1 & count_selected > 1),
    sum(!has_glp1 & count_selected > 0)
  )
)
tab1$`%` <- round(100 * tab1$n / N, 1)

knitr::kable(
  tab1,
  caption = "Table 1. Ingredient selections for the GLP-1 support product (Study 1, N = 117)."
)
Table 1. Ingredient selections for the GLP-1 support product (Study 1, N = 117).
Group n %
Selected GLP-1 as an ingredient 114 97.4
Selected GLP-1 as the only ingredient 73 62.4
Selected GLP-1 with other ingredients 41 35.0
Selected other ingredients but not GLP-1 3 2.6

Because endorsement of GLP-1 as an ingredient was near ceiling (97.4% selected GLP-1), there was insufficient variability to support meaningful inferential tests. Results are limited to descriptive statistics.


Study 2

Goal: Replicate the ingredient-inference effect using graded dose-response belief measures and three advertisement stimuli (N = 136).

Data import & cleaning

s2_url <- "https://osf.io/m3xtc/download"   # update with OSF permalink

dat2 <- read.csv(s2_url, comment.char = "#")

# Drop extra header rows; rows 52–53 are early participants who missed items
dat2 <- dat2[-c(1:11, 52:53), ]
dat2 <- subset(dat2, product.type == "Smoothie Supplement Powder")

# ── Recode core variables ────────────────────────────────────────────────────
dat2$effect.like.glp1 <- unname(agree_map[as.character(dat2$effect.like.glp1)])
dat2$similar.to.glp1  <- unname(agree_map[as.character(dat2$similar.to.glp1)])
dat2$works.like.glp1  <- unname(agree_map[as.character(dat2$works.like.glp1)])

# False-belief composite
dat2$glp1_belief_mean <- rowMeans(
  dat2[, c("effect.like.glp1", "similar.to.glp1", "works.like.glp1")],
  na.rm = TRUE
)

# Product evaluation composite
eval_items2 <- data.frame(
  purchase1 = unname(likely_map[as.character(dat2$purchase1)]),
  purchase2 = unname(agree_map[as.character(dat2$purchase2)]),
  appealing = unname(agree_map[as.character(dat2$appealing)])
)
dat2$eval_mean <- rowMeans(eval_items2, na.rm = TRUE)

# WTP
dat2$wtp <- as.numeric(unname(wtp_map[as.character(dat2$wtp)]))

# Prescription-knowledge item
script_map <- c(
  "Definitely no"  = 1, "Probably no" = 2, "Not sure" = 3,
  "Probably yes"   = 4, "Definitely yes" = 5
)
dat2$script.required <- unname(script_map[as.character(dat2$script.required)])

# Demographics
dat2$age <- as.numeric(dat2$age)
dat2$bmi <- (as.numeric(dat2$weight) / (as.numeric(dat2$height_1)^2)) * 703

dat2$income <- as.numeric(factor(
  na_99(dat2$income),
  levels = c("$0 - $19,999","$20,000 - $39,999","$40,000 - $59,999",
             "$60,000 - $89,999","$90,000 - $119,999",
             "$120,000 - $149,999","$150,000+"),
  ordered = TRUE
))

dat2$ses <- as.numeric(sub("^([0-9]+).*", "\\1", as.character(dat2$ses)))

dat2$gender_simple <- case_when(
  dat2$gender %in% c("Female","Female,Non-binary / third gender") ~ "Female",
  dat2$gender %in% c("Male","Male,Non-binary / third gender","Male,Transgender") ~ "Male",
  TRUE ~ NA_character_
)

race2 <- dat2$race
race2[grepl(",", race2) | grepl("prefer not to say", race2, ignore.case = TRUE)] <-
  "Other / Prefer not to say"
dat2$race_simple <- case_when(
  race2 == "White or European American" ~ "White",
  race2 == "Black or African American"  ~ "Black",
  race2 == "Asian"                       ~ "Asian",
  is.na(race2)                           ~ NA_character_,
  TRUE                                   ~ "Other"
) |> factor(levels = c("White","Black","Asian","Other"))

taking2 <- unname(yes_no_map[as.character(dat2$taking.glp1)])
dat2$glp1_exposure <- case_when(
  taking2 %in% c(4,5) ~ 1,
  taking2 %in% c(1,2) ~ 0,
  TRUE ~ NA_real_
)

dat2$condition <- as.factor(dat2$condition)

Scale reliability

# False-belief items
cat("=== False-belief scale (3 items) ===\n")
## === False-belief scale (3 items) ===
psych::alpha(dat2[, c("effect.like.glp1","similar.to.glp1","works.like.glp1")])[1]
## $total
##  raw_alpha std.alpha   G6(smc) average_r      S/N        ase     mean       sd
##  0.9425831 0.9427783 0.9187885 0.8459634 16.47589 0.00860451 3.676471 1.108843
##   median_r
##  0.8320618
# Inter-item correlations
cat("\nInter-item correlations:\n")
## 
## Inter-item correlations:
round(cor(dat2[, c("effect.like.glp1","similar.to.glp1","works.like.glp1")],
          use = "pairwise.complete.obs"), 2)
##                  effect.like.glp1 similar.to.glp1 works.like.glp1
## effect.like.glp1             1.00            0.88            0.83
## similar.to.glp1              0.88            1.00            0.83
## works.like.glp1              0.83            0.83            1.00
# Product evaluation items
cat("\n=== Product evaluation scale (3 items) ===\n")
## 
## === Product evaluation scale (3 items) ===
psych::alpha(eval_items2)
## 
## Reliability analysis   
## Call: psych::alpha(x = eval_items2)
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.97      0.97    0.95      0.91  29 0.005  2.4 1.4     0.91
## 
##     95% confidence boundaries 
##          lower alpha upper
## Feldt     0.95  0.97  0.97
## Duhachek  0.96  0.97  0.98
## 
##  Reliability if an item is dropped:
##           raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## purchase1      0.95      0.95    0.91      0.91  20   0.0084    NA  0.91
## purchase2      0.95      0.95    0.91      0.91  20   0.0086    NA  0.91
## appealing      0.95      0.95    0.91      0.91  20   0.0085    NA  0.91
## 
##  Item statistics 
##             n raw.r std.r r.cor r.drop mean  sd
## purchase1 136  0.97  0.97  0.94   0.93  2.2 1.3
## purchase2 135  0.97  0.97  0.94   0.93  2.5 1.4
## appealing 136  0.97  0.97  0.94   0.93  2.6 1.5
## 
## Non missing response frequency for each item
##              1    2    3    4    5 miss
## purchase1 0.43 0.19 0.16 0.17 0.05 0.00
## purchase2 0.38 0.13 0.16 0.25 0.08 0.01
## appealing 0.37 0.13 0.15 0.23 0.12 0.00
cat("\nInter-item correlations:\n")
## 
## Inter-item correlations:
round(cor(eval_items2, use = "pairwise.complete.obs"), 2)
##           purchase1 purchase2 appealing
## purchase1      1.00      0.91      0.91
## purchase2      0.91      1.00      0.91
## appealing      0.91      0.91      1.00

Descriptive statistics & Figure 2

# Endorsement rates (somewhat/strongly agree)
agree_pct <- function(x) round(100 * mean(x >= 4, na.rm = TRUE), 1)

cat("Endorsement rates (somewhat/strongly agree):\n")
## Endorsement rates (somewhat/strongly agree):
cat("  Has GLP-1-like effects:", agree_pct(dat2$effect.like.glp1), "%\n")
##   Has GLP-1-like effects: 73.3 %
cat("  Similar to GLP-1:      ", agree_pct(dat2$similar.to.glp1),  "%\n")
##   Similar to GLP-1:       72.8 %
cat("  Works like GLP-1:      ", agree_pct(dat2$works.like.glp1),  "%\n")
##   Works like GLP-1:       66.2 %
p1 <- plot_likert_hist(dat2, "effect.like.glp1", "Has GLP-1-like effects")
p2 <- plot_likert_hist(dat2, "similar.to.glp1",  "Similar to GLP-1")
p3 <- plot_likert_hist(dat2, "works.like.glp1",  "Works like GLP-1", show_x = TRUE)

p1 / p2 / p3
Figure 2. Distributions of endorsement that the product has GLP-1-like effects (Study 2).

Figure 2. Distributions of endorsement that the product has GLP-1-like effects (Study 2).

Condition differences (ANOVAs)

# False-belief strength by condition
m_belief2 <- aov(glp1_belief_mean ~ condition, data = dat2)
cat("=== Beliefs by condition ===\n"); summary(m_belief2)
## === Beliefs by condition ===
##              Df Sum Sq Mean Sq F value Pr(>F)
## condition     2   0.79  0.3961   0.319  0.728
## Residuals   133 165.19  1.2421
# Product evaluations by condition
m_prefer2 <- aov(eval_mean ~ condition, data = dat2)
cat("\n=== Evaluations by condition ===\n"); summary(m_prefer2)
## 
## === Evaluations by condition ===
##              Df Sum Sq Mean Sq F value Pr(>F)
## condition     2   3.07   1.536   0.838  0.435
## Residuals   133 243.64   1.832
# WTP by condition
m_wtp2 <- aov(wtp ~ condition, data = dat2)
cat("\n=== WTP by condition ===\n"); summary(m_wtp2)
## 
## === WTP by condition ===
##              Df Sum Sq Mean Sq F value Pr(>F)
## condition     2   1.55  0.7758   0.339  0.713
## Residuals   133 304.71  2.2910

Demographic predictors of false beliefs (Table 2)

m_demog2 <- lm(
  glp1_belief_mean ~ age + bmi + income + ses +
    gender_simple + race_simple + glp1_exposure + condition,
  data = na.omit(dat2)
)
summary(m_demog2)
## 
## Call:
## lm(formula = glp1_belief_mean ~ age + bmi + income + ses + gender_simple + 
##     race_simple + glp1_exposure + condition, data = na.omit(dat2))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.9027 -0.3981  0.2019  0.7110  1.7580 
## 
## Coefficients:
##                          Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             4.6383503  0.5429266   8.543 5.37e-14 ***
## age                    -0.0074446  0.0077468  -0.961   0.3385    
## bmi                    -0.0115383  0.0093403  -1.235   0.2192    
## income                 -0.1119193  0.0788102  -1.420   0.1582    
## ses                     0.0009389  0.0752588   0.012   0.9901    
## gender_simpleMale       0.1085691  0.2025112   0.536   0.5929    
## race_simpleBlack        0.6161984  0.3613507   1.705   0.0908 .  
## race_simpleAsian       -0.0564808  0.3630282  -0.156   0.8766    
## race_simpleOther        0.2649364  0.3477260   0.762   0.4476    
## glp1_exposure          -0.4556302  0.3825953  -1.191   0.2361    
## conditionmock           0.1166240  0.2519814   0.463   0.6443    
## conditionsmoothie_king -0.0833086  0.2596089  -0.321   0.7489    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.104 on 118 degrees of freedom
## Multiple R-squared:  0.1116, Adjusted R-squared:  0.02874 
## F-statistic: 1.347 on 11 and 118 DF,  p-value: 0.2075
confint(m_demog2)
##                              2.5 %      97.5 %
## (Intercept)             3.56320782 5.713492703
## age                    -0.02278541 0.007896231
## bmi                    -0.03003464 0.006957949
## income                 -0.26798488 0.044146362
## ses                    -0.14809409 0.149971871
## gender_simpleMale      -0.29245820 0.509596357
## race_simpleBlack       -0.09937445 1.331771167
## race_simpleAsian       -0.77537553 0.662413921
## race_simpleOther       -0.42365573 0.953528453
## glp1_exposure          -1.21327313 0.302012667
## conditionmock          -0.38236779 0.615615833
## conditionsmoothie_king -0.59740502 0.430787758
car::vif(m_demog2)
##                   GVIF Df GVIF^(1/(2*Df))
## age           1.107349  1        1.052307
## bmi           1.170358  1        1.081831
## income        1.968538  1        1.403046
## ses           2.024423  1        1.422822
## gender_simple 1.089185  1        1.043640
## race_simple   1.289671  3        1.043309
## glp1_exposure 1.209048  1        1.099567
## condition     1.215559  2        1.050011
shapiro.test(residuals(m_demog2))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m_demog2)
## W = 0.9093, p-value = 2.487e-07
lmtest::bptest(m_demog2)
## 
##  studentized Breusch-Pagan test
## 
## data:  m_demog2
## BP = 8.4855, df = 11, p-value = 0.6693
plot(m_demog2)

A few assumptions were violated, so we’ll run a bootstrapped model.

boot_demog2 <- car::Boot(m_demog2, R = 5000)
summary(boot_demog2)
## 
## Number of bootstrap replications R = 5000 
##                           original    bootBias    bootSE    bootMed
## (Intercept)             4.63835026 -0.02823450 0.5609807  4.6113401
## age                    -0.00744459 -0.00024621 0.0077345 -0.0075609
## bmi                    -0.01153835  0.00134917 0.0103436 -0.0109470
## income                 -0.11191926  0.00271298 0.0726120 -0.1086275
## ses                     0.00093889  0.00107705 0.0789708  0.0007107
## gender_simpleMale       0.10856908  0.00732795 0.1975563  0.1149586
## race_simpleBlack        0.61619836 -0.03528417 0.3171964  0.5797187
## race_simpleAsian       -0.05648080 -0.00109131 0.3851599 -0.0498997
## race_simpleOther        0.26493636  0.01182211 0.2957016  0.2857324
## glp1_exposure          -0.45563023 -0.00485698 0.5409207 -0.4435853
## conditionmock           0.11662402 -0.01947263 0.2591642  0.0966352
## conditionsmoothie_king -0.08330863 -0.01349561 0.2683256 -0.0954696
confint(boot_demog2, type = "perc")
## Bootstrap percent confidence intervals
## 
##                              2.5 %     97.5 %
## (Intercept)             3.46603898 5.69259793
## age                    -0.02275325 0.00692676
## bmi                    -0.02915258 0.01283392
## income                 -0.25604149 0.03206759
## ses                    -0.14625094 0.16689552
## gender_simpleMale      -0.27863781 0.50517593
## race_simpleBlack       -0.03979502 1.19164840
## race_simpleAsian       -0.83515272 0.68425062
## race_simpleOther       -0.32198836 0.83206148
## glp1_exposure          -1.58866167 0.58971908
## conditionmock          -0.41437002 0.60449513
## conditionsmoothie_king -0.61647319 0.43594577
confint(boot_demog2, type = "bca")
## Bootstrap bca confidence intervals
## 
##                              2.5 %      97.5 %
## (Intercept)             3.52102364 5.735575124
## age                    -0.02285777 0.006869729
## bmi                    -0.02918823 0.012671502
## income                 -0.26614505 0.020484044
## ses                    -0.14380212 0.173278031
## gender_simpleMale      -0.30240481 0.482143295
## race_simpleBlack        0.03803647 1.278561463
## race_simpleAsian       -0.84957105 0.655904998
## race_simpleOther       -0.47669996 0.745755151
## glp1_exposure          -1.66459455 0.548068885
## conditionmock          -0.37304847 0.643933760
## conditionsmoothie_king -0.59032161 0.461495555

False beliefs and product evaluations (Tables 3 & 4)

# Table 3: product evaluations ~ beliefs + demographics
m_eval2 <- lm(
  eval_mean ~ glp1_belief_mean + age + bmi + income + ses +
    gender_simple + race_simple + glp1_exposure + condition,
  data = na.omit(dat2)
)
summary(m_eval2)
## 
## Call:
## lm(formula = eval_mean ~ glp1_belief_mean + age + bmi + income + 
##     ses + gender_simple + race_simple + glp1_exposure + condition, 
##     data = na.omit(dat2))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.4713 -1.1241 -0.2465  1.0704  2.6774 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)   
## (Intercept)             0.696395   0.812138   0.857  0.39293   
## glp1_belief_mean        0.350278   0.108240   3.236  0.00158 **
## age                    -0.012470   0.009144  -1.364  0.17529   
## bmi                     0.018045   0.011053   1.633  0.10525   
## income                 -0.180416   0.093452  -1.931  0.05596 . 
## ses                     0.192388   0.088488   2.174  0.03171 * 
## gender_simpleMale       0.099297   0.238399   0.417  0.67780   
## race_simpleBlack        0.066263   0.430074   0.154  0.87782   
## race_simpleAsian       -0.469233   0.426887  -1.099  0.27394   
## race_simpleOther       -0.178539   0.409855  -0.436  0.66392   
## glp1_exposure           0.416598   0.452545   0.921  0.35917   
## conditionmock           0.363982   0.296545   1.227  0.22213   
## conditionsmoothie_king  0.208182   0.305377   0.682  0.49676   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.298 on 117 degrees of freedom
## Multiple R-squared:  0.1858, Adjusted R-squared:  0.1023 
## F-statistic: 2.225 on 12 and 117 DF,  p-value: 0.01458

Checking a few things:

# 95% CIs
confint(m_eval2)
##                               2.5 %      97.5 %
## (Intercept)            -0.912001080 2.304790721
## glp1_belief_mean        0.135915337 0.564641579
## age                    -0.030579135 0.005639961
## bmi                    -0.003845068 0.039934469
## income                 -0.365493022 0.004661691
## ses                     0.017141459 0.367634051
## gender_simpleMale      -0.372840687 0.571434021
## race_simpleBlack       -0.785475238 0.918002176
## race_simpleAsian       -1.314660171 0.376193425
## race_simpleOther       -0.990236217 0.633157458
## glp1_exposure          -0.479643468 1.312839478
## conditionmock          -0.223308870 0.951273364
## conditionsmoothie_king -0.396601704 0.812965891
# Multicollinearity
car::vif(m_eval2)
##                      GVIF Df GVIF^(1/(2*Df))
## glp1_belief_mean 1.125568  1        1.060928
## age              1.116015  1        1.056416
## bmi              1.185493  1        1.088804
## income           2.002182  1        1.414985
## ses              2.024426  1        1.422823
## gender_simple    1.091838  1        1.044911
## race_simple      1.327033  3        1.048287
## glp1_exposure    1.223580  1        1.106155
## condition        1.222854  2        1.051583
# Residual diagnostics
shapiro.test(residuals(m_eval2))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m_eval2)
## W = 0.95648, p-value = 0.0003692
lmtest::bptest(m_eval2)
## 
##  studentized Breusch-Pagan test
## 
## data:  m_eval2
## BP = 20.263, df = 12, p-value = 0.06227
# Bootstrap
set.seed(1234)
boot_eval2 <- car::Boot(m_eval2, R = 5000)
summary(boot_eval2)
## 
## Number of bootstrap replications R = 5000 
##                         original    bootBias    bootSE   bootMed
## (Intercept)             0.696395 -6.1970e-02 0.7516637  0.629308
## glp1_belief_mean        0.350278 -7.0022e-03 0.0877912  0.344736
## age                    -0.012470  4.4983e-05 0.0088363 -0.012466
## bmi                     0.018045  2.6269e-03 0.0128518  0.018942
## income                 -0.180416 -2.9488e-04 0.0987534 -0.179718
## ses                     0.192388  3.9484e-03 0.1066177  0.193193
## gender_simpleMale       0.099297 -3.7357e-03 0.2374789  0.093009
## race_simpleBlack        0.066263 -2.0891e-02 0.4624677  0.050564
## race_simpleAsian       -0.469233  1.1454e-02 0.4098306 -0.451160
## race_simpleOther       -0.178539  9.1645e-03 0.4121240 -0.173006
## glp1_exposure           0.416598 -8.1431e-03 0.3484391  0.412727
## conditionmock           0.363982  7.7287e-03 0.3134988  0.374321
## conditionsmoothie_king  0.208182 -5.4176e-03 0.3170942  0.200123
confint(boot_eval2, type = "perc")
## Bootstrap percent confidence intervals
## 
##                                2.5 %      97.5 %
## (Intercept)            -8.149724e-01 2.115551263
## glp1_belief_mean        1.690583e-01 0.514211479
## age                    -2.989289e-02 0.004487929
## bmi                    -5.785233e-05 0.052165884
## income                 -3.760666e-01 0.014592671
## ses                    -4.552821e-03 0.411778097
## gender_simpleMale      -3.707156e-01 0.552169329
## race_simpleBlack       -9.041250e-01 0.934884962
## race_simpleAsian       -1.277119e+00 0.340795413
## race_simpleOther       -9.672057e-01 0.652195664
## glp1_exposure          -3.093265e-01 1.080943446
## conditionmock          -2.434339e-01 0.972604387
## conditionsmoothie_king -4.229345e-01 0.827806741
confint(boot_eval2, type = "bca")
## Bootstrap bca confidence intervals
## 
##                               2.5 %      97.5 %
## (Intercept)            -0.649947579 2.318041819
## glp1_belief_mean        0.179896632 0.523719472
## age                    -0.029895783 0.004478506
## bmi                    -0.003564956 0.046776643
## income                 -0.370939250 0.021530602
## ses                    -0.022578461 0.393493903
## gender_simpleMale      -0.361192716 0.566403193
## race_simpleBlack       -0.857513474 0.994181581
## race_simpleAsian       -1.338550710 0.292452581
## race_simpleOther       -1.001594207 0.617515498
## glp1_exposure          -0.286692927 1.108338762
## conditionmock          -0.263274874 0.951217466
## conditionsmoothie_king -0.413257667 0.837402059
# Table 4: WTP ~ beliefs + demographics
m_wtp2_full <- lm(
  wtp ~ glp1_belief_mean + age + bmi + income + ses +
    gender_simple + race_simple + glp1_exposure + condition,
  data = na.omit(dat2)
)
summary(m_wtp2_full)
## 
## Call:
## lm(formula = wtp ~ glp1_belief_mean + age + bmi + income + ses + 
##     gender_simple + race_simple + glp1_exposure + condition, 
##     data = na.omit(dat2))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.6556 -0.9771 -0.3014  0.5439  3.8088 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)   
## (Intercept)            -0.349901   0.887128  -0.394  0.69399   
## glp1_belief_mean        0.376319   0.118234   3.183  0.00187 **
## age                    -0.018599   0.009989  -1.862  0.06510 . 
## bmi                     0.003449   0.012074   0.286  0.77567   
## income                 -0.137938   0.102081  -1.351  0.17922   
## ses                     0.301368   0.096659   3.118  0.00229 **
## gender_simpleMale      -0.304173   0.260412  -1.168  0.24516   
## race_simpleBlack        0.004260   0.469786   0.009  0.99278   
## race_simpleAsian       -0.662900   0.466304  -1.422  0.15780   
## race_simpleOther       -0.281246   0.447700  -0.628  0.53110   
## glp1_exposure           0.779581   0.494332   1.577  0.11749   
## conditionmock           0.161679   0.323927   0.499  0.61863   
## conditionsmoothie_king  0.080773   0.333575   0.242  0.80909   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.418 on 117 degrees of freedom
## Multiple R-squared:  0.2124, Adjusted R-squared:  0.1316 
## F-statistic: 2.629 on 12 and 117 DF,  p-value: 0.00382

Checking assumptions.

confint(m_wtp2_full)
##                              2.5 %      97.5 %
## (Intercept)            -2.10681188 1.407009814
## glp1_belief_mean        0.14216216 0.610475830
## age                    -0.03838108 0.001182394
## bmi                    -0.02046251 0.027359513
## income                 -0.34010471 0.064229088
## ses                     0.10993945 0.492795583
## gender_simpleMale      -0.81990655 0.211559937
## race_simpleBlack       -0.92612593 0.934646002
## race_simpleAsian       -1.58639102 0.260591446
## race_simpleOther       -1.16789263 0.605400846
## glp1_exposure          -0.19941691 1.758579080
## conditionmock          -0.47984087 0.803199128
## conditionsmoothie_king -0.57985463 0.741401179
car::vif(m_wtp2_full)
##                      GVIF Df GVIF^(1/(2*Df))
## glp1_belief_mean 1.125568  1        1.060928
## age              1.116015  1        1.056416
## bmi              1.185493  1        1.088804
## income           2.002182  1        1.414985
## ses              2.024426  1        1.422823
## gender_simple    1.091838  1        1.044911
## race_simple      1.327033  3        1.048287
## glp1_exposure    1.223580  1        1.106155
## condition        1.222854  2        1.051583
shapiro.test(residuals(m_wtp2_full))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m_wtp2_full)
## W = 0.91544, p-value = 5.593e-07
lmtest::bptest(m_wtp2_full)
## 
##  studentized Breusch-Pagan test
## 
## data:  m_wtp2_full
## BP = 15.348, df = 12, p-value = 0.2229
set.seed(1234)
boot_wtp2 <- car::Boot(m_wtp2_full, R = 5000)
summary(boot_wtp2)
## 
## Number of bootstrap replications R = 5000 
##                          original   bootBias   bootSE    bootMed
## (Intercept)            -0.3499010 -0.0589125 0.784112 -0.4060850
## glp1_belief_mean        0.3763190 -0.0022821 0.090496  0.3738312
## age                    -0.0185993 -0.0011854 0.010583 -0.0199102
## bmi                     0.0034485  0.0035343 0.013747  0.0047731
## income                 -0.1379378 -0.0048635 0.113565 -0.1415879
## ses                     0.3013675  0.0065352 0.119010  0.3035359
## gender_simpleMale      -0.3041733 -0.0097832 0.258120 -0.3148804
## race_simpleBlack        0.0042600 -0.0241183 0.582198 -0.0228569
## race_simpleAsian       -0.6628998  0.0509519 0.469804 -0.6529772
## race_simpleOther       -0.2812459  0.0016612 0.420418 -0.2988002
## glp1_exposure           0.7795811  0.0428563 0.566701  0.8146769
## conditionmock           0.1616791  0.0138320 0.344703  0.1764465
## conditionsmoothie_king  0.0807733  0.0156197 0.353035  0.1066027
confint(boot_wtp2, type = "perc")
## Bootstrap percent confidence intervals
## 
##                              2.5 %     97.5 %
## (Intercept)            -1.94644972 1.13187929
## glp1_belief_mean        0.20017790 0.55498621
## age                    -0.03996596 0.00140216
## bmi                    -0.01465780 0.03979243
## income                 -0.36556861 0.08015362
## ses                     0.08564410 0.55001544
## gender_simpleMale      -0.82270963 0.19624986
## race_simpleBlack       -1.13436380 1.13822647
## race_simpleAsian       -1.43092774 0.43584024
## race_simpleOther       -1.06920840 0.59669032
## glp1_exposure          -0.30718891 1.95305531
## conditionmock          -0.50570563 0.84839654
## conditionsmoothie_king -0.60451580 0.79028226
confint(boot_wtp2, type = "bca")
## Bootstrap bca confidence intervals
## 
##                              2.5 %      97.5 %
## (Intercept)            -1.85555955 1.224311026
## glp1_belief_mean        0.21004298 0.560910204
## age                    -0.03794710 0.003197798
## bmi                    -0.01778104 0.033062006
## income                 -0.35129756 0.090953414
## ses                     0.07436284 0.537650636
## gender_simpleMale      -0.80906334 0.210239385
## race_simpleBlack       -0.99643149 1.320978170
## race_simpleAsian       -1.35122088 0.665417569
## race_simpleOther       -1.00951325 0.683658232
## glp1_exposure          -0.30875203 1.951998291
## conditionmock          -0.53501922 0.820998829
## conditionsmoothie_king -0.68596362 0.725831914

Prescription knowledge and false beliefs

cor.test(dat2$script.required, dat2$glp1_belief_mean)
## 
##  Pearson's product-moment correlation
## 
## data:  dat2$script.required and dat2$glp1_belief_mean
## t = -1.7237, df = 134, p-value = 0.08707
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.30797884  0.02158659
## sample estimates:
##        cor 
## -0.1472815

Study 3

Goal: Replicate Study 2 in a larger, higher-powered sample and add psychological and social-media predictors (N = 363).

Data import & cleaning

s3_url <- "https://osf.io/ypztv/download"   # update with OSF permalink

dat3 <- read.csv(s3_url, comment.char = "#")

dat3 <- dat3[-c(1:10), ]
dat3 <- subset(dat3, product.type == "Smoothie Supplement Powder")

# ── Core DVs ─────────────────────────────────────────────────────────────────
dat3$effect.like.glp1 <- unname(agree_map[na_99(dat3$effect.like.glp1)])
dat3$similar.to.glp1  <- unname(agree_map[na_99(dat3$similar.to.glp1)])
dat3$works.like.glp1  <- unname(agree_map[na_99(dat3$works.like.glp1)])

dat3$glp1_belief_mean <- rowMeans(
  dat3[, c("effect.like.glp1","similar.to.glp1","works.like.glp1")],
  na.rm = TRUE
)

dat3$purchase1_num <- unname(likely_map[na_99(dat3$purchase1)])
dat3$purchase2_num <- unname(agree_map[na_99(dat3$purchase2)])
dat3$appealing_num <- unname(agree_map[na_99(dat3$appealing)])

dat3$prefer <- rowMeans(
  dat3[, c("purchase1_num","purchase2_num","appealing_num")],
  na.rm = TRUE
)

dat3$wtp <- as.numeric(unname(wtp_map[na_99(dat3$wtp)]))

# Prescription-knowledge item
dat3$script.required <- unname(script_map[as.character(dat3$script.required)])

# ── Demographics ─────────────────────────────────────────────────────────────
dat3$age <- as_num_na99(dat3$age)
dat3$bmi <- (as_num_na99(dat3$weight) / (as_num_na99(dat3$height_1)^2)) * 703
dat3$ses <- as.numeric(sub("^([0-9]+).*", "\\1", na_99(dat3$ses)))

dat3$income <- factor(
  na_99(dat3$income),
  levels = c("$0 - $19,999","$20,000 - $39,999","$40,000 - $59,999",
             "$60,000 - $89,999","$90,000 - $119,999",
             "$120,000 - $149,999","$150,000+"),
  ordered = TRUE
) |> as.numeric()

dat3$gender_simple <- case_when(
  na_99(dat3$gender) %in% c("Female","Female,Non-binary / third gender") ~ "Female",
  na_99(dat3$gender) %in% c("Male","Male,Non-binary / third gender","Male,Transgender") ~ "Male",
  TRUE ~ NA_character_
) |> factor(levels = c("Female","Male"))

race3 <- na_99(dat3$race)
race3[grepl(",", race3) | grepl("prefer not to say", race3, ignore.case = TRUE)] <-
  "Other / Prefer not to say"
dat3$race_simple <- case_when(
  race3 == "White or European American" ~ "White",
  race3 == "Black or African American"  ~ "Black",
  race3 == "Asian"                       ~ "Asian",
  is.na(race3)                           ~ NA_character_,
  TRUE                                   ~ "Other"
) |> factor(levels = c("White","Black","Asian","Other"))

dat3$taking.glp1_num <- unname(yes_no_map[na_99(dat3$taking.glp1)])
dat3$glp1_exposure <- case_when(
  dat3$taking.glp1_num %in% c(4,5) ~ 1,
  dat3$taking.glp1_num %in% c(1,2) ~ 0,
  TRUE ~ NA_real_
)

dat3$politics <- recode(
  na_99(dat3$politics),
  "Very liberal"                    = "1",
  "Liberal"                         = "2",
  "Somewhat liberal"                = "3",
  "Neither liberal nor conservative"= "4",
  "Somewhat conservative"           = "5",
  "Conservative"                    = "6",
  "Very conservative"               = "7",
  .default = NA_character_
) |> as.numeric()

dat3$FL_16_DO <- factor(na_99(dat3$FL_16_DO))
# ── Health anxiety (6 SHAI items, columns 40–45) ─────────────────────────────
health_anxt <- as.data.frame(dat3[, 40:45])

score_item_0to3 <- function(x, levels_key) {
  x <- na_99(x)
  as.numeric(factor(x, levels = levels_key, ordered = TRUE)) - 1
}

s1h <- score_item_0to3(health_anxt[[1]], c("Never","Occasionally","Much of the time","Most of the time"))
s2h <- score_item_0to3(health_anxt[[2]], c("Without a problem","Most of the time",
  "I try to resist thoughts of illness but am often unable to do so",
  "Thoughts of illness are so strong I no longer try to resist them"))
s3h <- score_item_0to3(health_anxt[[3]], c("Not at all","Sometimes","Often","Always"))
s4h <- score_item_0to3(health_anxt[[4]], c("Never","Sometimes","Often","Always"))
s5h <- score_item_0to3(health_anxt[[5]], c("Very low","Fairly low","Moderate","High"))
s6h <- score_item_0to3(health_anxt[[6]], c("Do not worry about my health",
  "Have a normal attitude about my health",
  "Worry too much about my health","Am a hypochondriac"))

dat3$ha_mean <- rowMeans(cbind(s1h, s2h, s3h, s4h, s5h, s6h), na.rm = TRUE)

# ── Weight loss concerns (5 items, columns 46–52) ────────────────────────────
dat3$afraid_3lbs <- recode(dat3[,46],
  "Very unafraid" = 1, "Unafraid" = 2,
  "Neither afraid nor unafraid" = 3, "Afraid" = 4, "Very afraid" = 5)

dat3$weight_importance <- as.numeric(factor(dat3[,47],
  levels = c("Not important at all","Barely important","Somewhat important",
             "Important","Very important")))

dat3[,48][dat3[,48] == "-99"] <- NA
dat3$ever_dieted <- as.numeric(factor(dat3[,48],
  levels = c("Definitely not","Probably not","Might or might not",
             "Probably yes","Definitely yes")))

dat3$need.lose.weight <- ifelse(dat3[,51] == "Yes", 1, 0)

dat3$scale_matters <- as.numeric(factor(dat3[,52],
  levels = c("Strongly disagree","Somewhat disagree","Neither agree nor disagree",
             "Somewhat agree","Strongly agree")))

dat3$wlc.average <- rowMeans(cbind(
  dat3$afraid_3lbs, dat3$weight_importance, dat3$ever_dieted,
  dat3$need.lose.weight, dat3$scale_matters), na.rm = TRUE)

# ── Body surveillance (7 items, columns 53–59) ───────────────────────────────
bs_items <- names(dat3)[53:59]
likert7_key <- c("Strongly disagree"=1,"Disagree"=2,"Somewhat disagree"=3,
                 "Neither agree nor disagree"=4,"Somewhat agree"=5,
                 "Agree"=6,"Strongly agree"=7)
for (v in bs_items) {
  x <- na_99(dat3[[v]]); x[x == "Not Applicable"] <- NA
  dat3[[v]] <- unname(likert7_key[x])
}
rev_bs <- intersect(c("bs1","bs2","bs3","bs6","bs7"), names(dat3))
dat3[rev_bs] <- lapply(dat3[rev_bs], function(x) ifelse(is.na(x), NA, 8 - x))
dat3$body_surv_mean <- rowMeans(dat3[, bs_items], na.rm = TRUE)

# ── Body appreciation (10 items, columns 60–69) ──────────────────────────────
ba_items <- names(dat3)[60:69]
ba_key <- c("Never"=1,"Seldom"=2,"Sometimes"=3,"Often"=4,"Always"=5)
for (v in ba_items) {
  x <- na_99(dat3[[v]]); x[x == "Not Applicable"] <- NA
  dat3[[v]] <- unname(ba_key[x])
}
dat3$body_appreciation_mean <- rowMeans(dat3[, ba_items], na.rm = TRUE)

# ── Eating disorder risk (7 yes/no items, columns 70–76) ─────────────────────
ed_items <- names(dat3)[70:76]
yn_key <- c("No"=0,"Yes"=1)
for (v in ed_items) {
  x <- na_99(dat3[[v]]); x[x == "Prefer not to say"] <- NA
  dat3[[v]] <- unname(yn_key[x])
}
dat3$ed_risk_total <- rowSums(dat3[, ed_items], na.rm = TRUE)

Scale reliability

cat("=== False-belief scale ===\n")
## === False-belief scale ===
psych::alpha(dat3[, c("effect.like.glp1","similar.to.glp1","works.like.glp1")])[1]
## $total
##  raw_alpha std.alpha  G6(smc) average_r      S/N         ase     mean       sd
##  0.9540386 0.9545878 0.938384 0.8751068 21.02053 0.004208446 3.617069 1.230947
##   median_r
##  0.8806055
cat("\n=== Product evaluation scale ===\n")
## 
## === Product evaluation scale ===
psych::alpha(dat3[, c("purchase1_num","purchase2_num","appealing_num")])[1]
## $total
##  raw_alpha std.alpha   G6(smc) average_r      S/N         ase     mean       sd
##  0.9669932 0.9680632 0.9563041  0.909942 30.31186 0.003014521 2.356122 1.368216
##   median_r
##  0.9028927
cat("\n=== Health anxiety (SHAI) ===\n")
## 
## === Health anxiety (SHAI) ===
psych::alpha(cbind(s1h, s2h, s3h, s4h, s5h, s6h))[1]
## $total
##  raw_alpha std.alpha   G6(smc) average_r      S/N         ase     mean
##  0.8883078 0.8887597 0.8764536 0.5711083 7.989546 0.008653013 1.004736
##         sd  median_r
##  0.6093592 0.6029069
cat("\n=== Weight loss concerns ===\n")
## 
## === Weight loss concerns ===
psych::alpha(cbind(dat3$afraid_3lbs, dat3$weight_importance,
                   dat3$ever_dieted, dat3$need.lose.weight,
                   dat3$scale_matters))[1]
## $total
##  raw_alpha std.alpha   G6(smc) average_r      S/N        ase     mean        sd
##  0.7540622 0.7833726 0.7620642 0.4196992 3.616221 0.01878833 2.884718 0.7933238
##   median_r
##  0.3934151
cat("\n=== Body surveillance ===\n")
## 
## === Body surveillance ===
psych::alpha(dat3[, bs_items])[1]
## $total
##  raw_alpha std.alpha  G6(smc) average_r      S/N        ase     mean      sd
##  0.8437645  0.842784 0.837652  0.433688 5.360677 0.01221992 4.079325 1.18841
##   median_r
##  0.4128959
cat("\n=== Body appreciation ===\n")
## 
## === Body appreciation ===
psych::alpha(dat3[, ba_items])[1]
## $total
##  raw_alpha std.alpha   G6(smc) average_r      S/N         ase     mean
##  0.9619208 0.9619966 0.9623365 0.7168219 25.31346 0.002852702 3.333065
##         sd  median_r
##  0.9373581 0.7279823
cat("\n=== Eating disorder risk ===\n")
## 
## === Eating disorder risk ===
psych::alpha(dat3[, ed_items])[1]
## $total
##  raw_alpha std.alpha  G6(smc) average_r      S/N        ase      mean        sd
##  0.7669352 0.7399519 0.743659 0.2890112 2.845443 0.01600541 0.2642601 0.2705937
##   median_r
##  0.2931444

Descriptive statistics & Figure 3

cat("Endorsement rates (somewhat/strongly agree):\n")
## Endorsement rates (somewhat/strongly agree):
cat("  Has GLP-1-like effects:", agree_pct(dat3$effect.like.glp1), "%\n")
##   Has GLP-1-like effects: 67 %
cat("  Similar to GLP-1:      ", agree_pct(dat3$similar.to.glp1),  "%\n")
##   Similar to GLP-1:       68.9 %
cat("  Works like GLP-1:      ", agree_pct(dat3$works.like.glp1),  "%\n")
##   Works like GLP-1:       60.1 %
p1 <- plot_likert_hist(dat3, "effect.like.glp1", "Has GLP-1-like effects")
p2 <- plot_likert_hist(dat3, "similar.to.glp1",  "Similar to GLP-1")
p3 <- plot_likert_hist(dat3, "works.like.glp1",  "Works like GLP-1", show_x = TRUE)

p1 / p2 / p3
Figure 3. Distributions of endorsement that the product has GLP-1-like effects (Study 3).

Figure 3. Distributions of endorsement that the product has GLP-1-like effects (Study 3).

Condition differences (ANOVAs)

m_belief3 <- aov(glp1_belief_mean ~ FL_16_DO, data = dat3)
cat("=== Beliefs by condition ===\n"); summary(m_belief3)
## === Beliefs by condition ===
##              Df Sum Sq Mean Sq F value  Pr(>F)   
## FL_16_DO      2   19.7   9.827   6.684 0.00141 **
## Residuals   370  544.0   1.470                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
cat("\nHolm-corrected pairwise contrasts:\n")
## 
## Holm-corrected pairwise contrasts:
emmeans(m_belief3, pairwise ~ FL_16_DO, adjust = "holm")
## $emmeans
##  FL_16_DO       emmean    SE  df lower.CL upper.CL
##  AmazonSmoothie   3.29 0.111 370     3.07     3.50
##  Smoothie         3.73 0.106 370     3.52     3.94
##  SmoothieKing     3.82 0.110 370     3.60     4.03
## 
## Confidence level used: 0.95 
## 
## $contrasts
##  contrast                      estimate    SE  df t.ratio p.value
##  AmazonSmoothie - Smoothie      -0.4453 0.153 370  -2.905  0.0078
##  AmazonSmoothie - SmoothieKing  -0.5312 0.156 370  -3.400  0.0022
##  Smoothie - SmoothieKing        -0.0859 0.152 370  -0.564  0.5731
## 
## P value adjustment: holm method for 3 tests
m_prefer3 <- aov(prefer ~ FL_16_DO, data = dat3)
cat("\n=== Evaluations by condition ===\n"); summary(m_prefer3)
## 
## === Evaluations by condition ===
##              Df Sum Sq Mean Sq F value Pr(>F)  
## FL_16_DO      2    9.2   4.618   2.486 0.0846 .
## Residuals   370  687.2   1.857                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
m_wtp3 <- aov(wtp ~ FL_16_DO, data = dat3)
cat("\n=== WTP by condition ===\n"); summary(m_wtp3)
## 
## === WTP by condition ===
##              Df Sum Sq Mean Sq F value Pr(>F)
## FL_16_DO      2    7.0   3.476   1.576  0.208
## Residuals   370  815.9   2.205

Demographic and psychological predictors of false beliefs (Table 5)

demog_vars3 <- c("bmi","income","ses","age","gender_simple","race_simple",
                 "glp1_exposure","FL_16_DO")
psych_vars3 <- c("ha_mean","wlc.average","body_surv_mean",
                 "body_appreciation_mean","ed_risk_total","politics")

fml <- function(dv, rhs) as.formula(paste(dv, "~", paste(rhs, collapse = " + ")))
make_df <- function(dv, rhs) {
  dat3 |> select(all_of(c(dv, rhs))) |> filter(complete.cases(pick(everything())))
}

df1 <- make_df("glp1_belief_mean", c(demog_vars3, psych_vars3))
message("Table 5 N: ", nrow(df1))

m1_s3 <- lm(fml("glp1_belief_mean", c(demog_vars3, psych_vars3)), data = na.omit(df1))
summary(m1_s3)
## 
## Call:
## lm(formula = fml("glp1_belief_mean", c(demog_vars3, psych_vars3)), 
##     data = na.omit(df1))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.1386 -0.6162  0.1807  0.8567  2.5177 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             2.341447   0.572346   4.091 5.35e-05 ***
## bmi                     0.008107   0.006049   1.340 0.181066    
## income                 -0.036951   0.045738  -0.808 0.419714    
## ses                    -0.042250   0.049081  -0.861 0.389929    
## age                    -0.002025   0.005202  -0.389 0.697363    
## gender_simpleMale      -0.193812   0.132526  -1.462 0.144527    
## race_simpleBlack        0.327344   0.204751   1.599 0.110792    
## race_simpleAsian        0.350127   0.270356   1.295 0.196164    
## race_simpleOther        0.430129   0.240495   1.789 0.074567 .  
## glp1_exposure          -0.611901   0.180255  -3.395 0.000767 ***
## FL_16_DOSmoothie        0.431067   0.151529   2.845 0.004709 ** 
## FL_16_DOSmoothieKing    0.465667   0.153938   3.025 0.002672 ** 
## ha_mean                -0.051689   0.122650  -0.421 0.673696    
## wlc.average             0.092939   0.108461   0.857 0.392101    
## body_surv_mean         -0.035231   0.064102  -0.550 0.582938    
## body_appreciation_mean  0.200286   0.082902   2.416 0.016211 *  
## ed_risk_total           0.041609   0.045327   0.918 0.359279    
## politics                0.123817   0.034594   3.579 0.000394 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.16 on 346 degrees of freedom
## Multiple R-squared:  0.1608, Adjusted R-squared:  0.1196 
## F-statistic:   3.9 on 17 and 346 DF,  p-value: 4.992e-07

Checking assumptions.

confint(m1_s3)
##                               2.5 %       97.5 %
## (Intercept)             1.215732376  3.467161693
## bmi                    -0.003790837  0.020005022
## income                 -0.126909779  0.053008340
## ses                    -0.138784751  0.054284348
## age                    -0.012255284  0.008206276
## gender_simpleMale      -0.454470581  0.066846145
## race_simpleBlack       -0.075370197  0.730057566
## race_simpleAsian       -0.181621682  0.881875949
## race_simpleOther       -0.042886251  0.903144576
## glp1_exposure          -0.966434461 -0.257367675
## FL_16_DOSmoothie        0.133032705  0.729102066
## FL_16_DOSmoothieKing    0.162894805  0.768438318
## ha_mean                -0.292922839  0.189543844
## wlc.average            -0.120386722  0.306263777
## body_surv_mean         -0.161309392  0.090846899
## body_appreciation_mean  0.037232008  0.363340872
## ed_risk_total          -0.047543116  0.130760420
## politics                0.055776535  0.191856682
car::vif(m1_s3)
##                            GVIF Df GVIF^(1/(2*Df))
## bmi                    1.349926  1        1.161863
## income                 1.832550  1        1.353717
## ses                    1.908543  1        1.381500
## age                    1.271698  1        1.127696
## gender_simple          1.156192  1        1.075264
## race_simple            1.298592  3        1.044509
## glp1_exposure          1.258718  1        1.121926
## FL_16_DO               1.072011  2        1.017536
## ha_mean                1.506400  1        1.227355
## wlc.average            1.997856  1        1.413455
## body_surv_mean         1.565953  1        1.251380
## body_appreciation_mean 1.649444  1        1.284307
## ed_risk_total          1.981998  1        1.407835
## politics               1.125713  1        1.060996
shapiro.test(residuals(m1_s3))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m1_s3)
## W = 0.96729, p-value = 2.77e-07
lmtest::bptest(m1_s3)
## 
##  studentized Breusch-Pagan test
## 
## data:  m1_s3
## BP = 30.698, df = 17, p-value = 0.02173
library(car)
set.seed(1234)
boot_s3_1 <- Boot(m1_s3, R = 5000)
summary(boot_s3_1)
## 
## Number of bootstrap replications R = 5000 
##                          original    bootBias    bootSE    bootMed
## (Intercept)             2.3414470  1.9087e-02 0.5554221  2.3568516
## bmi                     0.0081071 -3.0459e-04 0.0052868  0.0081260
## income                 -0.0369507 -3.5378e-03 0.0462214 -0.0410505
## ses                    -0.0422502  1.7144e-03 0.0470593 -0.0408618
## age                    -0.0020245 -8.4185e-05 0.0051718 -0.0021535
## gender_simpleMale      -0.1938122  1.9528e-03 0.1300895 -0.1911969
## race_simpleBlack        0.3273437  3.2005e-03 0.2045490  0.3349418
## race_simpleAsian        0.3501271 -6.4137e-03 0.2137357  0.3455192
## race_simpleOther        0.4301292 -4.5726e-04 0.2176669  0.4312117
## glp1_exposure          -0.6119011 -5.8033e-04 0.2091386 -0.6117558
## FL_16_DOSmoothie        0.4310674  4.0657e-03 0.1548422  0.4347974
## FL_16_DOSmoothieKing    0.4656666 -3.7934e-03 0.1543293  0.4622557
## ha_mean                -0.0516895 -3.0357e-04 0.1238376 -0.0523086
## wlc.average             0.0929385  4.0176e-03 0.1071363  0.0960189
## body_surv_mean         -0.0352312 -8.2454e-04 0.0633781 -0.0351894
## body_appreciation_mean  0.2002864 -2.8262e-03 0.0819833  0.1979080
## ed_risk_total           0.0416087 -1.2797e-03 0.0451820  0.0402266
## politics                0.1238166  3.9379e-04 0.0359006  0.1242323
confint(boot_s3_1, type = "perc")
## Bootstrap percent confidence intervals
## 
##                               2.5 %       97.5 %
## (Intercept)             1.277714249  3.464066383
## bmi                    -0.003667529  0.017369775
## income                 -0.131134608  0.051074265
## ses                    -0.133869633  0.050342595
## age                    -0.012215463  0.008151803
## gender_simpleMale      -0.446477710  0.057280957
## race_simpleBlack       -0.082010688  0.718507720
## race_simpleAsian       -0.091615437  0.752288030
## race_simpleOther        0.006920541  0.862456756
## glp1_exposure          -1.024027883 -0.200119146
## FL_16_DOSmoothie        0.121455567  0.740423956
## FL_16_DOSmoothieKing    0.157577876  0.768986032
## ha_mean                -0.294650836  0.189522197
## wlc.average            -0.118632680  0.302091158
## body_surv_mean         -0.160784779  0.089155340
## body_appreciation_mean  0.036001781  0.355036407
## ed_risk_total          -0.048700953  0.129116090
## politics                0.052741959  0.195488536
confint(boot_s3_1, type = "bca")
## Bootstrap bca confidence intervals
## 
##                               2.5 %       97.5 %
## (Intercept)             1.235920921  3.422673092
## bmi                    -0.003344135  0.017461871
## income                 -0.122306801  0.059598104
## ses                    -0.137912979  0.048249154
## age                    -0.011987910  0.008455824
## gender_simpleMale      -0.449745002  0.052698223
## race_simpleBlack       -0.111854706  0.694276340
## race_simpleAsian       -0.091262404  0.752300872
## race_simpleOther       -0.015485189  0.840235614
## glp1_exposure          -1.025185135 -0.206283009
## FL_16_DOSmoothie        0.114612012  0.736131936
## FL_16_DOSmoothieKing    0.163985857  0.775657524
## ha_mean                -0.290579654  0.192814617
## wlc.average            -0.127543093  0.294800514
## body_surv_mean         -0.160816747  0.089010060
## body_appreciation_mean  0.041683495  0.360059224
## ed_risk_total          -0.045638512  0.132574553
## politics                0.051587609  0.193307971

False beliefs and product evaluations (Tables 6 & 7)

# Table 6: product evaluations ~ beliefs + demographics + psych
df2 <- make_df("prefer", c("glp1_belief_mean", demog_vars3, psych_vars3))
message("Table 6 N: ", nrow(df2))

m2_s3 <- lm(fml("prefer", c("glp1_belief_mean", demog_vars3, psych_vars3)), data = na.omit(df2))
summary(m2_s3)
## 
## Call:
## lm(formula = fml("prefer", c("glp1_belief_mean", demog_vars3, 
##     psych_vars3)), data = na.omit(df2))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.4716 -0.8689 -0.1019  0.8756  3.8496 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            -1.122817   0.601357  -1.867  0.06273 .  
## glp1_belief_mean        0.295015   0.055167   5.348 1.62e-07 ***
## bmi                     0.008547   0.006224   1.373  0.17055    
## income                 -0.014465   0.046979  -0.308  0.75834    
## ses                    -0.033474   0.050419  -0.664  0.50719    
## age                     0.004316   0.005339   0.808  0.41946    
## gender_simpleMale      -0.081471   0.136413  -0.597  0.55074    
## race_simpleBlack        0.193602   0.210883   0.918  0.35923    
## race_simpleAsian        0.096632   0.278102   0.347  0.72845    
## race_simpleOther       -0.594601   0.247925  -2.398  0.01700 *  
## glp1_exposure           0.372204   0.188026   1.980  0.04855 *  
## FL_16_DOSmoothie        0.278354   0.157302   1.770  0.07769 .  
## FL_16_DOSmoothieKing    0.262888   0.160041   1.643  0.10137    
## ha_mean                -0.108318   0.125891  -0.860  0.39016    
## wlc.average             0.201815   0.111417   1.811  0.07096 .  
## body_surv_mean          0.192970   0.065808   2.932  0.00359 ** 
## body_appreciation_mean  0.078692   0.085785   0.917  0.35962    
## ed_risk_total           0.145039   0.046570   3.114  0.00200 ** 
## politics                0.053479   0.036150   1.479  0.13996    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.19 on 345 degrees of freedom
## Multiple R-squared:  0.2848, Adjusted R-squared:  0.2475 
## F-statistic: 7.634 on 18 and 345 DF,  p-value: < 2.2e-16

Checking assumptions.

confint(m2_s3)
##                               2.5 %      97.5 %
## (Intercept)            -2.305604959  0.05997164
## glp1_belief_mean        0.186509502  0.40352125
## bmi                    -0.003694096  0.02078792
## income                 -0.106865523  0.07793600
## ses                    -0.132641417  0.06569330
## age                    -0.006185311  0.01481643
## gender_simpleMale      -0.349777472  0.18683555
## race_simpleBlack       -0.221176427  0.60838055
## race_simpleAsian       -0.450356353  0.64362012
## race_simpleOther       -1.082236448 -0.10696609
## glp1_exposure           0.002381719  0.74202593
## FL_16_DOSmoothie       -0.031037689  0.58774576
## FL_16_DOSmoothieKing   -0.051890986  0.57766611
## ha_mean                -0.355929238  0.13929305
## wlc.average            -0.017326459  0.42095591
## body_surv_mean          0.063535764  0.32240517
## body_appreciation_mean -0.090035853  0.24741973
## ed_risk_total           0.053441894  0.23663519
## politics               -0.017623196  0.12458045
car::vif(m2_s3)
##                            GVIF Df GVIF^(1/(2*Df))
## glp1_belief_mean       1.191624  1        1.091615
## bmi                    1.356934  1        1.164875
## income                 1.836007  1        1.354993
## ses                    1.912630  1        1.382979
## age                    1.272254  1        1.127943
## gender_simple          1.163339  1        1.078582
## race_simple            1.321305  3        1.047532
## glp1_exposure          1.300640  1        1.140456
## FL_16_DO               1.107189  2        1.025783
## ha_mean                1.507173  1        1.227670
## wlc.average            2.002096  1        1.414954
## body_surv_mean         1.567320  1        1.251927
## body_appreciation_mean 1.677269  1        1.295094
## ed_risk_total          1.986825  1        1.409548
## politics               1.167392  1        1.080459
shapiro.test(residuals(m2_s3))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m2_s3)
## W = 0.98849, p-value = 0.005673
lmtest::bptest(m2_s3)
## 
##  studentized Breusch-Pagan test
## 
## data:  m2_s3
## BP = 29.594, df = 18, p-value = 0.04159
set.seed(1234)
boot_s3_2 <- Boot(m2_s3, R = 5000)
summary(boot_s3_2)
## 
## Number of bootstrap replications R = 5000 
##                          original    bootBias    bootSE    bootMed
## (Intercept)            -1.1228167  0.02949849 0.5337420 -1.0988217
## glp1_belief_mean        0.2950154 -0.00088268 0.0560592  0.2937773
## bmi                     0.0085469 -0.00016617 0.0060098  0.0086390
## income                 -0.0144648  0.00145906 0.0467046 -0.0130813
## ses                    -0.0334741 -0.00186361 0.0505118 -0.0355645
## age                     0.0043156 -0.00021107 0.0053913  0.0040947
## gender_simpleMale      -0.0814710 -0.00475773 0.1339327 -0.0849026
## race_simpleBlack        0.1936021  0.00454537 0.2302846  0.2006062
## race_simpleAsian        0.0966319 -0.00645099 0.2210492  0.0960515
## race_simpleOther       -0.5946013 -0.00062853 0.2224722 -0.5972623
## glp1_exposure           0.3722038 -0.00531372 0.1910209  0.3670449
## FL_16_DOSmoothie        0.2783540 -0.00150611 0.1540223  0.2763377
## FL_16_DOSmoothieKing    0.2628876 -0.00348735 0.1631608  0.2571540
## ha_mean                -0.1083181 -0.00496490 0.1319570 -0.1140558
## wlc.average             0.2018147  0.00383735 0.1089588  0.2050548
## body_surv_mean          0.1929705 -0.00071920 0.0636390  0.1929013
## body_appreciation_mean  0.0786919 -0.00155961 0.0816717  0.0782644
## ed_risk_total           0.1450385 -0.00097307 0.0471958  0.1443207
## politics                0.0534786 -0.00039889 0.0365831  0.0526430
confint(boot_s3_2, type = "perc")
## Bootstrap percent confidence intervals
## 
##                               2.5 %      97.5 %
## (Intercept)            -2.134975807 -0.02206071
## glp1_belief_mean        0.183243320  0.40282784
## bmi                    -0.004548670  0.01944154
## income                 -0.104400087  0.08010441
## ses                    -0.134741930  0.06442687
## age                    -0.006389876  0.01508765
## gender_simpleMale      -0.358605631  0.17529380
## race_simpleBlack       -0.258712858  0.65352946
## race_simpleAsian       -0.351275883  0.51719937
## race_simpleOther       -1.031150551 -0.15737241
## glp1_exposure          -0.002947027  0.73953425
## FL_16_DOSmoothie       -0.029167497  0.57642050
## FL_16_DOSmoothieKing   -0.061860544  0.58338831
## ha_mean                -0.366464018  0.14351954
## wlc.average            -0.009311236  0.41203672
## body_surv_mean          0.067385147  0.31672977
## body_appreciation_mean -0.080603708  0.23836852
## ed_risk_total           0.050597960  0.23732211
## politics               -0.017335475  0.12478054
confint(boot_s3_2, type = "bca")
## Bootstrap bca confidence intervals
## 
##                               2.5 %      97.5 %
## (Intercept)            -2.157338148 -0.06504740
## glp1_belief_mean        0.184337418  0.40486338
## bmi                    -0.004963183  0.01915281
## income                 -0.108248196  0.07616848
## ses                    -0.131161899  0.06777187
## age                    -0.005747043  0.01579030
## gender_simpleMale      -0.352234315  0.18311898
## race_simpleBlack       -0.271808853  0.63660341
## race_simpleAsian       -0.369385199  0.50247047
## race_simpleOther       -1.018517075 -0.13842251
## glp1_exposure           0.018424080  0.75828779
## FL_16_DOSmoothie       -0.028000314  0.57824863
## FL_16_DOSmoothieKing   -0.050087823  0.59339974
## ha_mean                -0.354155400  0.15281168
## wlc.average            -0.021780011  0.40328125
## body_surv_mean          0.066886841  0.31635022
## body_appreciation_mean -0.079181086  0.24083083
## ed_risk_total           0.051226158  0.23804821
## politics               -0.016218764  0.12704351
# Table 7: WTP ~ beliefs + demographics + psych
df3 <- make_df("wtp", c("glp1_belief_mean", demog_vars3, psych_vars3))
message("Table 7 N: ", nrow(df3))

m3_s3 <- lm(fml("wtp", c("glp1_belief_mean", demog_vars3, psych_vars3)), data = na.omit(df3))
summary(m3_s3)
## 
## Call:
## lm(formula = fml("wtp", c("glp1_belief_mean", demog_vars3, psych_vars3)), 
##     data = na.omit(df3))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.5565 -0.9540 -0.3298  0.6195  4.6715 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            -2.065819   0.704677  -2.932   0.0036 ** 
## glp1_belief_mean        0.347959   0.064645   5.383 1.36e-07 ***
## bmi                     0.008376   0.007293   1.148   0.2516    
## income                  0.016361   0.055050   0.297   0.7665    
## ses                     0.024145   0.059082   0.409   0.6830    
## age                     0.006419   0.006256   1.026   0.3056    
## gender_simpleMale       0.063314   0.159851   0.396   0.6923    
## race_simpleBlack        0.435027   0.247115   1.760   0.0792 .  
## race_simpleAsian       -0.252520   0.325883  -0.775   0.4389    
## race_simpleOther       -0.392473   0.290521  -1.351   0.1776    
## glp1_exposure          -0.012206   0.220331  -0.055   0.9559    
## FL_16_DOSmoothie        0.254049   0.184328   1.378   0.1690    
## FL_16_DOSmoothieKing    0.007347   0.187538   0.039   0.9688    
## ha_mean                -0.192958   0.147521  -1.308   0.1917    
## wlc.average             0.111755   0.130559   0.856   0.3926    
## body_surv_mean          0.092216   0.077114   1.196   0.2326    
## body_appreciation_mean  0.066048   0.100524   0.657   0.5116    
## ed_risk_total           0.133020   0.054571   2.438   0.0153 *  
## politics               -0.009400   0.042361  -0.222   0.8245    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.394 on 345 degrees of freedom
## Multiple R-squared:  0.1756, Adjusted R-squared:  0.1326 
## F-statistic: 4.084 on 18 and 345 DF,  p-value: 9.262e-08

Checking assumptions.

confint(m3_s3)
##                               2.5 %      97.5 %
## (Intercept)            -3.451823285 -0.67981539
## glp1_belief_mean        0.220810338  0.47510702
## bmi                    -0.005968557  0.02271973
## income                 -0.091915614  0.12463678
## ses                    -0.092060318  0.14035042
## age                    -0.005886408  0.01872365
## gender_simpleMale      -0.251090741  0.37771812
## race_simpleBlack       -0.051015108  0.92106860
## race_simpleAsian       -0.893487066  0.38844623
## race_simpleOther       -0.963888750  0.17894346
## glp1_exposure          -0.445567102  0.42115587
## FL_16_DOSmoothie       -0.108499661  0.61659738
## FL_16_DOSmoothieKing   -0.361513762  0.37620796
## ha_mean                -0.483111472  0.09719529
## wlc.average            -0.145036684  0.36854727
## body_surv_mean         -0.059456486  0.24388944
## body_appreciation_mean -0.131668676  0.26376538
## ed_risk_total           0.025685610  0.24035346
## politics               -0.092717673  0.07391808
car::vif(m3_s3)
##                            GVIF Df GVIF^(1/(2*Df))
## glp1_belief_mean       1.191624  1        1.091615
## bmi                    1.356934  1        1.164875
## income                 1.836007  1        1.354993
## ses                    1.912630  1        1.382979
## age                    1.272254  1        1.127943
## gender_simple          1.163339  1        1.078582
## race_simple            1.321305  3        1.047532
## glp1_exposure          1.300640  1        1.140456
## FL_16_DO               1.107189  2        1.025783
## ha_mean                1.507173  1        1.227670
## wlc.average            2.002096  1        1.414954
## body_surv_mean         1.567320  1        1.251927
## body_appreciation_mean 1.677269  1        1.295094
## ed_risk_total          1.986825  1        1.409548
## politics               1.167392  1        1.080459
shapiro.test(residuals(m3_s3))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(m3_s3)
## W = 0.92126, p-value = 6.807e-13
lmtest::bptest(m3_s3)
## 
##  studentized Breusch-Pagan test
## 
## data:  m3_s3
## BP = 48.459, df = 18, p-value = 0.0001286
set.seed(1234)
boot_s3_3 <- Boot(m3_s3, R = 5000)
summary(boot_s3_3)
## 
## Number of bootstrap replications R = 5000 
##                          original    bootBias    bootSE    bootMed
## (Intercept)            -2.0658193  3.6890e-02 0.6207945 -2.0259223
## glp1_belief_mean        0.3479587 -1.3037e-03 0.0622742  0.3454575
## bmi                     0.0083756 -4.3321e-04 0.0076126  0.0084113
## income                  0.0163606  1.0988e-03 0.0555717  0.0177127
## ses                     0.0241451 -1.5994e-03 0.0644276  0.0206698
## age                     0.0064186  2.3528e-04 0.0060499  0.0065653
## gender_simpleMale       0.0633137 -7.2849e-03 0.1561079  0.0589094
## race_simpleBlack        0.4350267  1.7450e-03 0.2890151  0.4362306
## race_simpleAsian       -0.2525204 -3.7853e-03 0.2762982 -0.2599898
## race_simpleOther       -0.3924726  4.7092e-03 0.2289134 -0.3842326
## glp1_exposure          -0.0122056 -9.4734e-03 0.2131354 -0.0231576
## FL_16_DOSmoothie        0.2540489 -3.8826e-05 0.1870513  0.2560695
## FL_16_DOSmoothieKing    0.0073471 -4.8630e-03 0.1899400  0.0012546
## ha_mean                -0.1929581 -9.3143e-03 0.1555681 -0.2001676
## wlc.average             0.1117553  2.5307e-03 0.1203372  0.1170755
## body_surv_mean          0.0922165 -3.1755e-04 0.0736596  0.0922186
## body_appreciation_mean  0.0660484 -5.0454e-03 0.1003918  0.0600859
## ed_risk_total           0.1330195 -1.2917e-05 0.0543125  0.1320444
## politics               -0.0093998 -7.2537e-04 0.0436081 -0.0099015
confint(boot_s3_3, type = "perc")
## Bootstrap percent confidence intervals
## 
##                               2.5 %      97.5 %
## (Intercept)            -3.219237586 -0.78621325
## glp1_belief_mean        0.225193500  0.47290787
## bmi                    -0.008426349  0.02162018
## income                 -0.090329963  0.12667490
## ses                    -0.103015400  0.15387423
## age                    -0.005144504  0.01854047
## gender_simpleMale      -0.254096688  0.35381744
## race_simpleBlack       -0.133129107  1.02648167
## race_simpleAsian       -0.782726461  0.29854172
## race_simpleOther       -0.839330509  0.06250978
## glp1_exposure          -0.433845221  0.40365113
## FL_16_DOSmoothie       -0.112767848  0.60915310
## FL_16_DOSmoothieKing   -0.374087336  0.37743017
## ha_mean                -0.503717062  0.09195760
## wlc.average            -0.121335723  0.34923288
## body_surv_mean         -0.054075022  0.23208255
## body_appreciation_mean -0.133635581  0.25825177
## ed_risk_total           0.026618984  0.24344926
## politics               -0.096021596  0.07532542
confint(boot_s3_3, type = "bca")
## Bootstrap bca confidence intervals
## 
##                               2.5 %      97.5 %
## (Intercept)            -3.305054937 -0.87232532
## glp1_belief_mean        0.230230294  0.47617865
## bmi                    -0.007641868  0.02220470
## income                 -0.094538477  0.12425110
## ses                    -0.095747706  0.16457325
## age                    -0.005432095  0.01827506
## gender_simpleMale      -0.241940849  0.36560745
## race_simpleBlack       -0.115109112  1.03602147
## race_simpleAsian       -0.736946792  0.34348511
## race_simpleOther       -0.847637509  0.05353829
## glp1_exposure          -0.408121009  0.42856372
## FL_16_DOSmoothie       -0.117120143  0.60523638
## FL_16_DOSmoothieKing   -0.362749592  0.39077149
## ha_mean                -0.485365446  0.11369918
## wlc.average            -0.139305141  0.33242094
## body_surv_mean         -0.056794718  0.23031622
## body_appreciation_mean -0.122270116  0.27215665
## ed_risk_total           0.028854011  0.24508320
## politics               -0.094140778  0.07624156

Prescription knowledge and false beliefs

cor.test(dat3$script.required, dat3$glp1_belief_mean)
## 
##  Pearson's product-moment correlation
## 
## data:  dat3$script.required and dat3$glp1_belief_mean
## t = -2.0668, df = 371, p-value = 0.03944
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.206003181 -0.005206382
## sample estimates:
##        cor 
## -0.1066925

Session Info

sessionInfo()
## R version 4.5.1 (2025-06-13)
## Platform: aarch64-apple-darwin20
## Running under: macOS Sequoia 15.7.4
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Chicago
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] car_3.1-3       carData_3.0-5   psych_2.5.6     emmeans_1.11.2 
## [5] patchwork_1.3.2 ggplot2_3.5.2   dplyr_1.1.4    
## 
## loaded via a namespace (and not attached):
##  [1] sandwich_3.1-1     sass_0.4.10        generics_0.1.4     lattice_0.22-7    
##  [5] digest_0.6.37      magrittr_2.0.3     evaluate_1.0.4     grid_4.5.1        
##  [9] estimability_1.5.1 RColorBrewer_1.1-3 mvtnorm_1.3-3      fastmap_1.2.0     
## [13] jsonlite_2.0.0     Matrix_1.7-3       Formula_1.2-5      survival_3.8-3    
## [17] multcomp_1.4-28    scales_1.4.0       TH.data_1.1-4      codetools_0.2-20  
## [21] jquerylib_0.1.4    abind_1.4-8        mnormt_2.1.1       cli_3.6.5         
## [25] rlang_1.1.6        splines_4.5.1      withr_3.0.2        cachem_1.1.0      
## [29] yaml_2.3.10        tools_4.5.1        parallel_4.5.1     coda_0.19-4.1     
## [33] boot_1.3-31        vctrs_0.6.5        R6_2.6.1           zoo_1.8-14        
## [37] lifecycle_1.0.4    MASS_7.3-65        pkgconfig_2.0.3    pillar_1.11.0     
## [41] bslib_0.9.0        gtable_0.3.6       glue_1.8.0         lmtest_0.9-40     
## [45] xfun_0.56          tibble_3.3.0       tidyselect_1.2.1   rstudioapi_0.17.1 
## [49] knitr_1.50         farver_2.1.2       xtable_1.8-4       htmltools_0.5.8.1 
## [53] nlme_3.1-168       rmarkdown_2.29     labeling_0.4.3     compiler_4.5.1