Visão geral

Os dados utilizados são sobre um experimento referente à preferência de usuários em relação ao tipo de mecanismo utilizado para a montagem de uma playlist em Jukeboxes, ou seja, uma playlist colaborativa. Os usuários foram divididos em 3 grupos e avaliaram 5 formas de organizar uma determinada playlist. Para cada uma foi dada uma nota de 1 a 5, onde quanto maior a nota, maior é a satisfação do usuário com a configuração da playlist.

Objetivos

A partir dos dados amostrais sobre satisfação dos usuários, vamos utilizar intervalos de confiança para produzir uma estimativa para a população de usuários de qual é o melhor mecanismo para a montagem de playlist em Jukeboxes.

Explorando os dados

dados = read_csv(here::here("data/satisfacoes.csv"), 
                 col_types = "cdcc") 

glimpse(dados)
## Rows: 115
## Columns: 4
## $ user_id      <chr> "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11",…
## $ satisfaction <dbl> 2.0, 3.0, 1.5, 1.0, 2.0, 2.5, 2.0, 3.0, 2.0, 2.0, 2.0, 2…
## $ scenario     <chr> "baseline", "baseline", "baseline", "baseline", "baselin…
## $ group        <chr> "3", "1", "2", "2", "1", "1", "3", "3", "2", "1", "3", "…

A variável user_id é auto-explicativa. Já satisfaction refere-se a satisfação do usuário com a playlist, enquanto scenario é sobre as formas de organizar a playlist. Por fim, group é apenas sobre o grupo de controle que o usuário estava durante o experimento.
É importante caracterizar as configurações das playlists, sendo elas:

  • Baseline: Uma fila simples, se uma nova música é adicionada à playlist, ela é colocada no final da fila.
  • Like/dislike: Apresenta um recurso que indica aos usuários se os outros usuários estão gostando (Like) ou não (Dislike) das músicas que estão sendo adicionadas.
  • Skip: Permite que os usuários pulem uma música da playlist. Se determinada quantidade de usuários votarem que querem pular essa música, a proxima da fila é reproduzida.
  • Up/downvoting: De acordo com as avaliações dos usuários, as músicas mais bem avaliadas são tocadas primeiro e as piores avaliadas são tocadas por último.
  • Combined: Todos os macanismos são aplicados juntos.

Observando a distribuição das notas de satisfação, por cenários, temos:

dados %>% 
  ggplot(aes(x = scenario, y = satisfaction, color = scenario)) +
  geom_quasirandom() +
  labs(title = "Distribuição da satisfação por configuração da playlist", 
       x = "Configuração da playlist", 
       y = "Satisfação", 
       color = "Configuração") +
  theme(plot.title = element_text(hjust = 0.5))

Pelo gráfico das distribuições acima, vemos que up/downvoting possui notas mais altas do que os demais, no geral.

Comparação via média com ICs

Para produzir uma estimativa da população sobre qual é o melhor método, vamos construir intervalos de confiança através de reamostragens, utilizando bootstraping. Para isso, vamos adotar a média da satisfação como a estatística de interesse, ou seja, analisaremos intervalos de confiança construídos a partir das médias amostrais para verificar se essa aproximação é válida para a média da população.

Precisamos definir uma funcção que produz a estatística (média).

theta_media <- function(d, i) {
  d %>% 
    slice(i) %>% 
    summarise(media = mean(satisfaction)) %>% 
    pull(media)
}

Calculando o intervalo de confiança da média da satisfação para cada um dos métodos, temos:

ci_theta <- function(methods) {
  dados %>% 
    filter(scenario == methods) %>% 
    boot(statistic = theta_media, R = 4000) %>% 
        tidy(conf.level = .95, conf.method = "bca", conf.int = TRUE)
}

ic_medias <- dados %>% 
  select(scenario) %>% 
  unique() %>% 
  cbind(map_df(.$scenario, ~ ci_theta(.)))

