Sobre Implicit Association Tests (IAT) – Olhe o README do repositório.

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: 155
## Columns: 5
## $ session_id  <chr> "2436706", "2436967", "2440429", "2440430", "2440431", "24…
## $ referrer    <chr> "sdsu", "sdsu", "sdsu", "sdsu", "sdsu", "sdsu", "sdsu", "s…
## $ sex         <ord> f, f, f, f, m, f, f, m, f, m, f, f, f, f, f, f, m, m, f, m…
## $ d_art       <dbl> 0.90444320, -0.47402625, 0.46840862, -0.02522412, 0.136813…
## $ 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))
## # A tibble: 2 × 2
##   sex   media
##   <ord> <dbl>
## 1 m     0.224
## 2 f     0.467
agrupado = iat %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art), `desvio` = sd(d_art), N = n())
    m_media = agrupado %>% filter(sex == "m") %>% pull(media)
    m_desvio = agrupado %>% filter(sex == "m") %>% pull(desvio)
    m_n = agrupado %>% filter(sex == "m") %>% pull(N)
    f_media = agrupado %>% filter(sex == "f") %>% pull(media)
    f_desvio = agrupado %>% filter(sex == "f") %>% pull(desvio)
    f_n = agrupado %>% filter(sex == "f") %>% pull(N)
m_media - f_media
## [1] -0.2430539

Comparação via ICs

library(boot)

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

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.2430539
## $ bias      <dbl> 0.0005678551
## $ std.error <dbl> 0.09462034
## $ conf.low  <dbl> -0.4387452
## $ conf.high <dbl> -0.06196684
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)

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) com a matemática negativa e média (média = 0.4666898, desv. padrão = 0.5475448, N = 117). Homens tiveram uma associação negativa com a matemática, portanto menor que a das mulheres (média = 0.2236359, desv. padrão = 0.4850899, N = 38). Houve portanto uma considerável diferença entre homens e mulheres (diferença das médias = 0.2430539, 95% CI [-0.4387452, -0.0619668]). A partir desta amostra, estimamos que:

  • Apesar de as mulheres terem uma relação positiva mais forte com a arte do que os homens, ambos os sexos tendem a se darem melhor com arte do que com matemática.
  • Todo o estudo foi baseado em uma única amostra de um local específico, portanto, não podemos afirmar que esse cenário se repete em todos os lugares e culturas.

Vale elencar que uma maior quantidade de dados e de cenarios estudados pode representar informações mais significativas.

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)

Para iniciar, realizaremos a análise semelhante ao exemplo anterior, porém, utilizando uma base de dados diferente.

iat_2 = read_csv(here::here(params$arquivo_dados_2), col_types = "cccdc")
iat_2 = iat_2 %>% 
    mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
glimpse(iat_2)
## Rows: 113
## Columns: 5
## $ session_id  <chr> "2401243", "2401244", "2401246", "2401249", "2401250", "24…
## $ referrer    <chr> "brasilia", "brasilia", "brasilia", "brasilia", "brasilia"…
## $ sex         <ord> m, m, f, f, f, m, f, m, m, f, f, f, f, f, m, m, f, m, f, m…
## $ d_art       <dbl> 0.1480913, 0.6285349, 0.4977736, 0.3999447, 0.8314632, 1.1…
## $ iat_exclude <chr> "Include", "Include", "Include", "Include", "Include", "In…

Agora, procederemos dividindo os dados por sexo:

iat_2 %>% 
    group_by(sex) %>% 
    summarise(media = mean(d_art))
## # A tibble: 2 × 2
##   sex   media
##   <ord> <dbl>
## 1 m     0.400
## 2 f     0.570

Por fim, calcularemos as médias, desvios padrão e o intervalo de confiança:

agrupado_2 = iat_2 %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art), `desvio` = sd(d_art), N = n())
    m_media_2 = agrupado_2 %>% filter(sex == "m") %>% pull(media)
    m_desvio_2 = agrupado_2 %>% filter(sex == "m") %>% pull(desvio)
    m_n_2 = agrupado_2 %>% filter(sex == "m") %>% pull(N)
    f_media_2 = agrupado_2 %>% filter(sex == "f") %>% pull(media)
    f_desvio_2 = agrupado_2 %>% filter(sex == "f") %>% pull(desvio)
    f_n_2 = agrupado_2 %>% filter(sex == "f") %>% pull(N)
    m_media_2 - f_media_2
## [1] -0.1705546
theta_2 <- function(d, i) {
    agrupado_2 = d %>% 
        slice(i) %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art))
    m_media_2 = agrupado_2 %>% filter(sex == "m") %>% pull(media)
    f_media_2 = agrupado_2 %>% filter(sex == "f") %>% pull(media)
    m_media_2 - f_media_2
}

booted <- boot(data = iat_2, 
               statistic = theta_2, 
               R = 2000)

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

glimpse(ci_2)
## Rows: 1
## Columns: 5
## $ statistic <dbl> -0.1705546
## $ bias      <dbl> -0.003341587
## $ std.error <dbl> 0.09016555
## $ conf.low  <dbl> -0.3425688
## $ conf.high <dbl> 0.008748055

