Sobre IAT

IAT: 0.15, 0.35, and 0.65 are considered small, medium, and large level of bias for individual scores.

Positive means bias towards arts / against Math.

Análise de uma replicação

Usei os argumentos header = TRUE e stringsAsFactors = FALSE para indicar que o arquivo possui um cabeçalho e que as strings não devem ser convertidas em fatores automaticamente.

Em seguida, pensei na função transform para adicionar a nova coluna “sex” como um fator ordenado.

Por fim, como o professor utilizei a função glimpse para imprimir um resumo dos dados em IAT, mostrando as primeiras linhas e a estrutura das colunas.

csv_files <- list.files(here("data"), pattern = "*.csv")
encontrado <- FALSE
for (csv_file in csv_files) {
  iat <- read_csv(here("data", csv_file), col_types = "cccdc")
  
  if ("sex" %in% colnames(iat)) {
    iat <- iat %>% 
      mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
    encontrado <- TRUE
    break
  }
}
if (!encontrado) {
  stop("Nenhum arquivo válido encontrado no diretório.")
}
glimpse(iat)
## Rows: 77
## Columns: 5
## $ session_id  <chr> "2400853", "2400856", "2400860", "2400868", "2400872", "24…
## $ referrer    <chr> "abington", "abington", "abington", "abington", "abington"…
## $ sex         <ord> f, f, f, m, m, f, m, m, f, f, f, f, f, f, f, f, f, f, f, f…
## $ d_art       <dbl> 0.36016146, 0.58144485, 0.13148464, 0.74446333, 0.01153370…
## $ 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")

# Cria o boxplot
ggplot(iat, aes(x = sex, y = d_art)) +
  geom_boxplot() +
  xlab("Sexo") +
  ylab("d_art") +
  ggtitle("Boxplot de d_art por sexo")

iat %>%
  ggplot(aes(x = sex, y = d_art)) +
  geom_quasirandom(width = 0.25) +
  stat_summary(geom = "point", fun.y = "mean", color = "red", size = 5) +
  xlab("Sexo") +
  ylab("d_art") +
  ggtitle("Gráfico de dispersão quasirandom com média por sexo")
## 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(referrer, sex) %>%
  summarise(media = mean(d_art), n=n())
## `summarise()` has grouped output by 'referrer'. You can override using the
## `.groups` argument.
## # A tibble: 2 × 4
## # Groups:   referrer [1]
##   referrer sex    media     n
##   <chr>    <ord>  <dbl> <int>
## 1 abington m     0.0808    24
## 2 abington f     0.454     53
theta <- function(d, s) {
  m = mean(d[s == "m"])
  f = mean(d[s == "f"])
  m - f
}

diferencas <- iat %>% 
  group_by(referrer) %>% 
  summarise(diff = theta(d_art, sex))

glimpse(diferencas)
## Rows: 1
## Columns: 2
## $ referrer <chr> "abington"
## $ diff     <dbl> -0.3732753
diferencas %>%
  arrange(desc(diff)) %>%
  mutate(referrer = factor(referrer, levels = rev(referrer))) %>%
  ggplot(aes(x = referrer, y = diff)) +
  geom_point() +
  coord_flip()

Comparação via ICs

theta <- function(data, indices) {
  d <- data[indices, ]
  agrupado <- d %>%
    group_by(sex) %>%
    summarise(media = mean(d_art))
  m <- agrupado$media[agrupado$sex == "m"]
  f <- agrupado$media[agrupado$sex == "f"]
  m - f
}

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

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

glimpse(ci)
## Rows: 1
## Columns: 5
## $ statistic <dbl> -0.3732753
## $ bias      <dbl> -0.0006989944
## $ std.error <dbl> 0.1134842
## $ conf.low  <dbl> -0.6167879
## $ conf.high <dbl> -0.1456512
ci %>%
  ggplot(aes(
    x = 1,
    y = statistic,
    ymin = conf.low,
    ymax = conf.high
  )) +
  geom_pointrange() +
  geom_point(size = 3) +
  scale_x_continuous(breaks = 1, labels = "") +
  labs(
    x = "Diferença",
    y = "IAT homens - mulheres"
  )

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.45, desv. padrão = 0.19, N = 53). Homens tiveram uma associação negativa com a matemática, portanto menor que a das mulheres (média = 0.08, desv. padrão = 0.13, N = 24). Houve portanto uma pequena diferença entre homens e mulheres (diferença das médias -0.37, 95% CI [-0.58, -0.11]). A partir desta amostra, estimamos que as mulheres têm uma associação negativa consideravelmente mais forte, com uma diferença que provavelmente está entre 0.6 e 1.0 ponto na escala IAT, o suficiente para diferenciar uma associação neutra de uma muito forte contra a matemática.