ic_medias
##        scenario statistic          bias  std.error conf.low conf.high
## 1      baseline  2.130435 -0.0018695652 0.13069022 1.869565  2.369565
## 2      combined  4.043478  0.0009836957 0.11078043 3.782609  4.217391
## 3  like/dislike  3.652174  0.0006793478 0.11065463 3.434783  3.847826
## 4 up/downvoting  4.391304 -0.0023315217 0.09263596 4.217391  4.565217
## 5          skip  2.521739  0.0009782609 0.10342466 2.270706  2.678440
ic_medias %>% 
  ggplot(aes(x = reorder(scenario, statistic), y = statistic, ymin = conf.low, ymax = conf.high, color = scenario)) + 
  geom_pointrange() +
  geom_errorbar(width = 0.4) +
  labs(title = "ICs da média dos métodos", x = "Métodos", y = "Média da satisfação", color = "Métodos") +
  theme(plot.title = element_text(hjust = 0.5))

Com a visualização acima, podemos ver que essa estatística (média da satisfação) não é generalizável e não reflete a média da população. Isso acontece por conta de existirem diversas interseções entre os intervalos de confiança. Isso acontece com baseline e skip; entre like/dislike e combined; e com combined e up/downvoting. Dessa forma, entre esses três pares de métodos, a média não é suficiente pra dizer que um método é melhor do que o outro, pois sempre vai haver uma incerteza associada ao intervalo de confiança da média de todos os métodos.

Comparação via diferença das médias com ICs

Para definir o melhor mecanismo com base no IC da diferença das médias, precisamos saber todos as combinações de métodos possíveis e depois produzir essa estatística para cada uma. Temos:

library(gtools)

comb_scenarios <- dados %>% 
  pull(scenario) %>% 
  permutations(n = NROW(unique(.)), r = 2)

comb_scenarios
##       [,1]            [,2]           
##  [1,] "baseline"      "combined"     
##  [2,] "baseline"      "like/dislike" 
##  [3,] "baseline"      "skip"         
##  [4,] "baseline"      "up/downvoting"
##  [5,] "combined"      "baseline"     
##  [6,] "combined"      "like/dislike" 
##  [7,] "combined"      "skip"         
##  [8,] "combined"      "up/downvoting"
##  [9,] "like/dislike"  "baseline"     
## [10,] "like/dislike"  "combined"     
## [11,] "like/dislike"  "skip"         
## [12,] "like/dislike"  "up/downvoting"
## [13,] "skip"          "baseline"     
## [14,] "skip"          "combined"     
## [15,] "skip"          "like/dislike" 
## [16,] "skip"          "up/downvoting"
## [17,] "up/downvoting" "baseline"     
## [18,] "up/downvoting" "combined"     
## [19,] "up/downvoting" "like/dislike" 
## [20,] "up/downvoting" "skip"

A seguir, precisamos de duas funções: uma que calcule as médias de dois mecanismos de jukebox e calcule a diferença entre elas, produzindo a estatística desejada; a outra função deve realizar o bootstraping para a construção dos intervalos de confiança.

ci_diff <- function(scenario1, scenario2) {
  
  theta_diff <- function(d, i) {
    agrupado = d %>% 
          slice(i) %>% 
          group_by(scenario) %>% 
          summarise(media = mean(satisfaction))
    sc1 = agrupado %>% filter(scenario == scenario1) %>% pull(media)
    sc2 = agrupado %>% filter(scenario == scenario2) %>% pull(media)
    sc2 - sc1
  }
  
  dados %>% 
  filter(scenario %in% c(scenario1, scenario2)) %>% 
  boot(statistic = theta_diff, R = 4000) %>% 
    tidy(conf.level = .95, conf.method = "bca", conf.int = TRUE)
}

# ci_diff("baseline", "combined")

Cada um dos pares de combinações de mecanismos de playlist está indicado em uma linha da matriz com todas as combinações. Logo, precisamos calcular o intervalo de confiança de cada uma das linhas da matriz comb_scenarios.

