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.

Lendo e Analisando os Dados

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: 1,236
## Columns: 5
## $ session_id  <chr> "2374915", "2374924", "2374971", "2375038", "2375052", "23…
## $ referrer    <chr> "pi", "pi", "pi", "pi", "pi", "pi", "pi", "pi", "pi", "pi"…
## $ sex         <ord> m, f, m, f, f, f, f, f, f, f, f, f, m, m, f, f, f, f, m, f…
## $ d_art       <dbl> 0.4109073, 1.1507938, 0.1046623, -0.4928488, 1.2583609, 0.…
## $ 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 per session.
## 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.322
## 2 f     0.613

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

Comparação via Intervalos de Confiança

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.2911497
## $ bias      <dbl> -0.000285124
## $ std.error <dbl> 0.02894759
## $ conf.low  <dbl> -0.3442984
## $ conf.high <dbl> -0.231277

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 da Análise dos Intervalos de Confiança

Considerando os dados de Project Implicit, em média, as mulheres que participaram do experimento tiveram uma associação implícita (medida pelo IAT) com a matemática negativa e quase forte (média 0.61, desv. padrão 0.44, N = 809). Homens tiveram uma associação negativa com a matemática, entranto menor do que a das mulheres (média 0.32 , desv. padrão 0.5, N = 427). Houve portanto uma considerável diferença entre homens e mulheres (diferença das médias -0.29, 95% CI [-0.3477488, -0.2377753]). A partir desta amostra, estimamos que a diferença real na associação implícita com a matemática entre homens e mulheres na população geral dificilmente será desconsiderável, sugerindo que as mulheres apresentam um maior viés negativo em relação à matemática do que os homens.

Embora as visualizações revelem que existe uma grande sobreposição nas pontuações entre os grupos, o intervalo de confiança calculado para a diferença das médias tem uma faixa muito estreita e afastada negativamente do valor zero. Esse distanciamento confirma que o maior viés implícito observado no grupo feminino é uma diferença real na população e não uma mera coincidência, consolidando a matemática como um campo de associação negativa para as mulheres.

Implementando e Comparando BootStraps

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

bootstraps a partir de uma biblioteca (exemplo acima)
bootstraps implementados por você utilizando pelo menos dois outros métodos de IC com bootstrap
justifique e escolha dos métodos e discuta / explique caso exista impacto nos resultados

Usando biblioteca (boot):

# importando a biblioteca boot
library(boot)

set.seed(41)

mean_function <- function(data, indices) {
  d <- data[indices, ] # Cria uma nova amostra
  return(mean(d$d_art))  # Calcula a média
}

Primeira Implementação:

boot_pivotal <- function(data, column, Num_Resamplings = 2000, conf_level = 0.95) {
  set.seed(41)
  n <- nrow(data)
  boot_means <- numeric(Num_Resamplings)
  
  for(i in 1:Num_Resamplings) {
    indices <- sample(1:n, size = n, replace = TRUE)
    boot_means[i] <- mean(data[indices, column, drop=TRUE], na.rm = TRUE)
  }
  
  Media <- mean(data[[column]], na.rm = TRUE)
  
  diferenca <- boot_means - Media
  alpha <- 1 - conf_level
  
  l <- quantile(diferenca, probs = alpha/2, na.rm = TRUE)
  u <- quantile(diferenca, probs = 1 - alpha/2, na.rm = TRUE)
  
  ci_lower <- Media - u
  ci_upper <- Media - l
  
  return(c(lower = as.numeric(ci_lower), upper = as.numeric(ci_upper)))
}

Segunda implementação:

