EDA UFCG: LastFM - Introdução a Inferência

Os dados

set.seed(12345)

lastfm = read_csv(here::here("data/experimento-lastfm.csv"), 
                  col_types = cols(.default = col_double(), 
                                   user = col_character())) %>% 
  mutate(proporcao = (news / (news + old)))

glimpse(lastfm)

Observations: 11,989
Variables: 16
$ user           <chr> "00blixt", "0ctane", "0sebastian0", "0xkirill", "111Ar…
$ ecletic        <dbl> 1159.4960, 3439.8373, 1611.4464, 697.0974, 1660.1563, …
$ clusters_total <dbl> 37, 155, 68, 37, 72, 93, 163, 150, 88, 132, 130, 24, 7…
$ clusters       <dbl> 19, 57, 25, 13, 31, 37, 64, 59, 27, 58, 62, 12, 36, 73…
$ media_pop      <dbl> 5.536362, 4.726167, 5.804086, 4.997963, 5.800357, 4.40…
$ mediana_pop    <dbl> 5.660406, 4.730935, 5.896073, 5.214290, 5.865121, 4.36…
$ dp_pop         <dbl> 0.6852190, 0.8819529, 0.6167104, 0.8685811, 0.5448580,…
$ news           <dbl> 38, 32, 24, 36, 28, 25, 30, 28, 14, 22, 27, 21, 23, 37…
$ news_total     <dbl> 38, 32, 24, 36, 28, 25, 30, 28, 14, 22, 27, 21, 23, 37…
$ old            <dbl> 116, 130, 10, 46, 128, 95, 228, 53, 46, 118, 90, 34, 1…
$ old_total      <dbl> 119, 141, 13, 71, 133, 167, 256, 63, 52, 125, 102, 45,…
$ count_sim      <dbl> 0.155514371, 0.074823398, -0.123188406, 0.084193831, 0…
$ tempo_sim      <dbl> 0.208395596, -0.020325875, -0.043478261, -0.001606542,…
$ count_pop      <dbl> 0.26923104, 0.13144651, -0.16666667, 0.09372521, 0.095…
$ tempo_pop      <dbl> 0.08303680, -0.14228113, -0.11594203, 0.13012993, 0.09…
$ proporcao      <dbl> 0.2467532, 0.1975309, 0.7058824, 0.4390244, 0.1794872,…

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.

Metodologia

1. Achar a media geral
2. Achamos médias a partir de n amostras de tamanho m.
3. Montar o intervalo de confiança a partir da porcentagem desejada

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

1. Achando a média geral

Essa média geral será nossa médida base para visualizarmos se a nossa inférencia “acertou” ou não

media_geral = lastfm %>% 
  filter(!is.na(proporcao)) %>% 
  pull(proporcao) %>%
  mean()

media_geral

[1] 0.2467958

2. Achando médias a partir de n amostras de tamanho m

Faremos isso para termos dados o suficiente para montarmos o nosso intervalo de confiança.

Para fazer isso, utilizaremos o processo de bootstraping. Esse processo consiste na montagem de novas amostras a partir uma unica amostra onde os elementos da nova amostra serão sorteados com reposição a partir da amostra original.

Primeiro precisamos definir qual o número de amostras e qual o tamanho de cada uma delas:

quantidade_amostras = 4000
tamanho_amostra = 300

paste("Quantidade de amostras: ", quantidade_amostras)

[1] "Quantidade de amostras:  4000"

paste("Tamanho das amostras: ", tamanho_amostra)

[1] "Tamanho das amostras:  300"

Com isso montamos a amostra raiz:

amostra_raiz = lastfm %>% 
  sample_n(tamanho_amostra)

amostra_raiz

Já que só queremos trabalhar com a média do atributo proporcao, ao invés de trabalhar com o dataset inteiro, podemos trabalhar com o vetor, com isso:

vetor_raiz_news = amostra_raiz %>% 
  pull(proporcao)

