Implementando ICs

Os dados

set.seed(1)

lastfm = read_csv(here::here("data/experimento-lastfm.csv"), 
                  col_types = cols(.default = col_double(), 
                                   user = col_character()))

lastfm = lastfm %>% 
  sample_n(300) %>% 
  select(news, old, mediana_pop)

glimpse(lastfm)

## Observations: 300
## Variables: 3
## $ news        <dbl> 344, 11, 26, 14, 12, 12, 17, 28, 49, 32, 20, 37, 22,…
## $ old         <dbl> 138, 54, 71, 59, 110, 181, 39, 87, 66, 55, 83, 149, …
## $ mediana_pop <dbl> 5.616130, 4.209336, 6.143725, 5.683016, 4.185174, 4.…

Proporção de artistas novos e popularidade

Utilizaremos ICs para estimar duas métricas sobre os usuários do LastFM em geral durante um período de 6 meses. Em ambos os casos faremos isso a partir de uma amostra de 300 usuários. As duas métricas são:

1. Qual a proporção de novos artistas em geral escutada por usuários?

---

Função que fornece o theta na amostra.

#proporcao de novos artistas em geral em porcentagem

theta = function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        #group_by(news) %>% 
        select(news) %>%
        summarise(proporcao = mean(news)/n()*100)
    m = agrupado %>% pull(proporcao)

    m
}

#theta_f = theta(lastfm, 1:NROW(lastfm))

booted <- boot(data = lastfm, 
               statistic = theta, 
               R = 300)

ci = tidy(booted, 
          conf.level = .95,
          conf.method = "basic",
          conf.int = TRUE)

glimpse(ci)

## Observations: 1
## Variables: 5
## $ statistic <dbl> 10.59667
## $ bias      <dbl> -0.0116
## $ std.error <dbl> 0.5788225
## $ conf.low  <dbl> 9.414039
## $ conf.high <dbl> 11.64675

Exibindo o gráfico:

ci %>%
    ggplot(aes(
        x = "",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "News", 
         y = "Proporção (%)")

Portanto, a proporção de novos artistas escutados entre os totais está aproximadamente entre 9 e 11%.

---

2. Para os usuários que gostam de música muito popular (mediana_pop > 5), qual a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos.

Crie intervalos com 95% de confiança.

---

Correlação entre gostar de novidades e gostar de artistas muito populares:

# correlacao: gostar de novidades e gostar de artistas muito populares 

theta = function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        filter(mediana_pop > 5) %>%
        summarise(correlacao = cor(news, mediana_pop))
    f = agrupado %>% pull(correlacao)

    f
}

#theta_f = theta(lastfm, 1:NROW(lastfm))

booted <- boot(data = lastfm, 
               statistic = theta, 
               R = 300)

ci = tidy(booted, 
          conf.level = .95,
          conf.method = "basic",
          conf.int = TRUE)

glimpse(ci)

## Observations: 1
## Variables: 5
## $ statistic <dbl> -0.116485
## $ bias      <dbl> -0.006522452
## $ std.error <dbl> 0.0504163
## $ conf.low  <dbl> -0.2006278
## $ conf.high <dbl> 0.009323987

Exibindo o gráfico do intervalo de confiança:

ci %>%
    ggplot(aes(
        x = "",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "", 
         y = "Correlação")

Portanto, podemos concluir que não há uma correlação muito forte entre quem gosta de artistas muito populares e quem escuta novidade (correlacao = -0.116485).

---