Sobre Implicit Association Tests (IAT)

IAT: 0.15, 0.35, and 0.65 are considered small, medium, and large levels of bias for individual scores. Positive means bias towards arts / against Math.

Exemplo de análise de uma replicação

iat = read_csv(here::here(params$arquivo_dados), col_types = "cccdc")
iat = iat %>% 
    mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
glimpse(iat)
## Rows: 894
## Columns: 5
## $ session_id  <chr> "2402411", "2402412", "2402416", "2402417", "2402421", "24…
## $ referrer    <chr> "mturk", "mturk", "mturk", "mturk", "mturk", "mturk", "mtu…
## $ sex         <ord> f, m, f, f, m, m, m, f, m, f, m, f, m, f, m, f, m, f, m, f…
## $ d_art       <dbl> 1.13204049, 1.00115521, 1.25238853, 0.27602068, 0.85487388…
## $ iat_exclude <chr> "Include", "Include", "Include", "Include", "Include", "In…
iat %>%
    ggplot(aes(x = d_art, fill = sex, color = sex)) +
    geom_histogram(binwidth = .2, alpha = .4) +
    geom_rug() +
    facet_grid(sex ~ ., scales = "free_y") + 
    theme(legend.position = "None")

iat %>% 
    ggplot(aes(x = sex, y = d_art)) + 
    geom_quasirandom(width = .1)

iat %>% 
    ggplot(aes(x = sex, y = d_art)) + 
    geom_quasirandom(width = .1) + 
    stat_summary(geom = "point", fun.y = "mean", color = "red", size = 5)
## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Qual a diferença na amostra
iat %>% 
    group_by(sex) %>% 
    summarise(
        media = mean(d_art),
        sd = sd(d_art),
        count = n()
    )
## # A tibble: 2 × 4
##   sex   media    sd count
##   <ord> <dbl> <dbl> <int>
## 1 m     0.332 0.468   410
## 2 f     0.585 0.453   484
agrupado = iat %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art))
    m = agrupado %>% filter(sex == "m") %>% pull(media)
    f = agrupado %>% filter(sex == "f") %>% pull(media)
m - f
## [1] -0.2531141

Comparação via ICs

library(boot)

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art))
    m = agrupado %>% filter(sex == "m") %>% pull(media)
    f = agrupado %>% filter(sex == "f") %>% pull(media)
    m - f
}

booted <- boot(data = iat, 
               statistic = theta, 
               R = 2000)

ci = tidy(booted, 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE)