…………………………………………………………………………………………………………………………………………..

homens <- iat %>%
  filter(sex == "m") %>%
  pull(d_art)

theta_homens <- function(d, i) {
  media_homens <- mean(d[i])
  media_homens
}

homens_booted <- boot(data = homens, statistic = theta_homens, R = 200)

homens_ci <- tidy(homens_booted, conf.level = 0.95, conf.method = "bca", conf.int = TRUE)

homens_ci <- homens_ci %>%
  mutate(sex = "m", desvio_padrao = (conf.high - conf.low) / 2)

glimpse(homens_ci)
## Rows: 1
## Columns: 7
## $ statistic     <dbl> 0.08081511
## $ bias          <dbl> 0.0004951695
## $ std.error     <dbl> 0.0886384
## $ conf.low      <dbl> -0.1100467
## $ conf.high     <dbl> 0.2415615
## $ sex           <chr> "m"
## $ desvio_padrao <dbl> 0.1758041
mulheres <- iat %>%
  filter(sex == "f") %>%
  pull(d_art)

theta_mulheres <- function(d, i) {
  media_mulheres <- mean(d[i])
  media_mulheres
}

mulheres_booted <- boot(data = mulheres, statistic = theta_mulheres, R = 200)

mulheres_ci <- tidy(mulheres_booted, conf.level = 0.95, conf.method = "bca", conf.int = TRUE)

mulheres_ci <- mulheres_ci %>%
  mutate(sex = "f", desvio_padrao = (conf.high - conf.low) / 2)

glimpse(mulheres_ci)
## Rows: 1
## Columns: 7
## $ statistic     <dbl> 0.4540904
## $ bias          <dbl> -0.003078721
## $ std.error     <dbl> 0.06222253
## $ conf.low      <dbl> 0.3353173
## $ conf.high     <dbl> 0.590181
## $ sex           <chr> "f"
## $ desvio_padrao <dbl> 0.1274318
……………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………
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 biblioteca (exemplo acima)
csv_files <- list.files(here("data"), pattern = "*.csv")
encontrados <- 0

for (csv_file in csv_files) {
  iats <- read_csv(here("data", csv_file), col_types = "cccdc")
  
  if ("sex" %in% colnames(iat)) {
    iats <- iats %>% 
      mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
    encontrados <- encontrados + 1
    
    if (encontrados == 2) {
      break
    }
  }
}

if (encontrados < 2) {
  stop("Menos de dois arquivos válidos encontrados no diretório.")
}

glimpse(iats)
## 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…

…………………………………………………………………………………………………………………………

Utilizamos um gráfico de barras com os desvios padrão, e adicionamos as barras de erro representando o intervalo de confiança de 95% utilizando o valor crítico 1.96 (correspondente ao quantil 97.5% da distribuição t-Student para um intervalo bilateral).

csv_files <- list.files(here("data"), pattern = "*.csv")
encontrados <- 0

for (csv_file in csv_files) {
  iats <- read_csv(here("data", csv_file), col_types = "cccdc")
  
  if ("sex" %in% colnames(iats)) {
    iats <- iats %>% 
      mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))
    encontrados <- encontrados + 1
    
    if (encontrados == 2) {
      break
    }
  }
}

if (encontrados < 2) {
  stop("Menos de dois arquivos válidos encontrados no diretório.")
}

desvio_padrao_homens <- iats %>%
  filter(sex == "m") %>%
  summarise(desvio_padrao = sd(d_art))

desvio_padrao_mulheres <- iats %>%
  filter(sex == "f") %>%
  summarise(desvio_padrao = sd(d_art))

resultados <- data.frame(
  sexo = c("Homens", "Mulheres"),
  desvio_padrao = c(desvio_padrao_homens$desvio_padrao, desvio_padrao_mulheres$desvio_padrao),
  n = c(nrow(iats %>% filter(sex == "m")), nrow(iats %>% filter(sex == "f")))
)

desvio_padrao_homens
## # A tibble: 1 × 1
##   desvio_padrao
##           <dbl>
## 1         0.516
desvio_padrao_mulheres
## # A tibble: 1 × 1
##   desvio_padrao
##           <dbl>
## 1         0.423
resultados <- data.frame(
  sexo = c("Homens", "Mulheres"),
  desvio_padrao = c(desvio_padrao_homens$desvio_padrao, desvio_padrao_mulheres$desvio_padrao),
  n = c(nrow(iats %>% filter(sex == "m")), nrow(iats %>% filter(sex == "f")))
)

