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?
  2. 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.

Crie intervalos com 95% de confiança.

Proporção de novos artistas escutada por usuários

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

Analisando graficamente o número de artistas novos escutados pelos usuários.

lastfm %>%
    ggplot(aes(news)) +
    geom_histogram(bins = 25) +
    scale_x_continuous(breaks = scales::pretty_breaks(n = 10))

Vemos que poucos novos artistas foram escutados durante os 6 meses.

A proporção de novos artistas será calculada relacionando o número de artistas novos e o número total de artistas (news / news + old).

Bootstrapping manual

funcao_theta <- function(df){
  x <- df %>% 
    mutate(proporcao = news/(news + old)) %>% 
    pull(proporcao)
  mean(x)
}

theta_c <- funcao_theta(lastfm)

theta_c
## [1] 0.242366
repeticoes = 4000
um_bootstrap <- function(df){
  x = df %>% 
      mutate(proporcao = news/(news + old))
  proporcao = x$proporcao
  boot_x <- sample(proporcao,           
                   size = NROW(proporcao), 
                   replace = TRUE)
  
  return(mean(boot_x))
}

set.seed(1212)

reamostragens = tibble(i = 1:repeticoes) %>% 
  mutate(theta_c_s = map_dbl(i, ~ um_bootstrap(lastfm)))

reamostragens

Calculando o IC:

intervalo = reamostragens %>% 
  mutate(erro = theta_c_s - 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

Bootstrapping pela biblioteca boot

funcao_theta <- function(df, i){
  x <- df %>% 
    slice(i) %>% 
    mutate(proporcao = news/(news + old)) %>% 
    pull(proporcao)
  mean(x)
}

booted <- boot(data = lastfm, 
               statistic = funcao_theta, 
               R = repeticoes)

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.20679e-05
## $ std.error <dbl> 0.006022829
## $ conf.low  <dbl> 0.2311165
## $ conf.high <dbl> 0.2546783

Podemos ver que o valor do theta do bootstrapping manual foi de 0.242366 e o intervalo de confiança de [0.2325967, 0.2524944] e pela bibliteca o valor do theta é 0.242366 e o intervalo de confiança [0.2311165, 0.2546783]. Os intervalos foram construídos com 95% de confiança. Dessa forma, os valores obtidos mostram que as estimativas produzidas pelos dois métodos foram iguais e podemos afirmar, com 95% de confiança, que a proporção de novos artistas em geral escutada por usuários é de 0.242366. Portanto, a partir da amostra utilizada, temos indícios que os usuários da plataforma consomem uma proporção baixa de artistas novos.

Usuários que gostam muito de música pop

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?

Analisando graficamente a relação entre a popularidade mediana dos artistas escutado e a proporção dos artistas escutados que eram novos.

lastfm %>%
    filter(mediana_pop > 5) %>% 
    mutate(proporcao = news/(news + old)) %>% 
    ggplot(aes(x = mediana_pop, y = proporcao)) +
    geom_point()

Pela visualização acima é difícil de vermos uma relação entre as variávies.

Bootstrapping manual

funcao_theta_pop <- function(df){
  x <- df %>% 
    filter(mediana_pop > 5) %>% 
    mutate(proporcao = news/(news + old)) %>% 
    summarise(correlacao = cor(mediana_pop, proporcao, method = 'pearson')) %>% 
    pull(correlacao)
  return(x)
}

theta_c_pop <- funcao_theta_pop(lastfm)

theta_c_pop
## [1] -0.05679804
repeticoes = 4000
um_bootstrap_pop <- function(df){
  boot_x <- sample_n(df,           
                   size = NROW(df), 
                   replace = TRUE) 
  
  return(funcao_theta_pop(boot_x))
}

reamostragens = tibble(i = 1:repeticoes) %>% 
  mutate(theta_c_s_pop = map_dbl(i, ~ um_bootstrap_pop(lastfm)))

reamostragens
intervalo = reamostragens %>% 
  mutate(erro = theta_c_s_pop - theta_c_pop) %>% 
  summarise(erro_i = quantile(erro, .05), 
            erro_s = quantile(erro, .95))

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

Bootstrapping pela biblioteca boot

funcao_theta_pop <- function(df, i){
  x <- df %>% 
    slice(i) %>% 
    filter(mediana_pop > 5) %>% 
    mutate(proporcao = news/(news + old)) %>% 
    summarise(correlacao = cor(mediana_pop, proporcao, method = 'pearson')) %>% 
    pull(correlacao)
  return(x)
}

booted <- boot(data = lastfm, 
               statistic = funcao_theta_pop, 
               R = repeticoes)

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

glimpse(ci)
## Observations: 1
## Variables: 5
## $ statistic <dbl> -0.05679804
## $ bias      <dbl> 0.001326655
## $ std.error <dbl> 0.06337184
## $ conf.low  <dbl> -0.182802
## $ conf.high <dbl> 0.06636441

Podemos ver que o valor do theta do bootstrapping manual foi de -0.05679804 e o intervalo de confiança de [-0.1601296, 0.0475122] e pela bibliteca o valor do theta é -0.05679804 e o intervalo de confiança de [-0.182802, 0.06636441]. Os intervalos foram construídos com 95% de confiança. Dessa forma, os valores obtidos mostram que as estimativas produzidas pelos dois métodos foram iguais e podemos afirmar, com 95% de confiança, que a correlação entre a popularidade mediana dos artistas e a proporção dos novos artistas escutados é de -0.05679804. Portanto, temos indícios que existe uma correlação negativa e baixa na amostra analisada. Além disso, ao observar os intervalos de confiança o valor dessa correlação pode ser negativa e baixa, ou nula, pois o valor 0 está incluso no intervalo, ou positivia e extremamente baixa.