Análise de uma replicação

A análise que será realizada neste laboratório se propõe a verificar um teste de associação implícita (IAT, em inglês) que mede a associação de dois conceitos com um atributo. Os dois conceitos aparecem em uma tarefa de duas escolhas que no caso da pesquisa é o nível de aversão à Matemática em comparação com arte.

A base de dados possui um índice chamado d_art, que mede a preferência por arte em comparação com matemática. O valor +1 é a maior aversão a Matemática em comparação com Arte, enquanto -1 é a maior preferência por Matemática em comparação com Arte. O zero significa indiferença.

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: 179
## Columns: 5
## $ session_id  <chr> "2421401", "2421408", "2421415", "2421419", "2421535", "24…
## $ referrer    <chr> "tamu", "tamu", "tamu", "tamu", "tamu", "tamu", "tamu", "t…
## $ sex         <ord> f, m, f, f, f, f, f, f, f, f, m, f, f, m, m, f, m, m, f, f…
## $ d_art       <dbl> 0.66404173, 0.28330852, 0.91158827, 0.40696666, 0.14532187…
## $ 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")

Também foram calculadas as medidas de desvio padrão para cada um dos sexos e foi verificado os valores abaixo.

iat %>% 
    group_by(sex)%>%
    summarise(sd(d_art))

## # A tibble: 2 × 2
##   sex   `sd(d_art)`
##   <ord>       <dbl>
## 1 m           0.452
## 2 f           0.465

Esses valores encontrados mostram que o sexo feminino tem valores mais irregulares e fora de padrão do que masculino, que está mais perto de 0.

O gráfico analisado abaixo é o de pontos, nele é possível, visualmente, extrair que no caso de “m” masculino, há uma variação maior, inclusive com um ponto extremo. Esses pontos mais próximos dos 1 indicam uma preferência maior por Artes do que para Matemática. Ainda é possível encontrar novos pontos extremos maiores que -0,5 indicando uma preferência maior para Matemática. Já no caso do “f” feminino, é possível visualmente observar uma concentração maior, inclusive com poucos pontos abaixo do 0, e com maioria dos pontos acima de 0.

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

Esta análise não se resumiu a apenas análises visuais, as constatações podem ser verificadas através de análises dos sumários.

iat %>%
    group_by(sex)%>%
    summarise(range(d_art))

## `summarise()` has grouped output by 'sex'. You can override using the `.groups`
## argument.

## # A tibble: 4 × 2
## # Groups:   sex [2]
##   sex   `range(d_art)`
##   <ord>          <dbl>
## 1 m             -0.992
## 2 m              1.10 
## 3 f             -0.662
## 4 f              1.38

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

## Warning: `fun.y` is deprecated. Use `fun` instead.

Qual a diferença na amostra

iat %>% 
    group_by(sex) %>% 
    summarise(media = mean(d_art), desvio = sd(d_art), n = n())

## # A tibble: 2 × 4
##   sex   media desvio     n
##   <ord> <dbl>  <dbl> <int>
## 1 m     0.236  0.452    58
## 2 f     0.420  0.465   121

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

Comparação via ICs

1.1 Utilizando a Biblioteca Boot

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.1841804
## $ bias      <dbl> 0.002134648
## $ std.error <dbl> 0.07332712
## $ conf.low  <dbl> -0.3357266
## $ conf.high <dbl> -0.04665965

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)

## Warning: `fun.y` is deprecated. Use `fun` instead.

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

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.4202452, desv. padrão 0.4646915, N = 121). Homens tiveram uma associação negativa e fraca com a matemática, portanto menor que a das mulheres (média 0.2360648, desv. padrão 0.4515570 , N = 58). Houve portanto uma considerável diferença entre homens e mulheres (diferença das médias -0,1841804, 95% CI [-0.3333651, -0.04199513]). A partir desta amostra, estimamos que mulheres têm uma associação negativa mais forte, 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, em especial devido a grande diferença na variável N de homens e mulheres.

1.2 Implementação Manual

Primeiro vamos encontrar a proporção.