ggplot(resultados, aes(x = sexo, y = desvio_padrao)) +
  geom_bar(stat = "identity", fill = "steelblue") +
  geom_errorbar(aes(ymin = desvio_padrao - qt(0.975, n - 1) * desvio_padrao / sqrt(n),
                    ymax = desvio_padrao + qt(0.975, n - 1) * desvio_padrao / sqrt(n)),
                width = 0.2, color = "black", size = 0.5) +
  labs(x = "Sexo", y = "Desvio Padrão", title = "Desvio Padrão por Sexo") +
  theme_minimal()
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Cálculo das barras de erro para o intervalo de confiança.

…………………………………………………………………………………………………………………………………………..

Cálculo da média da amostra usando a função theta para ambos os sexos.

calcular_media <- function(data) {
  media <- mean(data$d_art)
  return(media)
}

media_homens <- iats %>%
  filter(sex == "m") %>%
  calcular_media()

media_mulheres <- iats %>%
  filter(sex == "f") %>%
  calcular_media()

media_homens
## [1] 0.3997566
media_mulheres
## [1] 0.5703113
calcular_media <- function(data, indices) {
  subamostra <- data[indices, ]
  media <- mean(subamostra$d_art)
  return(media)
}

bootstrap_m <- boot(data = iats %>% filter(sex == "m"), statistic = calcular_media, R = 2000)

bootstrap_f <- boot(data = iats %>% filter(sex == "f"), statistic = calcular_media, R = 2000)

bootstrap_m
## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = iats %>% filter(sex == "m"), statistic = calcular_media, 
##     R = 2000)
## 
## 
## Bootstrap Statistics :
##      original       bias    std. error
## t1* 0.3997566 0.0008412924  0.07259022
bootstrap_f
## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = iats %>% filter(sex == "f"), statistic = calcular_media, 
##     R = 2000)
## 
## 
## Bootstrap Statistics :
##      original       bias    std. error
## t1* 0.5703113 -0.001359306  0.05069773
plot(bootstrap_m, type = "all", main = "Distribuição das Médias - Homens", xlab = "Média")
abline(v = mean(bootstrap_m$t), col = "red", lwd = 2, lty = 2)
abline(v = quantile(bootstrap_m$t, c(0.025, 0.975)), col = "blue", lwd = 2, lty = 2)

plot(bootstrap_f, type = "all", main = "Distribuição das Médias - Mulheres", xlab = "Média")
abline(v = mean(bootstrap_f$t), col = "red", lwd = 2, lty = 2)
abline(v = quantile(bootstrap_f$t, c(0.025, 0.975)), col = "blue", lwd = 2, lty = 2)

Definimos a opção type = “all” para exibir todas as sub-amostras no gráfico. Depois, utilizamos a função abline para adicionar linhas verticais representando a média e os limites do intervalo de confiança de 95% (quantis 2.5% e 97.5%) para cada grupo (homens e mulheres).

…………………………………………………………………………………………………………………………………………..

df_diferencas <- data.frame(Sexo = c(rep("Homens", length(bootstrap_m$t)), rep("Mulheres", length(bootstrap_f$t))),
                            Diferenca_Medias = c(bootstrap_m$t, bootstrap_f$t))

ggplot(df_diferencas, aes(x = Diferenca_Medias, fill = Sexo)) +
  geom_histogram(binwidth = 0.01, position = "identity", alpha = 0.5, color = "black") +
  labs(title = "Diferença das Médias das Sub-Amostras Bootstrap",
       x = "Diferença das Médias",
       y = "Frequência",
       fill = "Sexo") +
  theme_minimal() +
  scale_fill_manual(values = c("Homens" = "lightblue", "Mulheres" = "lightpink"))

……………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………

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

R: Preferi usar o bootstrap padrão que é amplamente utilizado por ser flexível e não faz muitas suposições sobre a distribuição dos dados. Ele também, permite obter estimativas robustas e intervalos de confiança para diversas estatísticas, mesmo quando a distribuição subjacente é desconhecida ou não segue uma distribuição paramétrica específica, preferi a opção mais segura para mim.

calcular_mediana <- function(data, indices) {
  subamostra <- data[indices, ]
  mediana <- median(subamostra$d_art)
  return(mediana)
}

bootstrap_m_mediana <- boot(data = iats %>% filter(sex == "m"), statistic = calcular_mediana, R = 2000)