vetor_raiz_news

  [1] 0.31460674 0.15283843 0.15662651 0.20000000 0.09722222 0.20238095
  [7] 0.10924370 0.14583333 0.30909091 0.41353383 0.11627907 0.22147651
 [13] 0.07751938 0.82509506 0.22727273 0.22222222 0.37931034 0.24418605
 [19] 0.36274510 0.34591195 0.31547619 0.10810811 0.14054054 0.20434783
 [25] 0.25899281 0.24691358 0.20000000 0.18085106 0.25882353 0.26446281
 [31] 0.24545455 0.11627907 0.19780220 0.12574850 0.26875000 0.10989011
 [37] 0.19469027 0.32812500 0.09655172 0.08441558 0.25510204 0.12871287
 [43] 0.32692308 0.14736842 0.33490566 0.25301205 0.35000000 0.36220472
 [49] 0.24096386 0.19480519 0.32407407 0.15000000 0.17142857 0.35294118
 [55] 0.17073171 0.22047244 0.46107784 0.18253968 0.25543478 0.19491525
 [61] 0.36363636 0.20338983 0.20370370 0.19444444 0.25850340 0.14788732
 [67] 0.30882353 0.52500000 0.20879121 0.20731707 0.16923077 0.34782609
 [73] 0.11046512 0.22222222 0.23846154 0.34375000 0.24342105 0.17582418
 [79] 0.31578947 0.15131579 0.27777778 0.21182266 0.44186047 0.16560510
 [85] 0.29032258 0.08108108 0.11818182 0.21686747 0.19047619 0.34054054
 [91] 0.31250000 0.22777778 0.18750000 0.20714286 0.32450331 0.20689655
 [97] 0.28865979 0.12500000 0.23728814 0.24793388 0.25984252 0.35164835
[103] 0.29411765 0.16923077 0.10000000 0.16551724 0.21259843 0.42960289
[109] 0.45045045 0.22429907 0.15116279 0.29000000 0.15263158 0.13392857
[115] 0.24000000 0.42406877 0.36190476 0.15714286 0.21052632 0.67635659
[121] 0.36448598 0.04494382 0.15508021 0.09523810 0.38709677 0.25877193
[127] 0.33333333 0.24698795 0.28395062 0.20833333 0.26923077 0.23308271
[133] 0.11358575 0.19354839 0.34848485 0.32142857 0.45762712 0.44347826
[139] 0.24175824 0.09523810 0.46987952 0.56223176 0.11290323 0.28125000
[145] 0.32710280 0.31192661 0.24418605 0.10489510 0.14666667 0.56470588
[151] 0.26600985 0.09448819 0.08024691 0.27500000 0.15415020 0.12099644
[157] 0.17647059 0.17171717 0.12500000 0.15384615 0.31884058 0.19607843
[163] 0.21000000 0.20772947 0.27737226 0.11458333 0.24096386 0.25490196
[169] 0.43801653 0.21428571 0.10000000 0.12571429 0.22666667 0.24299065
[175] 0.25520833 0.13684211 0.10144928 0.25961538 0.32631579 0.40322581
[181] 0.22368421 0.28879310 0.11494253 0.11111111 0.32258065 0.50442478
[187] 0.14606742 0.12312312 0.16949153 0.09944751 0.39062500 0.28225806
[193] 0.31446541 0.16417910 0.25925926 0.36054422 0.06349206 0.64761905
[199] 0.36290323 0.15044248 0.18548387 0.46808511 0.18828452 0.28837209
[205] 0.16363636 0.14479638 0.14728682 0.24363636 0.21052632 0.18181818
[211] 0.28787879 0.24675325 0.46376812 0.41935484 0.39090909 0.16455696
[217] 0.10924370 0.17543860 0.19298246 0.49479167 0.16000000 0.25547445
[223] 0.19230769 0.09581882 0.37457045 0.07692308 0.30158730 0.26250000
[229] 0.11643836 0.22222222 0.18518519 0.38053097 0.43442623 0.18333333
[235] 0.38036810 0.14444444 0.16513761 0.31944444 0.17460317 0.14723926
[241] 0.52439024 0.18181818 0.34722222 0.23376623 0.17948718 0.30434783
[247] 0.26168224 0.12621359 0.25581395 0.19393939 0.25225225 0.19583333
[253] 0.25454545 0.39416058 0.34408602 0.26666667 0.25714286 0.21212121
[259] 0.32888147 0.31707317 0.31007752 0.15000000 0.43023256 0.08547009
[265] 0.23333333 0.21428571 0.31972789 0.41379310 0.38596491 0.21428571
[271] 0.27459016 0.11811024 0.22222222 0.36538462 0.16935484 0.15909091
[277] 0.12800000 0.35576923 0.45029240 0.20481928 0.28682171 0.19047619
[283] 0.33734940 0.25925926 0.36231884 0.16363636 0.17322835 0.11403509
[289] 0.28888889 0.19148936 0.06395349 0.38596491 0.54320988 0.11678832
[295] 0.36885246 0.16438356 0.32775120 0.39849624 0.20000000 0.36231884

