Comparando mecanismos para jukebox sociais

library(tidyverse)
theme_set(theme_bw())

library(boot)
library(broom)

knitr::opts_chunk$set(tidy = FALSE,
                      fig.width = 6,
                      fig.height = 5)

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

glimpse(dados)

## Observations: 115
## Variables: 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,...
## $ scenario     <chr> "baseline", "baseline", "baseline", "baseline", "basel...
## $ group        <chr> "3", "1", "2", "2", "1", "1", "3", "3", "2", "1", "3",...

Explicando as variáveis

Baseline: Uma fila, quando uma música é adicionada na playlist, ela vai para o final da fila. Like/dislike: Indica se os usuários estão gostando (like) ou não (dislike) das músicas. Skip: O usuário pode pular uma música da playlist. Up/downvoting: As músicas com melhores avaliações são tocadas primeiro e as com piores avaliações são por último. Combined: Todos os macanismos anteriores aplicados juntos.

ggplot(dados, aes(x = satisfaction)) +
  geom_histogram(binwidth = .2) + 
  facet_wrap(~ scenario) +
  labs(x = "Satisfação", y = "Quantidade", title = "Nível de satisfação em cada mecanismo")

Aqui podemos ver que up/downvoting é o mecanismo com os melhores níveis de satisfação, obtendo apenas valores de 4 para cima, então vamos usá-lo como padrão para comparar com os outros mecanismo.

Comparação por IC’s

Up/Downvoting x Like/Dislike

comparacao1 = dados %>% 
    filter(scenario %in% c("like/dislike", "up/downvoting"))

theta1 <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    l = agrupado %>% filter(scenario == "like/dislike") %>% pull(media)
    u = agrupado %>% filter(scenario == "up/downvoting") %>% pull(media)
    u - l
}

theta1(comparacao1, i = 1:NROW(comparacao1))

## [1] 0.7391304

ci1 = boot(data = comparacao1,
           statistic = theta1,
           R = 2000) %>%
    tidy(conf.level = .95,
         conf.method = "bca",
         conf.int = TRUE)

ci1

## # A tibble: 1 x 5
##   statistic     bias std.error conf.low conf.high
##       <dbl>    <dbl>     <dbl>    <dbl>     <dbl>
## 1     0.739 -0.00847     0.148    0.462      1.03

ggplot(ci1, mapping = aes(
        x = "Like/dislike x Up/Downvoting",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "Comparação", 
         y = "Diferença")

Com 95% de confiança, um IC [0.4606018, 1.033967], uma margem de erro de 14% e uma diferença de médias de 0.7391304, por este último sendo maior que zero, podemos concluir que o mecanismo de Up/Downvoting agrada mais que o Like/Dislike.

Baseline x Up/Downvoting

comparacao2 = dados %>% 
    filter(scenario %in% c("baseline", "up/downvoting"))

theta2 <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    b = agrupado %>% filter(scenario == "baseline") %>% pull(media)
    u = agrupado %>% filter(scenario == "up/downvoting") %>% pull(media)
    u - b
}

theta2(comparacao2, i = 1:NROW(comparacao2))

## [1] 2.26087

ci2 = boot(data = comparacao2,
           statistic = theta2,
           R = 2000) %>%
    tidy(conf.level = .95,
         conf.method = "bca",
         conf.int = TRUE)

ci2

## # A tibble: 1 x 5
##   statistic     bias std.error conf.low conf.high
##       <dbl>    <dbl>     <dbl>    <dbl>     <dbl>
## 1      2.26 -0.00350     0.161     1.94      2.57

ggplot(ci2, mapping = aes(
        x = "Baseline x Up/Downvoting",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "Comparação", 
         y = "Diferença")

Com 95% de confiança, um IC [1.952855, 2.586957], uma margem de erro de 16% e uma diferença de médias de 2.26087, por este último sendo maior que zero, podemos concluir que o mecanismo de Up/Downvoting agrada mais que o Baseline.

Up/Downvoting x Skip

comparacao3 = dados %>% 
    filter(scenario %in% c("skip", "up/downvoting"))

theta3 <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    s = agrupado %>% filter(scenario == "skip") %>% pull(media)
    u = agrupado %>% filter(scenario == "up/downvoting") %>% pull(media)
    u - s
}

