Comparando mecanismos para jukebox sociais

Os dados

Os dados fazem parte de um trabalho sobre mecanismos para jukebox sociais. As jukebox sociais são sites onde as pessoas podem ouvir música em conjunto, cada pessoa do grupo tem a chance de colocar uma música na fila, e assim todo mundo consegue ouvir ao mesmo tempo. Além disso, existem mecanismos que possbilitam os usuário dar um feedback sobre a música do momento, os mecanismos disponíveis são: baseline, up/downvoting,like/dislike, skip e combined. Os usuário avaliaram esses mecanismos.

Sabendo disso vamos avaliar/comparar os mecanismos baseline, up/downvoting e like/dislike e ver qual deles foi mais bem recebido pelos usuários.

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", "…

Intervalos de Confiança.

Para avaliar os mecanismos citados, vamos estimar a média das avaliações dos usuários.

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

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

 tb <- data.frame(theta = theta(comparacao1, i = 1:NROW(comparacao1)))
 tb %>% kable(align = 'c') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'responsive'))

theta
2.130435
3.652174
4.391304

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

ci1$scenario = c("baseline", "like/dislike","up/downvoting")

ci1 %>% kable(align = 'c') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'responsive'))

statistic	bias	std.error	conf.low	conf.high	scenario
2.130435	-0.0035371	0.1318291	1.875000	2.400000	baseline
3.652174	0.0014584	0.1137576	3.428571	3.888276	like/dislike
4.391304	-0.0020848	0.0925979	4.229167	4.588235	up/downvoting

Visualizando

p <- ggplot(ci1, aes(x=scenario, y=statistic)) + 
  geom_boxplot()

p+ geom_dotplot(binaxis='y', stackdir='center', dotsize=1) +
    geom_errorbar(aes(ymax = conf.high, ymin = conf.low)) 

## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

O mecanismo mais bem avaliado é o up/downvoting

Como só estamos avaliando 3 mecanismos, vamos tentar estrimar a diferença de médias entre os 2 aparentemente menos populares com o mais bem avaliaso, o up/downvoting, assim saberemos se a diferença é significativa ou não.

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

ci_dif = boot(data = comparacao1,
           statistic = theta_emb,
           R = 4000) %>%
    tidy(conf.level = .95,
         conf.method = "bca",
         conf.int = TRUE)

ci_dif$scenario = c("up/downvoting - baseline",
                    "up/downvoting - like/dislike")
ci_dif %>% kable(align = 'c') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'responsive'))

statistic	bias	std.error	conf.low	conf.high	scenario
2.2608696	0.0025330	0.1629533	1.9400439	2.580532	up/downvoting - baseline
0.7391304	0.0013882	0.1482447	0.4480566	1.035894	up/downvoting - like/dislike

Visualizando novamente

p <- ggplot(ci_dif, aes(x=scenario, y=statistic)) + 
  geom_boxplot()

p+ geom_dotplot(binaxis='y', stackdir='center', dotsize=1) +
    geom_errorbar(aes(ymax = conf.high, ymin = conf.low)) 

## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

Observando a diferença do like/dislike e up/downvoting (0.73913) com IC [ 0.45011670, 1.0288637 ], isto é, moderada. E observando apenas o gráfico, vemos que a diferença com o baseline é bem maior, então podemos dizer que o up/downvotingse destaca nesse caso. ## Testes de Hipotese

theta_chapeu = {
    satisfacoes = comparacao1 %>% 
        group_by(scenario) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    
    like = satisfacoes %>% filter(scenario == "like/dislike") %>% pull(satisfacao)
    baseline = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
    
    c(up - baseline, up - like)
}

theta_emb_up_like = 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_emb_up_baseline = function(d){
    satisfacoes = d %>% 
        mutate(scenario_embaralhado = sample(scenario, n())) %>% 
        group_by(scenario_embaralhado) %>% 
        summarise(satisfacao = mean(satisfaction)) 
    baseline = satisfacoes %>% filter(scenario_embaralhado == "baseline") %>% pull(satisfacao)
    up = satisfacoes %>% filter(scenario_embaralhado == "up/downvoting") %>% pull(satisfacao)
    up - baseline
}

difuplike = replicate(4000, {theta_emb_up_like(comparacao1)})
difupbase = replicate(4000, {theta_emb_up_baseline(comparacao1)})

Visualizando os testes de hipótese

 tb1 <- data.frame(theta = theta_chapeu)
 tb1 %>% kable(align = 'c') %>% 
  kable_styling(bootstrap_options = c('striped', 'hover', 'responsive'))

theta
2.2608696
0.7391304

pl1 <- tibble(diferenca = difuplike) %>%
    ggplot(aes(x = diferenca)) +
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = theta_chapeu[2], color = "orange") + 
    geom_vline(xintercept = -theta_chapeu[2], color = "orange") +
    labs(title = "Up/Downvoting - Like/Dislike")

pl2 <- tibble(diferenca = difupbase) %>% 
    ggplot(aes(x = diferenca)) + 
    geom_histogram(binwidth = .2, fill = "white", color = "darkgreen") +
    geom_vline(xintercept = theta_chapeu[1], color = "orange") + 
    geom_vline(xintercept = -theta_chapeu[1], color = "orange") +
    labs(title = "Up/Downvoting - Baseline")

grid.arrange(pl2, pl1)

• H0 = diferença da média != theta_chapeu
• H1 = diferença da média = theta_chapeu.

É possível observar que a diferença entre up/downvoting e baseline não está na distribuição (observando as linhas amarelas mostradas na visualização). Assim como na segunda visualização para up/downvoting e like/dislike. Portanto, podemos rejeitar H0 e não rejeitar H1

Conclusão

Há uma diferença que pode ser considerada significativa entre os pares de mecanismos comparados acima. Para os 3 mecanismos analisados, podemos afirmar que o up/downvoting foi o que obteve uma melhor aceitação.