diff_medias <- map_df(1:NROW(comb_scenarios), ~ {function(nrow){
        scenario1 = comb_scenarios[nrow, 1]
        scenario2 = comb_scenarios[nrow, 2]
        
        cbind(tibble(scenario1, scenario2), ci_diff(scenario1, scenario2))
      }}
(.))

diff_medias
##        scenario1     scenario2  statistic          bias std.error    conf.low   conf.high
## 1       baseline      combined  1.9130435  1.781592e-05 0.1691709  1.56521739  2.22691930
## 2       baseline  like/dislike  1.5217391  1.192161e-03 0.1747890  1.18031189  1.86538462
## 3       baseline          skip  0.3913043 -1.399979e-03 0.1678683  0.04075528  0.71739130
## 4       baseline up/downvoting  2.2608696  1.101997e-04 0.1612829  1.94642857  2.57537625
## 5       combined      baseline -1.9130435  2.596430e-03 0.1722647 -2.25057405 -1.57539683
## 6       combined  like/dislike -0.3913043 -2.389106e-03 0.1578222 -0.68766242 -0.07388176
## 7       combined          skip -1.5217391  3.777529e-03 0.1545505 -1.82462211 -1.22174434
## 8       combined up/downvoting  0.3478261 -7.977750e-04 0.1467860  0.07120801  0.64615385
## 9   like/dislike      baseline -1.5217391 -2.424673e-03 0.1744663 -1.85419607 -1.17391304
## 10  like/dislike      combined  0.3913043 -9.895355e-04 0.1614816  0.06819835  0.70475658
## 11  like/dislike          skip -1.1304348  1.726718e-05 0.1579107 -1.43568271 -0.82608696
## 12  like/dislike up/downvoting  0.7391304 -3.872672e-03 0.1477414  0.44684012  1.02172260
## 13          skip      baseline -0.3913043  4.037483e-05 0.1715082 -0.72925127 -0.06364270
## 14          skip      combined  1.5217391  7.969285e-04 0.1516851  1.22373132  1.81143252
## 15          skip  like/dislike  1.1304348  6.263566e-03 0.1570552  0.82002032  1.44087628
## 16          skip up/downvoting  1.8695652 -2.891414e-03 0.1404596  1.60138027  2.14770303
## 17 up/downvoting      baseline -2.2608696 -5.905927e-04 0.1652394 -2.59304191 -1.95068991
## 18 up/downvoting      combined -0.3478261 -1.671381e-03 0.1439641 -0.65217391 -0.08594092
## 19 up/downvoting  like/dislike -0.7391304  1.445453e-03 0.1488029 -1.03571442 -0.45443482
## 20 up/downvoting          skip -1.8695652 -3.494267e-04 0.1406196 -2.15656233 -1.60606061

Observando os resultados pela visualização abaixo, temos:

diff_medias %>% 
  ggplot(aes(x = statistic, y = reorder(scenario1, statistic), xmin = conf.low, xmax = conf.high, color = scenario1)) +
  geom_pointrange() +
  geom_errorbar(width = 0.4) +
  geom_vline(xintercept = 0, linetype = "dashed", alpha = 0.5) +
  facet_grid(rows = vars(scenario2)) +
  labs(title = "Diferença das médias em relação as combinações de métodos", x = "Diferença das médias", y = "Método", color = "Método") +
  theme(plot.title = element_text(hjust = 0.5))

Podemos interpretar os quadros da seguinte maneira: se a marca referente à um método (indicada pela cor e que está no eixo y) estiver no lado direito em relação a linha pontilhada, a diferença está acima de 0, indicando que o IC do mecanismo do facet (o retangulo cinza que envolve os pontos) foi maior e é mais bem avaliado. Consequentemente, se a marca estiver do lado esquerdo da linha pontilhada, o método mais bem avaliado é o que está no eixo y (ou indicado pela cor).
Exemplificando: o terceiro facet de cima para baixo (skip) possui quase todos os ICs das diferenças das médias do lado esquerdo e apenas um (baseline) do lado direito, logo ele só é mais bem avaliado do que baseline, que está do lado direito. Além disso, é importante dizer que se houvesse algum IC com interseção no 0 (linha vertical pontilhada) não seria possível indicar que um método é melhor do que outro. Como isso não acontece, podemos verificar com mais facilidade qual é o melhor método. Para isso, só precisamos contar qual deles possui mais valores maiores do que 0 (mais valores do lado direito) e facilmente chegamos no método up/downvoting como sendo o melhor mecanismo entre os testados.