theta3(comparacao3, i = 1:NROW(comparacao3))

## [1] 1.869565

ci3 = boot(data = comparacao3,
           statistic = theta3,
           R = 2000) %>%
    tidy(conf.level = .95,
         conf.method = "bca",
         conf.int = TRUE)

ci3

## # A tibble: 1 x 5
##   statistic      bias std.error conf.low conf.high
##       <dbl>     <dbl>     <dbl>    <dbl>     <dbl>
## 1      1.87 -0.000141     0.143     1.61      2.19

ggplot(ci3, mapping = aes(
        x = "Skip x Up/Downvoting",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "Comparação", 
         y = "Diferença")

Com 95% de confiança, um IC [1.598308, 2.165164], uma margem de erro de 14% e uma diferença de médias de 1.869565, por este último sendo maior que zero, podemos concluir que o mecanismo de Up/Downvoting agrada mais que o Skip.

Up/Downvoting x Combined

comparacao4 = dados %>% 
    filter(scenario %in% c("combined", "up/downvoting"))

theta4 <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    c = agrupado %>% filter(scenario == "combined") %>% pull(media)
    u = agrupado %>% filter(scenario == "up/downvoting") %>% pull(media)
    u - c
}

theta4(comparacao4, i = 1:NROW(comparacao4))

## [1] 0.3478261

ci4 = boot(data = comparacao4,
           statistic = theta4,
           R = 2000) %>%
    tidy(conf.level = .95,
         conf.method = "bca",
         conf.int = TRUE)

ci4

## # A tibble: 1 x 5
##   statistic    bias std.error conf.low conf.high
##       <dbl>   <dbl>     <dbl>    <dbl>     <dbl>
## 1     0.348 0.00271     0.142   0.0870     0.646

ggplot(ci4, mapping = aes(
        x = "Combined x Up/Downvoting",
        y = statistic,
        ymin = conf.low,
        ymax = conf.high
    )) +
    geom_pointrange() +
    geom_point(size = 3) + 
    labs(x = "Comparação", 
         y = "Diferença")

Com 95% de confiança, um IC [0.07673497, 0.6504036], uma margem de erro de 14% e uma diferença de médias de 0.3478261, por este último sendo maior que zero, podemos concluir que o mecanismo de Up/Downvoting agrada mais que o Combined.

O mecanismo combined teve uma diferença de médias muito baixa em relação ao up/downvoting, logo não podemos afirmar que o up/downvoting é melhor, porém em relação ao mecanismo like/dislike, o up/downvoting se sai como melhor, pois a diferença de médias é moderada, próximo de 1. Quanto ao baseline e o skip em relação ao up/downvoting, podemos afirmar que o mecanismo up/downvoting definitivamente é melhor que esses dois pois as diferenças de média foram maiores que 1.

Teste de Hipóteses

Após calcular os IC’s, vamos utilizar testes de hipóteses (TH) para estimar a diferença da média da satisfação entre o up/downvoting e todos os outros mecanismos.

theta_chapeu representa a diferença da média da sastifação entre os mecanismos. Vamos calcular uma reamostragem para obter as diferenças das médias nos dados e a partir disso iremos criar uma hipótese nula que poderá ou não ser rejetada.

Aqui, H0 (hipótese nula) é se a diferença da média da sastifação entre os mecanismos não é o valor do theta_chapeu e a H1 é se a diferença da média da satisfação entre os mecanismos é o valor de theta_chapeu.

Caso 1 - Up/Downvoting x Like/Dislike

comparacao1_TH = dados %>% 
    filter(scenario %in% c("up/downvoting", "like/dislike"))

theta_chapeu1 = {
    satisfacoes = comparacao1_TH %>% 
        group_by(scenario) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    
    like = satisfacoes %>% filter(scenario == "like/dislike") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
    
    up - like
}

theta_chapeu1

## [1] 0.7391304

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

theta_emb1(comparacao1_TH)

## [1] 0.08695652

diffs1 = replicate(4000, {theta_emb1(dados)})

tibble(diferenca = diffs1) %>% 
  ggplot(aes(x = diferenca)) + 
  geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    # geom_density(fill = "white", color = "darkgreen") + 
  geom_vline(xintercept = theta_chapeu1, 
             color = "orange") + 
    geom_vline(xintercept = -theta_chapeu1, 
             color = "orange")