bootstrap_f_mediana <- boot(data = iats %>% filter(sex == "f"), statistic = calcular_mediana, R = 2000)

bootstrap_m_mediana
## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = iats %>% filter(sex == "m"), statistic = calcular_mediana, 
##     R = 2000)
## 
## 
## Bootstrap Statistics :
##      original      bias    std. error
## t1* 0.4304925 -0.02662826  0.09403974
bootstrap_f_mediana
## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = iats %>% filter(sex == "f"), statistic = calcular_mediana, 
##     R = 2000)
## 
## 
## Bootstrap Statistics :
##      original    bias    std. error
## t1* 0.6048482 0.0189469  0.06080974
calcular_media <- function(data, indices) {
  subamostra <- data[indices, ]
  media <- mean(subamostra$d_art)
  return(media)
}

bootstrap_m <- boot(data = iats %>% filter(sex == "m"), statistic = calcular_media, R = 2000)

bootstrap_f <- boot(data = iats %>% filter(sex == "f"), statistic = calcular_media, R = 2000)

par(mfrow = c(1, 2))

hist(bootstrap_m$t, main = "Homens", xlab = "Média", col = "blue", border = "black")

hist(bootstrap_f$t, main = "Mulheres", xlab = "Média", col = "pink", border = "black")

par(mfrow = c(1, 2))

hist(bootstrap_m$t, main = "Homens", xlab = "Média", col = "blue", border = "black")
abline(v = mean(bootstrap_m$t), col = "red", lwd = 2)

hist(bootstrap_f$t, main = "Mulheres", xlab = "Média", col = "pink", border = "black")
abline(v = mean(bootstrap_f$t), col = "red", lwd = 2)

media_homens <- mean(bootstrap_m$t)
media_mulheres <- mean(bootstrap_f$t)

media_homens
## [1] 0.3997398
media_mulheres
## [1] 0.5701489
……………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………………

Então vimo a necessidade de calcular o IC de ambos os sexo do data.frame escolhido.

ic_homens <- boot.ci(bootstrap_m, type = "perc", conf = 0.95)

ic_mulheres <- boot.ci(bootstrap_f, type = "perc", conf = 0.95)

limite_inferior_homens <- ic_homens$percent[4]
limite_superior_homens <- ic_homens$percent[5]

cat("Intervalo de Confiança para Homens (95%):\n")
## Intervalo de Confiança para Homens (95%):
cat("Limite Inferior:", limite_inferior_homens, "\n")
## Limite Inferior: 0.2522629
cat("Limite Superior:", limite_superior_homens, "\n\n")
## Limite Superior: 0.5510986
limite_inferior_mulheres <- ic_mulheres$percent[4]
limite_superior_mulheres <- ic_mulheres$percent[5]

cat("Intervalo de Confiança para Mulheres (95%):\n")
## Intervalo de Confiança para Mulheres (95%):
cat("Limite Inferior:", limite_inferior_mulheres, "\n")
## Limite Inferior: 0.4654339
cat("Limite Superior:", limite_superior_mulheres, "\n")
## Limite Superior: 0.6698046
ic <- data.frame(
  sexo = c("Homens", "Mulheres"),
  media = c(media_homens, media_mulheres),
  conf.low = c(limite_inferior_homens, limite_inferior_mulheres),
  conf.high = c(limite_superior_homens, limite_superior_mulheres)
)

# Plotar os intervalos de confiança
ggplot(ic, aes(x = sexo, y = media, ymin = conf.low, ymax = conf.high, fill = sexo)) +
  geom_errorbar(width = 0.2, position = position_dodge(width = 0.5)) +
  geom_point(position = position_dodge(width = 0.5), shape = 21, size = 3) +
  labs(title = "Intervalo de Confiança (95%)",
       x = "Sexo",
       y = "Média") +
  scale_fill_manual(values = c("#1F77B4", "#FF7F0E")) +
  theme_minimal()

diferenca_medias <- bootstrap_m$t - bootstrap_f$t

df_diferenca_medias <- data.frame(diferenca_medias)

ggplot(df_diferenca_medias, aes(x = 1, y = diferenca_medias)) +
  geom_point(shape = 21, size = 3, fill = "blue") +
  geom_errorbar(aes(ymin = quantile(diferenca_medias, 0.025),
                    ymax = quantile(diferenca_medias, 0.975)), width = 0.2) +
  labs(title = "Diferença das Médias",
       x = "",
       y = "Diferença das Médias") +
  theme_minimal()