A partir desse vetor, montaremos novos vetores e calcularemos as médias deles:

bootstrap_vetor = function (vetor) {
  vetor %>% 
    sample(replace = TRUE, size = length(vetor))
}

calcula_media_bootstrap = function (vetor) {
  vetor %>% 
    bootstrap_vetor() %>% 
    mean()
}

set.seed(1212)

medias_proporcao = tibble(n_amostra = 1:quantidade_amostras) %>% 
  mutate(media_amostra = map_dbl(n_amostra, ~ calcula_media_bootstrap(vetor_raiz_news)))

medias_proporcao

Usamos a função bootstrap_vetor para gerar novos vetores e usamos a função calcula_media_bootstrap para gerar novas médias a partir de um vetor bootstrap. Por fim, fizemos uma tabela com n linhas, sendo n a quantidade de amostras, com cada linha contendo o número da linha e uma média de uma amostra bootstrap.

3. Montando o intervalo de confiança

A partir do calculo da média da amostra raiz:

media_amostra_raiz = vetor_raiz_news %>% 
  mean()

media_amostra_raiz

[1] 0.2483568

Calculamos os erros das amostragems:

medias_proporcao = medias_proporcao %>% 
  mutate(erro = media_amostra_raiz - media_amostra)

medias_proporcao

Depois, podemos montar o intervalo de confiança:

confianca_desejada = 0.95

margem_intervalo = (1 - confianca_desejada) / 2

margem_intervalo

[1] 0.025

intervalo = medias_proporcao %>% 
  summarise(
    erro_inferior = quantile(erro, margem_intervalo),
    erro_superior = quantile(erro, 1 - margem_intervalo),
    valor_inferior = quantile(media_amostra, margem_intervalo),
    valor_superior = quantile(media_amostra, 1 - margem_intervalo),
  )

intervalo

Com isso, podemos plotar num gráfico para visualizar:

medias_proporcao %>% 
  ggplot() +
  geom_rect(
    data = intervalo,
    aes(xmin = valor_inferior, xmax = valor_superior),
    ymin = -Inf,
    ymax = +Inf,
    fill = "yellow",
    alpha = 0.6
  ) + 
  geom_histogram(
    aes(x = media_amostra),
    fill = "white",
    color = "brown"
  ) +
  geom_vline(
    xintercept = media_amostra_raiz,
    color = "darkblue"
  ) +
  geom_vline(
    xintercept = media_geral,
    color = "darkgreen"
  ) 

O IC estimado com 95% de confiança é [0.2354, 0.2611].

Com biblioteca

library(boot)
library(broom)

calculo_media = function(d, i) {
  d %>% 
    slice(i) %>% 
    summarise(media = mean(proporcao)) %>% 
    pull(media)
}

amostra_raiz %>% 
  boot(statistic = calculo_media, R = quantidade_amostras) %>% 
  tidy(conf.level = confianca_desejada,
       conf.int = TRUE)