## Rows: 115
## Columns: 4
## $ user_id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1…
## $ 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 <dbl> 3, 1, 2, 2, 1, 1, 3, 3, 2, 1, 3, 2, 3, 1, 3, 1, 1, 3, 3,…
Os dados analisados foram retirados desse artigo, onde foi disponibilizado um aplicativo de reprodução de músicas a vários grupos de pessoas, e com ele, várias formas de seleção das músicas, de modo que a próxima música sempre agradasse a maior quantidade de pessoas. Houveram vários testes com cenários diferentes: o cenário sem nenhuma forma de seleção é chamado de baseline. Existem também o up/down, que visa subir ou descer uma música de acordo com a vontade de cada usuário; like/deslike que busca selecionar uma música por meio de like ou deslike; skip que permite o usuário passar a música; combined que uniu todos os outros cenários.
Observe os números entrevistados:
comparacao %>%
summarise('quantidade de grupos entrevistados' = n(),
'quantidade de pessoas entrevistadas' = sum(group))
comparacao %>%
ggplot(aes(x = satisfaction)) +
geom_histogram(binwidth = .8,
boundary = 0,
color = "brown") +
facet_wrap(~ scenario)
comparacao %>%
group_by(scenario) %>%
summarise(media = sum(satisfaction)/n(),
mediana = median(satisfaction),
'dp' = sd(satisfaction)) %>%
arrange(-media)
Percebe-se que há dois candidatos a melhor mecanismo de “ranqueamento”, pois o método de “subir ou descer” uma música na ordem, e o método que reúne todos os outros juntos, mostram as duas maiores médias, e duas das maiores medianas.
Compare os demais métodos com o baseline considerando as seguintes classificações:
Diferença entre \(\theta\):
Analisando inicialmente o \(\theta\) do baseline com os outros, vê-se:
exibe_diferenca_bootstraps = function (df, qnt, func) {#Função que exibe a diferença de thetas_c
bootstraps =
df %>%
boot(statistic = func, R = qnt) %>%
tidy(conf.level = 0.95,
conf.int = TRUE)
bootstraps
}
theta_dif_satisfacao = function(df, i) {
satisfacoes = df %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
baseline = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
skip = satisfacoes %>% filter(scenario == "skip" ) %>% pull(satisfacao)
baseline - skip
}
exibe = exibe_diferenca_bootstraps(comparacao, 4000, theta_dif_satisfacao)
theta_dif = exibe %>% pull(statistic)
exibe %>%
ggplot() +
geom_rect(aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "red",
alpha = 0.1) +
geom_vline(xintercept = theta_dif) +
labs(x = "Diferença",
subtitle = "Linha =" ~ theta ~ "estimado Vermelho = Margem de erro")
theta_dif_satisfacao = function(df, i) {
satisfacoes = df %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
baseline = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
joinha = satisfacoes %>% filter(scenario == "like/dislike" ) %>% pull(satisfacao)
baseline - joinha
}
exibe = exibe_diferenca_bootstraps(comparacao, 4000, theta_dif_satisfacao)
theta_dif = exibe %>% pull(statistic)
exibe %>%
ggplot() +
geom_rect(aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "red",
alpha = 0.1) +
geom_vline(xintercept = theta_dif) +
labs(x = "Diferença",
subtitle = "Linha =" ~ theta ~ "estimado Vermelho = Margem de erro")
theta_dif_satisfacao = function(df, i) {
satisfacoes = df %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
baseline = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
combined = satisfacoes %>% filter(scenario == "combined" ) %>% pull(satisfacao)
baseline - combined
}
exibe = exibe_diferenca_bootstraps(comparacao, 4000, theta_dif_satisfacao)
theta_dif = exibe %>% pull(statistic)
exibe %>%
ggplot() +
geom_rect(aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "red",
alpha = 0.1) +
geom_vline(xintercept = theta_dif) +
labs(x = "Diferença",
subtitle = "Linha =" ~ theta ~ "estimado Vermelho = Margem de erro")
theta_dif_satisfacao = function(df, i) {
satisfacoes = df %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
baseline = satisfacoes %>% filter(scenario == "baseline") %>% pull(satisfacao)
updown = satisfacoes %>% filter(scenario == "up/downvoting" ) %>% pull(satisfacao)
baseline - updown
}
exibe = exibe_diferenca_bootstraps(comparacao, 4000, theta_dif_satisfacao)
theta_dif = exibe %>% pull(statistic)
exibe %>%
ggplot() +
geom_rect(aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "red",
alpha = 0.1) +
geom_vline(xintercept = theta_dif) +
labs(x = "Diferença",
subtitle = "Linha =" ~ theta ~ "estimado Vermelho = Margem de erro")
Tendo em vista que o baseline, de acordo com os gráficos de diferença de \(\theta\) aproximado, foi o pior cenário, serão escolhidos 2 dos melhores cenários do teste, de modo a simplificar a análise.
calcula_theta_updown = function(df, i) {
satisfacao = comparacao %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
satisfacao %>%
filter(scenario == "up/downvoting") %>%
pull(satisfacao)
}
updown_boot = comparacao %>%
boot(statistic = calcula_theta_updown, R = 4000) %>%
tidy(conf.level = 0.95,
conf.int = TRUE)
updown_boot
calcula_theta_combined = function(df, i) {
satisfacao = comparacao %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
satisfacao %>%
filter(scenario == "combined") %>%
pull(satisfacao)
}
combined_boot = comparacao %>%
boot(statistic = calcula_theta_combined, R = 4000) %>%
tidy(conf.level = 0.95,
conf.int = TRUE)
combined_boot
Agora, observe a comparação dos dois cenários.
updown_theta = updown_boot %>% pull(statistic)
combined_theta = combined_boot %>% pull(statistic)
ggplot() +
geom_rect(data = combined_boot,
aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "red",
alpha = 0.1) +
geom_rect(data = updown_boot,
aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "lightblue",
alpha = 0.2) +
geom_vline(xintercept = combined_theta, color = "blue") +
geom_vline(xintercept = updown_theta) +
labs(title = "Comparação dos intervalos de confiança e " ~ theta,
x = ~ theta,
subtitle = "Linha preta :" ~ theta ~ "updown voting Linha azul:" ~ theta ~ "combined voting")
Vê-se que o theta do updown voting é aproximadamente 0.03 pontos maior que o theta do combined voting.
theta_dif_satisfacao = function(df, i) {
satisfacoes = df %>%
slice(i) %>%
group_by(scenario) %>%
summarise(satisfacao = mean(satisfaction))
updown = satisfacoes %>% filter(scenario == "up/downvoting") %>% pull(satisfacao)
combined = satisfacoes %>% filter(scenario == "combined" ) %>% pull(satisfacao)
updown - combined
}
bootstraps =
comparacao %>%
boot(statistic = theta_dif_satisfacao, R = 8000) %>%
tidy(conf.level = 0.95,
conf.int = TRUE)
bootstraps
A análise utilizando bootstraps nos mostra que não há um viés muito forte para a diferença do \(\theta\) dos dois cenários, e possui uma regular margem de erro.
theta_dif = bootstraps %>% pull(statistic)
bootstraps %>%
ggplot() +
geom_rect(aes(xmin = conf.low, xmax = conf.high),
ymin = -Inf,
ymax = Inf,
fill = "lightblue",
alpha = .2) +
geom_vline(xintercept = theta_dif) +
labs(x = "Diferença de" ~ theta,
y = "",
title = theta ~ "e o seu intervalo de erro")
Nesse gráfico observa-se que a diferença da satisfação dos usuários no uso de votos combinados, e de votos up/down não possui uma grande diferença, porém positiva, com 95% de confiança, o \(\theta\) da diferença fica entre 0.03 e 0.4, um intervalo de confiança baixo. Então, conclui-se que:
- Ambos os métodos são ótimos se comparados com o baseline (método padrão).
- O $\theta$ estimado e o intervalo de confiança do método *up/down* são maiores que o método *combinado*.
- A diferença dos dois métodos é baixa, e positiva.
Ou seja, dando ênfase aos maiores custos de implementação do combined voting, e considerando a maior satisfação dos usuários, o up/down voting aparenta ser o melhor mecanismo de “ranqueamento” e seleção de músicas.