boot_percentil <- function(data, column, Num_Resamplings = 2000, conf_level = 0.95) {
  set.seed(41)
  n <- nrow(data)
  boot_means <- numeric(Num_Resamplings)
  
  # Amostragem com reposição (Bootstrap)
  for(i in 1:Num_Resamplings) {
    indices <- sample(1:n, size = n, replace = TRUE)
    boot_means[i] <- mean(data[indices, column, drop=TRUE], na.rm = TRUE)
  }
  
  # Nível de significância
  alpha <- 1 - conf_level
  
  # Seleção direta dos quantis da distribuição bootstrap
  ic <- quantile(boot_means, probs = c(alpha/2, 1 - alpha/2), na.rm = TRUE)
  
  return(c(lower = as.numeric(ic[1]), upper = as.numeric(ic[2])))
}

Comparação entre as 3 implementações (biblioteca x primeira e segunda implementações)

Podemos observar que não há nem um centésimo de diferença.

iat_limpo <- iat[!is.na(iat$d_art) & !is.na(iat$sex), ]

# --- 0. PREPARAÇÃO DOS DADOS (FILTRADOS POR GÊNERO) ---
iat_m <- iat_limpo[iat_limpo$sex == "m", ]
iat_f <- iat_limpo[iat_limpo$sex == "f", ]

media_m <- mean(iat_m$d_art)
media_f <- mean(iat_f$d_art)

# --- 1. EXECUÇÃO PARA HOMENS (M) ---
set.seed(41)
boot_m <- boot(iat_m, mean_function, R = 5000)
ic_lib_m <- boot.ci(boot_m, type = "norm")$norm
ic_lib_m <- c(lower = ic_lib_m[2], upper = ic_lib_m[3])

ic_piv_m <- boot_pivotal(iat_m, "d_art", Num_Resamplings = 5000)
ic_per_m <- boot_percentil(iat_m, "d_art", Num_Resamplings = 5000)

res_m <- data.frame(
  Metodo = c("1. Biblioteca boot", "2. boot_pivotal", "3. boot_percentil"),
  Lower  = c(ic_lib_m["lower"], ic_piv_m["lower"], ic_per_m["lower"]),
  Upper  = c(ic_lib_m["upper"], ic_piv_m["upper"], ic_per_m["upper"]),
  Y      = c(3, 2, 1)
)

# --- 2. EXECUÇÃO PARA MULHERES (F) ---
set.seed(41)
boot_f <- boot(iat_f, mean_function, R = 5000)
ic_lib_f <- boot.ci(boot_f, type = "norm")$norm
ic_lib_f <- c(lower = ic_lib_f[2], upper = ic_lib_f[3])

ic_piv_f <- boot_pivotal(iat_f, "d_art", Num_Resamplings = 5000)
ic_per_f <- boot_percentil(iat_f, "d_art", Num_Resamplings = 5000)

res_f <- data.frame(
  Metodo = c("1. Biblioteca boot", "2. boot_pivotal", "3. boot_percentil"),
  Lower  = c(ic_lib_f["lower"], ic_piv_f["lower"], ic_per_f["lower"]),
  Upper  = c(ic_lib_f["upper"], ic_piv_f["upper"], ic_per_f["upper"]),
  Y      = c(3, 2, 1)
)

# --- 3. GERAÇÃO DOS DOIS GRÁFICOS LADO A LADO ---

# mfrow = c(1, 2) divide a tela em 1 linha e 2 colunas
# mar ajusta as margens para caber os nomes dos métodos à esquerda
par(mfrow = c(1, 2), mar = c(5, 8, 4, 1))

# GRÁFICO 1: HOMENS
limite_xm <- range(c(res_m$Lower, res_m$Upper, media_m)) + c(-0.05, 0.05)
plot(1, type = "n", xlim = limite_xm, ylim = c(0.5, 3.5), yaxt = "n", 
     xlab = "Valor do IAT", ylab = "", main = "Homens (m)")
axis(2, at = res_m$Y, labels = res_m$Metodo, las = 1)
abline(v = media_m, col = "red", lty = 2, lwd = 1.5)
arrows(x0 = res_m$Lower, y0 = res_m$Y, x1 = res_m$Upper, y1 = res_m$Y, 
       code = 3, angle = 90, length = 0.08, lwd = 2, col = c("blue", "darkgreen", "orange"))