Comparação via diferença das médias com teste de hipótese

Como vimos que os resultados produzidos pela diferença das médias foram melhores, continuaremos com essa estatística para realizarmos a comparação por meio de um teste de hipótese. Dessa maneira poderemos estimar a diferença das médias da satisfação. Como já vimos que o mecanismo up/downvoting apresentou bons resultados, vamos analisar somente a diferença deste método com os outros e não mais as diferenças de todos com todos.
Então, vamos calcular a estatística da diferença entre as médias da satisfação dos mecanismos, utilizando a amostra para fazer 4000 reamostragens e garar uma distribuição. A partir dos valores que forem obtidos para a estatística e pela distribuição obtida, poderemos rejeitar H0 (ou não). Em nosso cenário, a hipótese nula (H0) é definida pela existência de diferença nas médias da satisfação, ou seja, se a estatística (theta) estiver dentro da distribuição da população, não podemos rejeitar H0.

Calculando a estatística (theta) das diferenças das médias, temos:

comb_scenarios_updown <- comb_scenarios[comb_scenarios[, 1] == "up/downvoting",]

diff_medias_updown <- map_df(1:NROW(comb_scenarios_updown), ~ {function(nrow){
        scenario1 = comb_scenarios_updown[nrow, 1]
        scenario2 = comb_scenarios_updown[nrow, 2]
        
        cbind(tibble(scenario1, scenario2), ci_diff(scenario1, scenario2))
      }}
(.))

diff_medias_updown
##       scenario1    scenario2  statistic          bias std.error   conf.low
## 1 up/downvoting     baseline -2.2608696 -1.744799e-03 0.1627080 -2.5952727
## 2 up/downvoting     combined -0.3478261 -1.523362e-03 0.1464851 -0.6400076
## 3 up/downvoting like/dislike -0.7391304 -9.585156e-05 0.1488360 -1.0402078
## 4 up/downvoting         skip -1.8695652 -1.977720e-03 0.1408406 -2.1549352
##     conf.high
## 1 -1.95322874
## 2 -0.06571429
## 3 -0.45454545
## 4 -1.59956299

Em seguida, vamos calcular as diferenças das médias realizando 4000 reamostragens, obtendo uma distribuição. Temos:

theta_diff_emb_1 = function(d){
    satisfacoes = d %>% 
        mutate(scenario_embaralhado = sample(scenario, n())) %>% 
        group_by(scenario_embaralhado) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    up = satisfacoes %>% filter(scenario_embaralhado == "up/downvoting") %>% pull(satisfacao)
    combined = satisfacoes %>% filter(scenario_embaralhado == "baseline") %>% pull(satisfacao)
    up - combined
}

diff_up_base = replicate(4000, {theta_diff_emb_1(dados)})

theta_diff_emb_2 = function(d){
    satisfacoes = d %>% 
        mutate(scenario_embaralhado = sample(scenario, n())) %>% 
        group_by(scenario_embaralhado) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    up = satisfacoes %>% filter(scenario_embaralhado == "up/downvoting") %>% pull(satisfacao)
    combined = satisfacoes %>% filter(scenario_embaralhado == "combined") %>% pull(satisfacao)
    up - combined
}

diff_up_comb = replicate(4000, {theta_diff_emb_2(dados)})

