Exemplo de análise de uma replicação

iat = read_csv(here::here("data/brasilia .csv"), col_types = "cccdc")
iat = iat %>% 
    mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
glimpse(iat)

## 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…

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), desvio = sd(d_art), count = n())

## # A tibble: 2 × 4
##   sex   media desvio count
##   <ord> <dbl>  <dbl> <int>
## 1 m     0.400  0.516    48
## 2 f     0.570  0.423    65

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.1705546

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.1705546
## $ bias      <dbl> 0.00308453
## $ std.error <dbl> 0.09152877
## $ conf.low  <dbl> -0.3487487
## $ conf.high <dbl> 0.01506454

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árica negativa e média (média = 0.570, desv. padrão = 0.423 , N = 65). Homens tiveram uma associação negativa com a matemática, portanto menor que a das mulheres (média = 0.423, desv. padrão = 0.516, N = 48). Houve portanto uma pequena diferença entre homens e mulheres (diferença das médias -0.1705546, 95% CI [-0.3450994, 0.01255164]). A partir desta amostra, estimamos que:

As mulheres têm uma associação negativa ligeiramente mais forte em comparação aos homens, mas essa diferença é pequena e pode não ser estatisticamente significativa. Para determinar se essa diferença é relevante ou negligenciável, é necessário coletar mais dados.

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:

bootstraps a partir de uma bibliotece (exemplo acima)
bootstraps implementados por você (justifique o método de IC com bootstraps escolhido)

2 - Implementando Bootstraps manualmente

A baixo a implemntação manual do Bootstraps

set.seed(123)

bootstrap_diff <- function(data, n) {
  boot_sample <- replicate(n, {
    sample_data <- data[sample(1:nrow(data), replace = TRUE), ]
    m_mean <- mean(sample_data$d_art[sample_data$sex == "m"])
    f_mean <- mean(sample_data$d_art[sample_data$sex == "f"])
    m_mean - f_mean
  })
  return(boot_sample)
}

boot_diffs <- bootstrap_diff(iat, 2000)

ci_lower <- quantile(boot_diffs, 0.025)
ci_upper <- quantile(boot_diffs, 0.975)

mean_diff <- mean(boot_diffs)

results <- list(mean_diff = mean_diff, ci_lower = ci_lower, ci_upper = ci_upper)

print(results)

## $mean_diff
## [1] -0.1699463
## 
## $ci_lower
##      2.5% 
## -0.346301 
## 
## $ci_upper
##       97.5% 
## 0.004294935

Essa implementação manual acima, tem como vantagem um controle maior sobre o processo de bootstrap, permite personalizar caso necessário. Os resultados obtidos foram: Diferenças das médias = -0.1699463, IC: [-0.346301, 0.004294935]. Para justificar o uso da implementação manual, buscando simplicidade foi utilizado os percentis dos bootstraps, embora seja menos precisa em alguns contedxtos comparados ao BCA da implementação acima.

Histograma dos valores bootstrap

Gráfico de histograma que mostra a distribuição de médias obtidas a partir do bootstrap, com uma linha vertical tracejada indicando a diferença média.

bootstrap_results <- data.frame(boot_diffs)

histogram_plot <- ggplot(bootstrap_results, aes(x = boot_diffs)) +
  geom_histogram(binwidth = 0.01, fill = "blue", alpha = 0.7) +
  geom_vline(xintercept = mean_diff, color = "red", linetype = "dashed", linewidth = 1) +
  labs(title = "Histograma dos Valores Bootstrap",
       x = "Diferença das Médias",
       y = "Frequência") +
  theme_minimal()

print(histogram_plot)

Intervalo de Confiança

O gráfico abaixo mostra a diferença média entre os intervalos de confiança (IC) obtidos manualmente.

point_ci_plot <- ggplot() +
  geom_pointrange(aes(x = 1, y = mean_diff, ymin = ci_lower, ymax = ci_upper), size = 1.5) +
  geom_point(aes(x = 1, y = mean_diff), color = "red", size = 3) +
  scale_x_continuous(breaks = NULL) +
  labs(title = "Diferença das Médias com Intervalo de Confiança",
       x = "Bootstrap",
       y = "Diferença das Médias") +
  theme_minimal()

print(point_ci_plot)

Comparação das duas formas

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 <- boot.ci(booted, type = "bca")

boot_results <- data.frame(
  method = "Biblioteca boot",
  mean_diff = booted$t0,
  ci_lower = ci$bca[4],
  ci_upper = ci$bca[5]
)

manual_results <- data.frame(
  method = "Implementação Manual",
  mean_diff = results$mean_diff,
  ci_lower = results$ci_lower,
  ci_upper = results$ci_upper
)

combined_results <- rbind(boot_results, manual_results)

comparison_plot <- ggplot(combined_results, aes(x = method, y = mean_diff)) +
  geom_pointrange(aes(ymin = ci_lower, ymax = ci_upper), size = 1.5) +
  geom_point(color = "red", size = 3) +
  labs(title = "Comparação das Abordagens",
       x = "Método",
       y = "Diferença das Médias") +
  theme_minimal()

print(comparison_plot)

Resultados e Comparações

Com uso da biblioteca boot:

Diferenças das médias = -0.1705546, 95% CI [-0.3450994, 0.01255164]).

Sem uso da biblioteca boot (Implementação manual):

Diferenças das médias = -0.1699463, IC: [-0.346301, 0.004294935].

Conclusões

Ambas as abordagens mostram uma mínima diferença nas associações implícitas com a matemática entre homens e mulheres, os intervalos de confiança sugerem que a diferença pode não ser estatisticamente significativa.

FPCC2 - Láb 4 - Samuel Alves Medeiros

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