points((res_m$Lower + res_m$Upper) / 2, res_m$Y, pch = 19, col = c("blue", "darkgreen", "orange"), cex = 1.2)

# GRÁFICO 2: MULHERES (Ajustando margem esquerda para não repetir rótulos redundantes se preferir, ou mantendo igual)
limite_xf <- range(c(res_f$Lower, res_f$Upper, media_f)) + c(-0.05, 0.05)
plot(1, type = "n", xlim = limite_xf, ylim = c(0.5, 3.5), yaxt = "n", 
     xlab = "Valor do IAT", ylab = "", main = "Mulheres (f)")
axis(2, at = res_f$Y, labels = res_f$Metodo, las = 1)
abline(v = media_f, col = "red", lty = 2, lwd = 1.5)
arrows(x0 = res_f$Lower, y0 = res_f$Y, x1 = res_f$Upper, y1 = res_f$Y, 
       code = 3, angle = 90, length = 0.08, lwd = 2, col = c("blue", "darkgreen", "orange"))
points((res_f$Lower + res_f$Upper) / 2, res_f$Y, pch = 19, col = c("blue", "darkgreen", "orange"), cex = 1.2)

# Restaura o padrão de tela única e margens após plotar
par(mfrow = c(1, 1), mar = c(5, 4, 4, 2))

Visualmente, todos os 3 intervalos de confiança são praticamente idênticos. A representação numérica deles pode confirmar mais essa igualdade.

Representando em tabela (para comparar valores absolutos)

library(knitr)

# --- PREPARAÇÃO DOS DADOS (HOMENS) ---
valores_brutos_m <- res_m %>% 
  mutate(
    Diferenca_Lower = abs(Lower - ic_lib_m["lower"]),
    Diferenca_Upper = abs(Upper - ic_lib_m["upper"])
  ) %>%
  select(Metodo, Lower, Upper, Diferenca_Lower, Diferenca_Upper)

# --- PREPARAÇÃO DOS DADOS (MULHERES) ---
valores_brutos_f <- res_f %>% 
  mutate(
    Diferenca_Lower = abs(Lower - ic_lib_f["lower"]),
    Diferenca_Upper = abs(Upper - ic_lib_f["upper"])
  ) %>%
  select(Metodo, Lower, Upper, Diferenca_Lower, Diferenca_Upper)

# --- RENDERIZAÇÃO EM HTML LIMPO ---
kable(valores_brutos_m, 
      caption = "Valores Brutos e Erro Absoluto: Homens (m)", 
      digits = 10, 
      col.names = c("Método", "Limite Inferior", "Limite Superior", "Dif. Inferior", "Dif. Superior"))

Valores Brutos e Erro Absoluto: Homens (m)
Método	Limite Inferior	Limite Superior	Dif. Inferior	Dif. Superior
1. Biblioteca boot	0.2752504	0.3693716	0.0000000000	0.0000000000
2. boot_pivotal	0.2752478	0.3703168	0.0000026432	0.0009451921
3. boot_percentil	0.2739702	0.3690392	0.0012801805	0.0003323452

kable(valores_brutos_f, 
      caption = "Valores Brutos e Erro Absoluto: Mulheres (f)", 
      digits = 10, 
      col.names = c("Método", "Limite Inferior", "Limite Superior", "Dif. Inferior", "Dif. Superior"))

Valores Brutos e Erro Absoluto: Mulheres (f)
Método	Limite Inferior	Limite Superior	Dif. Inferior	Dif. Superior
1. Biblioteca boot	0.5834450	0.6434598	0.0000000000	0.0000000000
2. boot_pivotal	0.5824860	0.6442721	0.0009589439	0.0008122608
3. boot_percentil	0.5823144	0.6441004	0.0011306153	0.0006405894