glimpse(ci)
## Rows: 1
## Columns: 5
## $ statistic <dbl> -0.2531141
## $ bias      <dbl> -0.0002227591
## $ std.error <dbl> 0.03059292
## $ conf.low  <dbl> -0.3124273
## $ conf.high <dbl> -0.1932431
ci %>%
    ggplot(aes(
        x = "",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "Diferença", 
         y = "IAT homens - mulheres")

p1 = iat %>% 
    ggplot(aes(x = sex, y = d_art)) +
    geom_quasirandom(width = .1) + 
    stat_summary(geom = "point", fun.y = "mean", color = "red", size = 5)

p2 = ci %>%
    ggplot(aes(
        x = "",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    ylim(-1, 1) + 
    labs(x = "Diferença", 
         y = "IAT homens - mulheres")

grid.arrange(p1, p2, ncol = 2)

theta <- function(d, i) {
    agrupado <- d %>% 
        slice(i)
    
    mean(agrupado$d_art)
}

m_iat <- iat %>% filter(sex == "m")
m_booted <- boot(
    data = m_iat,
    statistic = theta, 
    R = 2000
)
m_ci = tidy(
    m_booted, 
    conf.level = .95,
    conf.method = "bca",
    conf.int = TRUE
)

f_iat <- iat %>% filter(sex == "f")
f_booted <- boot(
    data = f_iat,
    statistic = theta, 
    R = 2000
)
f_ci = tidy(
    f_booted, 
    conf.level = .95,
    conf.method = "bca",
    conf.int = TRUE
)

plot_data <- data.frame(
    sex = c("Homem", "Mulher"),
    iat_mean = c(mean(m_iat$d_art), mean(f_iat$d_art)),
    ci_l = c(min(m_ci$conf.low), min(f_ci$conf.low)),
    ci_h = c(min(m_ci$conf.high), min(f_ci$conf.high))
)

my_colors <- c(Homem = "darkgreen", Mulher = "red")

ggplot(plot_data, aes(x=sex, y=iat_mean, color=sex)) +
    geom_point(size = 4) + 
    geom_errorbar(aes(ymax=ci_h, ymin=ci_l), width=.2) +
    scale_color_manual(values = my_colors) +
    ggtitle("Intervalos de Confiança da média de IAT para Homens e Mulheres") +
    theme(
        axis.text.x = element_blank(),
        axis.title.x = element_blank()
    )

Conclusão

Preencha os resultados e conclusões abaixo

Em média, as mulheres que participaram do experimento tiveram uma associação implícita (medida pelo IAT) em direção as artes e contra a matemática positiva e média (média 0.5854692, desv. padrão 0.4534015, N = 484). Homens tiveram uma associação positiva em direção as artes e contra a matemática, menor que a das mulheres (média 0.3323551, desv. padrão 0.4682523, N = 410) Houve portanto uma pequena diferença entre homens e mulheres (diferença das médias -0.2531141, 95% CI [-0.3158817, -0.1946968]). A partir desta amostra, estimamos que:

  • mulheres têm uma associação positiva mais forte em direção as artes e contra a matemática, tanto por comparação de média como pelos intervalos de confiança não se sobrepor, porém não é claro se essa diferença é grande, moderada ou pequena. É necessário coletar mais dados para determinar se a diferença é relevante ou negligenciável. A diferença entre as médias não levaria, por exemplo, um viés médio para um grande (0.35+0.25 = 0.6 < 0.65)

Realize novas análises sobre IAT usando as abordagens a seguir

Realize a análise e compare as conclusões obtidas nos dois casos experimentados:

  1. bootstraps a partir de uma bibliotece (exemplo acima)
  2. bootstraps implementados por você (justifique o método de IC com bootstraps escolhido)
Bootstrap implementado
custom_bootstrap <- function(x) {
    boot <- sample(
        x, NROW(x), replace = TRUE
    )
    return(mean(boot))
}

alpha = 0.05
N = 10000

m_iat <- iat %>% filter(sex == "m") %>% pull(d_art)
f_iat <- iat %>% filter(sex == "f") %>% pull(d_art)

columns <- c("index", "boot_mean")

m_samples <- data.frame(matrix(nrow = 0, ncol = length(columns)))

for (i in 1:N) {
    row <- c(i, custom_bootstrap(m_iat))
    m_samples <- rbind(m_samples, row)
}

colnames(m_samples) = columns

custom_m_ci <- m_samples %>%
    mutate(diferenca = boot_mean - mean(m_iat)) %>%
    summarise(
        l = stats::quantile(diferenca, probs = alpha/2), 
        u = stats::quantile(diferenca, probs = 1 - alpha/2)
    ) %>% 
    mutate(
        ci_lower = mean(m_iat) - u, 
        ci_upper = mean(m_iat) - l
    )

f_samples <- data.frame(matrix(nrow = 0, ncol = length(columns))) 

for (i in 1:N) {
    row <- c(i, custom_bootstrap(f_iat))
    f_samples <- rbind(f_samples, row)
}

colnames(f_samples) = columns

custom_f_ci <- f_samples %>%
    mutate(diferenca = boot_mean - mean(f_iat)) %>%
    summarise(
        l = stats::quantile(diferenca, probs = alpha/2), 
        u = stats::quantile(diferenca, probs = 1 - alpha/2)
    ) %>% 
    mutate(
        ci_lower = mean(f_iat) - u, 
        ci_upper = mean(f_iat) - l
    )

custom_plot_data <- data.frame(
    sex = c("Homem", "Mulher"),
    iat_mean = c(mean(m_iat), mean(f_iat)),
    ci_l = c(min(custom_m_ci$ci_lower), min(custom_f_ci$ci_lower)),
    ci_h = c(min(custom_m_ci$ci_upper), min(custom_f_ci$ci_upper))
)

my_colors <- c(Homem = "darkgreen", Mulher = "red")

ggplot(custom_plot_data, aes(x=sex, y=iat_mean, color=sex)) +
    geom_point(size = 4) + 
    geom_errorbar(aes(ymax=ci_h, ymin=ci_l), width=.2) +
    scale_color_manual(values = my_colors) +
    ggtitle("Intervalos de Confiança da média de IAT para Homens e Mulheres") +
    theme(
        axis.text.x = element_blank(),
        axis.title.x = element_blank()
    )

plot_data$source <- "Lib"
custom_plot_data$source <- "Custom"
combined_data <- rbind(plot_data, custom_plot_data)

ggplot(combined_data, aes(x = sex, y = iat_mean, color = source)) +
  geom_point(stat = "identity", position = position_dodge(width = 0.9)) +
  geom_errorbar(aes(ymin = ci_l, ymax = ci_h), position = position_dodge(width = 0.9), width = 0.2) +
  labs(title = "Comparação Boostrap Lib e Custom",
       x = "Gênero",
       y = "IAT",
       fill = "Bootstrap") +
  theme_minimal()

É possível observar que os resultados do bootstrap implementado foram bastante semelhantes aos apresentados utilizando a biblioteca, com uma pequena diferença, mantendo as conclusões tomadas anteriormente.

Para ser efetivo, o bootstrap implementado realiza amostragens de tamanho igual ao tamanho da amostra original. Foi utilizado “replace = True” na função de bootstrap, onde cada elemento coletado para formar a amostra de tamanho igual ao original é colocado de volta para a próxima coleta, permitindo que alguns elementos sejam coletados mais de uma vez, tornando as amostras diferentes da amostra original. Este processo foi repetido 10000 vezes para termos estimativas acuradas. As margens de erro foram calculadas utilizando percentis.