É possível observar que o comportamento para a nova base de dados estudada tem um comportamento similar ao exemplo anterior, as mulheres mulheres que participaram do experimento apresentam uma associação implícita (medida pelo IAT) com a matemática negativa e média (média = 0.5703113, desv. padrão = 0.4229594, N = 65). Os homens ainda tiveram uma associação maior com a matemática em relação às mulheres, mas, para essa base deu para notar um aumento na associação negativa com a matemática (média = 0.3997566, desv. padrão = 0.5162869, N = 48). Houve portanto uma considerável porém menor diferença entre homens e mulheres (diferença das médias = 0.1705546, 95% CI [-0.3425688, 0.0087481]).

2. bootstraps implementados por você (justifique o método de IC com bootstraps escolhido)

Agora vamos realizar o mesmo estudo, utilizando a mesma base de dados mencionada anteriormente. Desta vez, faremos a implementação do bootstrap de forma manual e utilizaremos o método do percentil, pois, além de ser mais simples de implementar, nos permitirá comparar os resultados obtidos entre os metódos.

agrupado_3 = iat_2 %>% 
        group_by(sex) %>% 
        summarise(media = mean(d_art), `desvio` = sd(d_art), N = n())
    m_media_3 = agrupado_3 %>% filter(sex == "m") %>% pull(media)
    m_desvio_3 = agrupado_3 %>% filter(sex == "m") %>% pull(desvio)
    m_n_3 = agrupado_3 %>% filter(sex == "m") %>% pull(N)
    f_media_3 = agrupado_3 %>% filter(sex == "f") %>% pull(media)
    f_desvio_3 = agrupado_3 %>% filter(sex == "f") %>% pull(desvio)
    f_n_3 = agrupado_3 %>% filter(sex == "f") %>% pull(N)
    m_media_3 - f_media_3
## [1] -0.1705546
theta_3 <- function(data) {
  agrupado_3 <- data %>%
    group_by(sex) %>%
    summarise(media = mean(d_art), .groups = 'drop')
  m_media_3 = agrupado_3 %>% filter(sex == "m") %>% pull(media)
  f_media_3 = agrupado_3 %>% filter(sex == "f") %>% pull(media)
  m_media_3 - f_media_3
}

theta_hat <- theta_3(iat_2)

R <- 2000
n <- nrow(iat_2)
bootstrap_samples <- replicate(R, {
  sample_indices <- sample(1:n, n, replace = TRUE)
  theta_3(iat_2[sample_indices, ])
})

ci_lower <- quantile(bootstrap_samples, 0.025)
ci_high <- quantile(bootstrap_samples, 0.975)

list(
  original = theta_hat,
  ci_lower = ci_lower,
  ci_high = ci_high
)
## $original
## [1] -0.1705546
## 
## $ci_lower
##       2.5% 
## -0.3481824 
## 
## $ci_high
##       97.5% 
## 0.006225515

Vamos comparar graficamente os dois resultados:

bootstrap_df_b <- data.frame(bootstrap_samples = booted$t)

# Histograma com curva de densidade e intervalos de confiança
plot_blibi <- ggplot(bootstrap_df_b, aes(x = bootstrap_samples)) +
  geom_histogram(binwidth = 0.01, fill = "blue", color = "black") +
  geom_vline(xintercept = ci_2$conf.low, linetype = "dashed", color = "red", linewidth = 0.5) +
  geom_vline(xintercept = ci_2$conf.high, linetype = "dashed", color = "red", linewidth = 0.5) +
  labs(title = "Histograma com IC BCa",
       x = "Diferença das Médias (Bootstrap)",
       y = "Densidade") +
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_x_continuous(breaks = seq(0, 0.5, by = 0.1),
                     labels = seq(0, 0.5, by = 0.1))


bootstrap_df_m <- data.frame(bootstrap_samples = bootstrap_samples)

plot_manual <- ggplot(bootstrap_df_m, aes(x = bootstrap_samples)) +
  geom_histogram(binwidth = 0.01, fill = "blue", color = "black") +
  geom_vline(xintercept = ci_lower, linetype = "dashed", color = "red", linewidth = 0.5) +
  geom_vline(xintercept = ci_high, linetype = "dashed", color = "red", linewidth = 0.5) +
  labs(title = "Histograma com IC Percentil",
       x = "Diferença das Médias (Bootstrap)",
       y = "Densidade") +
  theme(plot.title = element_text(hjust = 0.5)) +
  scale_x_continuous(breaks = seq(0, 0.5, by = 0.1),
                     labels = seq(0, 0.5, by = 0.1))

grid.arrange(plot_blibi, plot_manual, ncol = 2)

Como podemos observar, o gráfico representado pela abordagem BCa aparenta ter uma distribuição mais normalizada. Isso pode ser devido às características dos dados originais ou a algum viés que possa ser observado. No entanto, mesmo assim, a estratégia do percentil feita manualmente não foi ruim, exibindo até mesmo resultados similares:

BCa: Medias (0.5703113 e 0.3997566), CI ([-0.3425688, 0.0087481])
Percentil: Medias (0.5703113 e 0.3997566), CI ([-0.3481824, 0.0062255])