Intervalos de Confiança praticamente iguais: variam menos de 1 centésimo da função da biblioteca.

Prova Visual de Simetria e Normalidade (Diagnóstico do Bootstrap)

Para confirmar a premissa de que a distribuição bootstrap das médias é altamente simétrica e normal (justificando a convergência dos métodos), analisei as distribuições das reamostragens para ambos os grupos:

# Criamos uma matriz de layout 2x2:
# Linha 1: Histograma (m) | Q-Q Plot (m)  -> Homens
# Linha 2: Histograma (f) | Q-Q Plot (f)  -> Mulheres
par(mfrow = c(2, 2), mar = c(4, 4, 3, 2))

# --- DIAGNÓSTICO: HOMENS ---
# 1. Histograma
hist(boot_m$t, breaks = 40, prob = TRUE, col = "lightgray",
     main = "Histograma das Médias (Homens)", xlab = "Valores de t*", ylab = "Densidade")
lines(density(boot_m$t), col = "blue", lwd = 2) # Curva de densidade empírica
abline(v = boot_m$t0, col = "red", lty = 2, lwd = 1.5) # Média original

# 2. Q-Q Plot
qqnorm(boot_m$t, main = "Q-Q Plot (Homens)", xlab = "Quantis Teóricos", ylab = "Quantis Amostrais")
qqline(boot_m$t, col = "red", lty = 2)


# --- DIAGNÓSTICO: MULHERES ---
# 3. Histograma
hist(boot_f$t, breaks = 40, prob = TRUE, col = "lightgray",
     main = "Histograma das Médias (Mulheres)", xlab = "Valores de t*", ylab = "Densidade")
lines(density(boot_f$t), col = "blue", lwd = 2)
abline(v = boot_f$t0, col = "red", lty = 2, lwd = 1.5)

# 4. Q-Q Plot
qqnorm(boot_f$t, main = "Q-Q Plot (Mulheres)", xlab = "Quantis Teóricos", ylab = "Quantis Amostrais")
qqline(boot_f$t, col = "red", lty = 2)

# Restaura o padrão do sistema gráfico
par(mfrow = c(1, 1))

Os gráficos mostram que a distribuição bootstrap das médias é simétrica (histogramas em formato de “sino”) e normal (pontos do Q-Q Plot perfeitamente alinhados sobre a diagonal). É justamente essa normalidade e simetria que faz com que as abordagens Normal (biblioteca), Percentil e Pivotal convirjam para os mesmos intervalos de confiança.

Conclusão das Comparações dos Diferentes Bootstraps

Os resultados obtidos nas três implementações (Biblioteca boot, boot_pivotal e boot_percentil) são praticamente idênticos, tanto para o grupo masculino quanto para o feminino. Os pontos centrais e os limites dos intervalos de confiança não apresentam nem 1 centésimo de diferenças.

Justificativa dos Métodos Escolhidos e Impacto nos Resultados

Método Percentil: Escolhido por ser uma abordagem direta e por não depender de métricas já conhecidas da população.
Método Pivotal: Escolhido por sua capacidade de corrigir possíveis assimetrias e vieses presentes no cálculo do próprio intervalo de confiança.

Por que não houve impacto nos resultados (convergência)? Essa quase igualdade entre os três métodos ocorre porque a distribuição bootstrap das médias amostrais de \(d\_art\) para ambos os sexos é altamente simétrica e aproxima-se perfeitamente de uma distribuição Normal. Esse comportamento ocorre pelo Teorema Central do Limite (TCL), dado que trabalhamos com amostras grandes (\(N=809\) para mulheres e \(N=427\) para homens - o motivo de “pi.csv” ser o conjunto escolhido para essa análise). Sob condições de simetria e grandes amostras, as estimativas Normal, Percentil e Pivotal convergem para os mesmos limites.

Análise de uma replicação: Implicit Association Tests (IAT)

Miguel de Oliveira Rodrigues

2026-07-15