Os dados

set.seed(12345)

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> 25, 13, 21, 18, 10, 11, 29, 51, 23, 11, 22, 35, 77, …
## $ old         <dbl> 103, 61, 62, 180, 55, 68, 120, 45, 61, 116, 68, 83, …
## $ mediana_pop <dbl> 5.966097, 5.745970, 5.195969, 5.595928, 5.900597, 6.…

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?
lastfm_ajustada <- lastfm %>% mutate(proporcao = (news/(news+old)))

funcao_theta = function(df) {
  df %>%
    pull(proporcao) %>%
    mean() ## mudar aqui a estatística
}

theta = funcao_theta(lastfm_ajustada)

amostras = tibble(amostra = 1:1000) %>% # faremos 1000 vezes
  mutate(theta_c = map_dbl(amostra, ~ lastfm_ajustada %>% 
                                       sample_n(100) %>%  
                                       funcao_theta()))

amostras %>% 
  ggplot(aes(theta_c)) + 
  geom_histogram(binwidth = .002, fill = "white", colour = "darkgrey") + 
  geom_vline(xintercept = theta) 

theta
## [1] 0.242366

manualmente

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

theta = funcao_theta(lastfm_ajustada)

set.seed(1212)
amostra = lastfm %>%  
  sample_n(200) 

theta_c = funcao_theta(amostra)
repeticoes = 4000 # pelo menos 2000, mas mais não faz mal.
um_bootstrap <- function(x){
  proporcao = x %>% pull(proporcao)
  boot_x <- sample(proporcao,           # amostre dos dados
                   size = NROW(proporcao), # tamanho igual ao recebido
                   replace = TRUE) # aqui é o bootstrap
  return(mean(boot_x))
}
# A REAMOSTRAGEM
reamostragens = tibble(i = 1:repeticoes) %>% 
  mutate(theta_c_s = map_dbl(i, ~ um_bootstrap(lastfm_ajustada)))
confianca = .95
alpha = 1 - confianca
intervalo = reamostragens %>% 
  mutate(erro = theta_c_s - theta_c) %>% 
  summarise(erro_i = quantile(erro, alpha), 
            erro_s = quantile(erro, 1 - alpha)) %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)
intervalo
confianca = .95
alpha = 1 - confianca
intervalo = reamostragens %>% 
  mutate(erro = theta_c_s - theta_c) %>% 
  summarise(erro_i = quantile(erro, alpha), 
            erro_s = quantile(erro, 1 - alpha)) %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)
intervalo
theta_c
## [1] 30.215

usando biblioteca

theta <- function(df,i) {
    mean(
        (df %>%
        slice(i) %>%
        pull(proporcao)
    ))
}
booted <- boot(data = lastfm_ajustada, 
               statistic = theta, 
               R = 4000)
ci = tidy(booted, 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE)
glimpse(ci)
## Observations: 1
## Variables: 5
## $ statistic <dbl> 0.242366
## $ bias      <dbl> 9.011212e-05
## $ std.error <dbl> 0.006021484
## $ conf.low  <dbl> 0.2311962
## $ conf.high <dbl> 0.2547229

Conclusões

Nos dois modos de fazer, os resultados foram iguais, 0.242366 Com 95% de confiança é possível afirmar que a proporção de artistas novos escutados é de 0.24.

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

manualmente

media_pop_5 <- lastfm_ajustada %>% filter(mediana_pop > 5 )
proporcoes <- media_pop_5[["proporcao"]]
medianas <- media_pop_5[["mediana_pop"]]

media_pop_5 <- media_pop_5 %>% mutate(correlacao =cor(proporcoes, medianas))
funcao_theta = function(df) {
  df %>%
    pull(correlacao) %>%
    mean()
}

theta = funcao_theta(media_pop_5)

set.seed(1212)
amostra = media_pop_5 %>%  
  sample_n(200) 

theta_c = funcao_theta(amostra)
repeticoes = 4000 # pelo menos 2000, mas mais não faz mal.

um_bootstrap <- function(x){
  correlacao = x %>% pull(correlacao)
  boot_x <- sample(correlacao,           # amostre dos dados
                   size = NROW(correlacao), # tamanho igual ao recebido
                   replace = TRUE) # aqui é o bootstrap
  return(mean(boot_x))
}

set.seed(1212)

# A REAMOSTRAGEM
reamostragens = tibble(i = 1:repeticoes) %>% 
  mutate(theta_c_s = map_dbl(i, ~ um_bootstrap(amostra)))
intervalo = intervalo %>% 
  mutate(valor_i = theta_c + erro_i, 
         valor_s = theta_c + erro_s)

intervalo

usando biblioteca

t2 <- function(d, i) {
    df = d %>%
        slice(i) %>%
        filter(mediana_pop > 5) 
        cor(df$proporcao, df$mediana_pop)
}

btstrp <- boot(data = media_pop_5, 
               statistic = t2, 
               R = 2000)

IC = tidy(btstrp, 
          conf.level = .95,
          conf.method = "bca",
          conf.int = TRUE)

glimpse(IC)
## Observations: 1
## Variables: 5
## $ statistic <dbl> -0.05679804
## $ bias      <dbl> 0.001497383
## $ std.error <dbl> 0.06171567
## $ conf.low  <dbl> -0.1831636
## $ conf.high <dbl> 0.06072484

Crie intervalos com 95% de confiança.

IC %>%
    ggplot(aes(
        x = "",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "popularidade mediana dos artistas x proporção dos artistas novos", 
         y = "")

### Conclusões

O intervalo de confiança foi [-0.1883234, 0.06283954]. Com 95% de confiança podemos afirmar que a correlação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos é de-0.05679804, ou seja muitíssimo baixo, então essas duas variáveis não se influenciam muito.