theta_diff_emb_3 = function(d){
    satisfacoes = d %>% 
        mutate(scenario_embaralhado = sample(scenario, n())) %>% 
        group_by(scenario_embaralhado) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    up = satisfacoes %>% filter(scenario_embaralhado == "up/downvoting") %>% pull(satisfacao)
    combined = satisfacoes %>% filter(scenario_embaralhado == "like/dislike") %>% pull(satisfacao)
    up - combined
}

diff_up_ld = replicate(4000, {theta_diff_emb_3(dados)})

theta_diff_emb_4 = function(d){
    satisfacoes = d %>% 
        mutate(scenario_embaralhado = sample(scenario, n())) %>% 
        group_by(scenario_embaralhado) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    up = satisfacoes %>% filter(scenario_embaralhado == "up/downvoting") %>% pull(satisfacao)
    combined = satisfacoes %>% filter(scenario_embaralhado == "skip") %>% pull(satisfacao)
    up - combined
}

diff_up_skip = replicate(4000, {theta_diff_emb_4(dados)})

Plotando os resultados, temos:

p1 <- tibble(diferenca = diff_up_base) %>% 
    ggplot(aes(x = diferenca)) + 
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = diff_medias_updown %>% filter(scenario2 == "baseline") %>% pull(statistic), color = "orange") + 
    geom_vline(xintercept = -(diff_medias_updown %>% filter(scenario2 == "baseline") %>% pull(statistic)), color = "orange") +
    labs(title = "Diferença entre default e baseline")

p2 <- tibble(diferenca = diff_up_comb) %>% 
    ggplot(aes(x = diferenca)) + 
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = diff_medias_updown %>% filter(scenario2 == "combined") %>% pull(statistic), color = "orange") + 
    geom_vline(xintercept = -(diff_medias_updown %>% filter(scenario2 == "combined") %>% pull(statistic)), color = "orange") +
    labs(title = "Diferença entre default e combined")

p3 <- tibble(diferenca = diff_up_ld) %>%
    ggplot(aes(x = diferenca)) +
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = diff_medias_updown %>% filter(scenario2 == "like/dislike") %>% pull(statistic), color = "orange") + 
    geom_vline(xintercept = -(diff_medias_updown %>% filter(scenario2 == "like/dislike") %>% pull(statistic)), color = "orange") +
    labs(title = "Diferença entre default e like/dislike")

p4 <- tibble(diferenca = diff_up_skip) %>% 
    ggplot(aes(x = diferenca)) + 
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = diff_medias_updown %>% filter(scenario2 == "skip") %>% pull(statistic), color = "orange") + 
    geom_vline(xintercept = -(diff_medias_updown %>% filter(scenario2 == "skip") %>% pull(statistic)), color = "orange") +
    labs(title = "Diferença entre default e skip")

grid.arrange(p1, p2, p3, p4, top = "Diferenças entre médias - up/downvoting como default")

A partir das visualizações dos resultados acima, podemos dizer que:

  • Entre up/downvoting e baseline temos que a distribuição não está dentro das diferenças calculadas (theta), logo rejeita-se H0 e podemos afirmar que existe uma diferença significativa na avaliação dos dois mecanismos.
  • Entre up/downvoting e combined verifica-se que a estatística (theta) está dentro da distribuição da população e não podemos rejeitar H0. Com isso, não verificamos uma diferença significativa entre as duas configurações, já que não é possível conhecer o valor da diferença na população.
  • Entre up/downvoting e like/dislike encontramos a mesma situação da comparação anterior e não podemos verificar uma diferença significativa, não podendo rejeitarmos H0.
  • Entre up/downvoting e skip observamos que a distribuição também não está dentro das diferenças calculadas e rejeitamos H0. Assim, podemos afirmar que existe uma diferença significativa na avaliação dos dois mecanismos.

Comparativo dos métodos para as diferenças das médias

Verificamos diferenças relevantes entre os métodos, com os ICs demonstrando que up/downvoting é o melhor método em comparação com todos os outros - o que não se verifica com os testes de hipótese, onde up/downvoting só demonstrou ser melhor do que baseline e skip.