sum(abs(diffs1) >= abs(theta_chapeu1)) / length(diffs1)

## [1] 0.017

Caso 2 - Up/Downvoting x Baseline

comparacao2_TH = dados %>% 
    filter(scenario %in% c("up/downvoting", "baseline"))

theta_chapeu2 = {
    satisfacoes = comparacao2_TH %>% 
        group_by(scenario) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    
    base = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
    
    up - base
}

theta_chapeu2

## [1] 2.26087

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

theta_emb2(comparacao2_TH)

## [1] 0.7826087

diffs2 = replicate(4000, {theta_emb2(dados)})

tibble(diferenca = diffs2) %>% 
  ggplot(aes(x = diferenca)) + 
  geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    # geom_density(fill = "white", color = "darkgreen") + 
  geom_vline(xintercept = theta_chapeu2, 
             color = "orange") + 
    geom_vline(xintercept = -theta_chapeu2, 
             color = "orange")

sum(abs(diffs2) >= abs(theta_chapeu2)) / length(diffs2)

## [1] 0

Caso 3 - Up/Downvoting x Skip

comparacao3_TH = dados %>% 
    filter(scenario %in% c("up/downvoting", "skip"))

theta_chapeu3 = {
    satisfacoes = comparacao3_TH %>% 
        group_by(scenario) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    
    skip = satisfacoes %>% filter(scenario == "skip") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
    
    up - skip
}

theta_chapeu3

## [1] 1.869565

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

theta_emb3(comparacao3_TH)

## [1] 0.4347826

diffs3 = replicate(4000, {theta_emb3(dados)})

tibble(diferenca = diffs3) %>% 
  ggplot(aes(x = diferenca)) + 
  geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    # geom_density(fill = "white", color = "darkgreen") + 
  geom_vline(xintercept = theta_chapeu3, 
             color = "orange") + 
    geom_vline(xintercept = -theta_chapeu3, 
             color = "orange")

sum(abs(diffs3) >= abs(theta_chapeu3)) / length(diffs3)

## [1] 0

Caso 4 - Up/Downvoting x Combined

comparacao4_TH = dados %>% 
    filter(scenario %in% c("up/downvoting", "combined"))

theta_chapeu4 = {
    satisfacoes = comparacao4_TH %>% 
        group_by(scenario) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    
    comb = satisfacoes %>% filter(scenario == "combined") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
    
    up - comb
}

theta_chapeu4

## [1] 0.3478261

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

theta_emb4(comparacao4_TH)

## [1] 0.3043478

diffs4 = replicate(4000, {theta_emb4(dados)})

tibble(diferenca = diffs4) %>% 
  ggplot(aes(x = diferenca)) + 
  geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    # geom_density(fill = "white", color = "darkgreen") + 
  geom_vline(xintercept = theta_chapeu4, 
             color = "orange") + 
    geom_vline(xintercept = -theta_chapeu4, 
             color = "orange")

sum(abs(diffs4) >= abs(theta_chapeu4)) / length(diffs4)

## [1] 0.27525

Podemos ver que nas comparações entre up/downvoting e combined o valor de theta_chapeu está dentro da distribuição das diferenças das médias, então não pode-se afirmar com certeza que o mecanismo up/downvoting é melhor que combined, logo H0 é aceita no caso 4. Porém o valor de theta_chapeu na comparação entre up/downvoting e like/dislike está bem mais afastado do centro da distribuição do que combined, o que pode indicar que o mecanismo up/downvoting é moderadamente melhor do que like/dislike, mas ainda assim aceita-se H0 no caso 1.

Podemos ver que nas comparações de up/downvoting com baseline e skip os valores de theta_chapeu estão fora da distribuição de diferenças de médias, o que indica que existe uma diferença sigficativa entre os mecanismos, provando que o mecanismo up/downvoting é melhor que os outros dois, sendo assim rejeitamos H0 e aceitamos H1 nos casos 2 e 3.

Conclusão

Utilizandos os dois métodos (IC’s e TH), é visto que o mecanismo de up/downvoting é consideravelmente melhor que os mecanismos de baseline e skip, e moderadamente melhor que o mecanismo like/dislike e inconclusivo em relação ao combined.