iat = read_csv(here::here(params$arquivo_dados), col_types = "cccdc")
iat = iat %>% 
    mutate(sex = factor(sex, levels = c("m", "f"), ordered = TRUE))

funcao_theta = function(df) {
    df %>%
        pull(d_art) %>%
        mean()
}

theta_c = funcao_theta(iat)

theta_c

## [1] 0.3605667

Agora vamos realizar um número elevado de amostragens de maneira a visualizar a variação nos valores de maneira mais evidente, gerando assim uma distribuição amostral da métrica calculada, no caso a média.

repeats = 2000


bootstrap = function(x) {
  reamostra = x %>% pull(d_art)
  boot_x = sample(reamostra,
                  size = NROW(x),
                  replace = TRUE)
  
  return(mean(boot_x))
}

set.seed(1)

reamostras = tibble(i = 1:repeats) %>%
  mutate(theta_cs = map_dbl(i, ~ bootstrap(iat)))

reamostras

## # A tibble: 2,000 × 2
##        i theta_cs
##    <int>    <dbl>
##  1     1    0.346
##  2     2    0.317
##  3     3    0.322
##  4     4    0.364
##  5     5    0.376
##  6     6    0.417
##  7     7    0.387
##  8     8    0.329
##  9     9    0.358
## 10    10    0.383
## # … with 1,990 more rows

Como observado, foram geradas 2000 novas amostras contendo um valor diferente da média calculada.

Agora vamos criar o intervalo.

# Usando a distribuição nós conseguimos encontrar 2 valores de erro = theta_cs - theta_c entre os quais os quais esse erro está 90% do tempo. Basta encontrar o 5 e o 95 percentis. Esses são os dois valores mais próximos que contém 90% das observações. 
intervalo = reamostras %>%
  mutate(erro = theta_cs - theta_c) %>%
  summarise(erro_i = quantile(erro, .05),
            erro_s = quantile(erro, .95))

intervalo = intervalo %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)

intervalo

## # A tibble: 1 × 4
##    erro_i erro_s valor_i valor_s
##     <dbl>  <dbl>   <dbl>   <dbl>
## 1 -0.0591 0.0578   0.301   0.418

Assim podemos ver que, com confiança de 95%, os valores mínimo e máximo do intervalo são 0.3014866 e 0.4183845.

Ainda podemos visualizar a distribuição do erro amostral e o intervalo estimado por meio da implementação do bootstrap da proporção por meio dos histogramas a seguir.

#Distribuição do erro amostral
reamostras %>%
  ggplot(aes(x = theta_cs - theta_c)) +
  geom_histogram(binwidth = .005,
                 fill = "white",
                 colour = "darkblue") +
  geom_vline(xintercept = 0) + 
  labs(title = "Distribuição do erro amostral", x = "Erro Amostral (theta_cs - theta_c)", y = "Qntde. de reamostras")

# Visualização do IC gerado por meio de implementação manual
ggplot() +
  geom_rect(
    data = intervalo,
    aes(xmin = valor_i, xmax = valor_s),
    ymin = -Inf,
    ymax = Inf,
    fill = "green", 
    alpha = .25
  ) +
  geom_histogram(
    data = reamostras,
    aes(x = theta_cs),
    binwidth = .0015,
    fill = "blue",
    colour = "darkgrey"
  ) +
  geom_vline(xintercept = theta_c, color = "red") +
  labs(title = "Intervalo estimado por meio da implementação manual", x = "Theta das amostras", y = "Qntde. de reamostras")

Conclusão

A partir desses resultados, podemos observar que por implementação própria e com duas mil amostragens, os resultados referentes aos intervalos de confiança giram em torno de 0.3014866 e 0.4183845, com confiança de 95%.

analise-um-lab-parte2-Laryssa

Laryssa Kellen Filgueira Milanez

2022-05-21

Sobre Implicit Association Tests (IAT)

Arquivo

Análise de uma replicação

Qual a diferença na amostra

Comparação via ICs

1.1 Utilizando a Biblioteca Boot

Conclusão

1.2 Implementação Manual

Conclusão