Experimento com jukeboxes

Dados

Antes de começarmos o experimento, é ncessário que se faça uma análise descritiva dos dados, sendo assim será analisado a distribuição da variável satisfação para cada um dos mecanismos.

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", …
## $ satisfaction <dbl> 2.0, 3.0, 1.5, 1.0, 2.0, 2.5, 2.0, 3.0, 2.0, 2.0, 2…
## $ scenario     <chr> "baseline", "baseline", "baseline", "baseline", "ba…
## $ group        <chr> "3", "1", "2", "2", "1", "1", "3", "3", "2", "1", "…

dados %>% 
    ggplot(mapping = aes(x = scenario, y = satisfaction)) + 
    geom_boxplot(color = "red") + 
    geom_quasirandom() + 
    labs(x = "Cenário", y = "Satisfação", title = "Visão Geral dos dados Cenário x Satisfação") + 
    theme(plot.title = element_text(hjust = 0.5))

Observando o gráfico acima, nota-se que os mecanismos combined, like/dislike e principalmente up/downvoting apresentam um nível de satisfação maior. Destaca-se a concentração elevada no nível de satisfação 4 no combined, no entanto, há uma variação elevada pois concentra dados entre 2,5 até 5. Além disso, uma observação a ser feita é que no mecanismo de baseline concentra-se os piores níveis de satisfação.

Intervalos de Confiança

Seguindo adiante com o experimento, primeiro vamos calcular o intervalo de confiança com 95% de confiança utilizando o bootstrap implementado da bilbioteca para que assim possamos concluir qual o mecanismo que obteve o melhor desempenho.

theta <- function(df, i) {
    x <- df %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    c_baseline = x %>% 
        filter(scenario == "baseline") %>% 
        pull(media)
    c_like = x %>% 
        filter(scenario == "like/dislike") %>% 
        pull(media)
    c_skip = x %>% 
        filter(scenario == "skip") %>% 
        pull(media)
    c_combined = x %>% 
        filter(scenario == "combined") %>% 
        pull(media)
    c_up = x %>% 
        filter(scenario == "up/downvoting") %>% 
        pull(media)
    c(c_baseline, c_like, c_skip, c_combined, c_up)
}

theta(dados, i = 1:NROW(dados))

## [1] 2.130435 3.652174 2.521739 4.043478 4.391304

repeticoes = 4000
intervalo <- boot(data = dados,
               statistic = theta,
               R = repeticoes) %>% 
    tidy(conf.level = 0.95,
         conf.method = "bca",
         conf.int = TRUE)
intervalo$scenario = c("baseline", "like/dislike", "skip", "combined", "up/downvoting")
intervalo

## # A tibble: 5 x 6
##   statistic      bias std.error conf.low conf.high scenario     
##       <dbl>     <dbl>     <dbl>    <dbl>     <dbl> <chr>        
## 1      2.13 -0.00301     0.135      1.87      2.40 baseline     
## 2      3.65 -0.000199    0.114      3.43      3.88 like/dislike 
## 3      2.52  0.00331     0.107      2.29      2.71 skip         
## 4      4.04 -0.00346     0.111      3.82      4.25 combined     
## 5      4.39  0.000298    0.0928     4.22      4.58 up/downvoting

Após o cálculo dos intervalos de confianca, temos os seguintes resultados:

Baseline - (Média - 2.130435 | IC - [1.857143, 2.400000])
Like/Dislike - (Média - 3.652174 | IC - [3.420000, 3.875000])
Skip - (Média - 2.521739 | IC - [2.293852, 2.711538])
Combined - (Média - 4.043478 | IC - [3.812500, 4.250000])
Up/Downvoting - (Média - 4.391304 | IC - [4.217391, 4.578947])

Tendo em vista os resultados acima, plotaremos um gráfico para visualizar melhor os dados e assim concluirmos com mais assertividade.

intervalo %>% 
    ggplot(mapping = aes(x = reorder(scenario, statistic), y = statistic)) + 
    geom_point(size = 3) +
    geom_errorbar(mapping = aes(ymax = conf.high, ymin = conf.low)) +
    labs(x = "Cenário",
         y = "Satisfação",
         title = "Intervalos de confiança Cenário x Satisfação") + 
    theme(plot.title = element_text(hjust = 0.5))

Analisando o gráfico e os resultados acima, podemos afirmar que o mecanismo mais bem avaliado é o de up/downvoting. No entanto, os intervalos entre up/downvoting e combined estão sobrepostos, ou seja, o máximo do intervalo de combined é maior que o mínimo do intervalo de up/downvoting, a mesma coisa acontece com combined e like/dislike e skip e baseline. Tendo em vista esses acontecimentos, será necessário calcular a diferença entre esses mecanismos para assim concluirmos qual o mecanismo que tem a melhor avaliação. Como o up/downvoting foi o mecanismo melhor avaliado, iremos calcular a diferença do seu intervalo de confiança com 95% de confiança e os outros mecanismos.

thetaDiferenca <- function(df, i) {
    x <- df %>% 
        slice(i) %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    c_baseline = x %>% 
        filter(scenario == "baseline") %>% 
        pull(media)
    c_like = x %>% 
        filter(scenario == "like/dislike") %>% 
        pull(media)
    c_skip = x %>% 
        filter(scenario == "skip") %>% 
        pull(media)
    c_combined = x %>% 
        filter(scenario == "combined") %>% 
        pull(media)
    c_up = x %>% 
        filter(scenario == "up/downvoting") %>% 
        pull(media)
    
    c(c_up - c_baseline, c_up - c_like, c_up - c_skip, c_up - c_combined)
}

thetaDiferenca(dados, i = 1:NROW(dados))

## [1] 2.2608696 0.7391304 1.8695652 0.3478261

intervaloDiferenca = boot(data = dados,
                          statistic = thetaDiferenca,
                          R = repeticoes) %>% 
    tidy(conf.level = 0.95,
         conf.method = "bca",
         conf.int = TRUE)

intervaloDiferenca$scenario = c("up/downvoting - baseline", "up/downvoting - like/dislike", "up/downvoting - skip", "up/downvoting - combined")

intervaloDiferenca

## # A tibble: 4 x 6
##   statistic     bias std.error conf.low conf.high scenario                 
##       <dbl>    <dbl>     <dbl>    <dbl>     <dbl> <chr>                    
## 1     2.26   0.00104     0.165   1.94       2.60  up/downvoting - baseline 
## 2     0.739 -0.00180     0.152   0.435      1.04  up/downvoting - like/dis…
## 3     1.87  -0.00407     0.142   1.60       2.17  up/downvoting - skip     
## 4     0.348 -0.00260     0.147   0.0708     0.658 up/downvoting - combined

Após o cálculo da diferença entre os intervalos de confianca, temos os seguintes resultados:

Up/Downvoting - Baseline: (Diferença - 2.2608696 | IC - [1.9415791, 2.5901985])
Up/Downvoting - Like/Dislike: (Diferença - 0.7391304 | IC - [0.4594549, 1.0282692])
Up/Downvoting - Skip: (Diferença - 1.8695652 | IC - [1.6010166, 2.1499236])
Up/Downvoting - Combined: (Diferença - 0.3478261 | IC - [0.1464959, 0.0748694])

Deixando os dados visualizáveis para auxiliar na análise realizada, temos:

intervaloDiferenca %>% 
    ggplot(mapping = aes(x = reorder(scenario, statistic), y = statistic)) + 
    geom_point(size = 3) + 
    geom_errorbar(mapping = aes(ymax = conf.high, ymin = conf.low)) + 
    labs(x = "Cenário",
         y = "Satisfação",
         title = "Intervalos de confiança Cenário x Satisfação (diferença)") + 
     theme(plot.title = element_text(hjust = 0.5))

Observando os resultados expostos e o gráfico acima podemos concluir que a diferença entre os intervlos de up/downvoting e combined é bem pequena (0.3478261), assim como falamos anteriormente. Sendo assim, não podemos afirmar com confiançå que o up/downvoting é mais bem avaliado que o combined. Em relação aos outros mecanismos, a menor diferença é com o like/dislike (0.7391304), no entanto o número está próximo a 1, por isso podemos classificar como uma diferença média, e entre os outros mecanismos a diferença é maior que 2, então é uma diferença alta. Por fim, podemos afirmar que o up/downvoting foi melhor avaliado que todos os mecanismos, com exceção do combined, pois a diferença foi pequena e não podemos afirmar nada com confiança.

Teste de Hipótese

Após fazer a análise utilizando intervalos de confiança, agora faremos praticamente a mesma coisa, mas utilizando a métrica de teste de hipótese para concluirmos qual mecanismo é melhor avaliado.

Terá que ser calculado o theta chapéu para rejeitarmos ou não a hipótese nula (H0), levando em conta os seus resultados. A hipótese nula é se a diferença da média de satisfação entre os mecanismos não é igual ao valor do theta chapéu. Para isso, temos:

Theta Chapéu:

thetaChapeu = {
    x <- dados %>% 
        group_by(scenario) %>% 
        summarise(media = mean(satisfaction))
    
    c_baseline = x %>% 
        filter(scenario == "baseline") %>% 
        pull(media)
    c_like = x %>% 
        filter(scenario == "like/dislike") %>% 
        pull(media)
    c_skip = x %>% 
        filter(scenario == "skip") %>% 
        pull(media)
    c_combined = x %>% 
        filter(scenario == "combined") %>% 
        pull(media)
    c_up = x %>% 
        filter(scenario == "up/downvoting") %>% 
        pull(media)
    c(c_up - c_baseline, c_up - c_like, c_up - c_skip, c_up - c_combined)
        
}

thetaChapeu

## [1] 2.2608696 0.7391304 1.8695652 0.3478261

comparacoes <- data.frame("Comparacao/Mecanismos" = c("up/downvoting - baseline", "up/downvoting - like/dislike", "up/downvoting - skip", "up/downvoting - combined "), "Theta Chapeu" = thetaChapeu)

comparacoes

##          Comparacao.Mecanismos Theta.Chapeu
## 1     up/downvoting - baseline    2.2608696
## 2 up/downvoting - like/dislike    0.7391304
## 3         up/downvoting - skip    1.8695652
## 4    up/downvoting - combined     0.3478261

Reamostragem:

thetaBaseline <- function(df) {
    x <- df %>% 
        mutate(cenarioEmbaralhado = sample(scenario, n())) %>% 
        group_by(cenarioEmbaralhado) %>% 
        summarise(media = mean(satisfaction))
    baseline = x %>% 
        filter(cenarioEmbaralhado == "baseline") %>% 
        pull(media)
    up = x %>% 
        filter(cenarioEmbaralhado == "up/downvoting") %>% 
        pull(media)
    up-baseline
}

thetaLike <- function(df) {
    x <- df %>% 
        mutate(cenarioEmbaralhado = sample(scenario, n())) %>% 
        group_by(cenarioEmbaralhado) %>% 
        summarise(media = mean(satisfaction))
    like = x %>% 
        filter(cenarioEmbaralhado == "like/dislike") %>% 
        pull(media)
    up = x %>% 
        filter(cenarioEmbaralhado == "up/downvoting") %>% 
        pull(media)
    up-like
}

thetaSkip <- function(df) {
    x <- df %>% 
        mutate(cenarioEmbaralhado = sample(scenario, n())) %>% 
        group_by(cenarioEmbaralhado) %>% 
        summarise(media = mean(satisfaction))
    skip = x %>% 
        filter(cenarioEmbaralhado == "skip") %>% 
        pull(media)
    up = x %>% 
        filter(cenarioEmbaralhado == "up/downvoting") %>% 
        pull(media)
    up-skip
}

thetaCombined <- function(df) {
    x <- df %>% 
        mutate(cenarioEmbaralhado = sample(scenario, n())) %>% 
        group_by(cenarioEmbaralhado) %>% 
        summarise(media = mean(satisfaction))
    combined = x %>% 
        filter(cenarioEmbaralhado == "combined") %>% 
        pull(media)
    up = x %>% 
        filter(cenarioEmbaralhado == "up/downvoting") %>% 
        pull(media)
    up-combined
        
}

comparacaoBaseline = replicate(repeticoes, {thetaBaseline(dados)})
comparacaoLike = replicate(repeticoes, {thetaLike(dados)})
comparacaoSkip = replicate(repeticoes, {thetaSkip(dados)})
comparacaoCombined = replicate(repeticoes, {thetaCombined(dados)})

comparacao_b <- tibble(comparacao = comparacaoBaseline) %>% 
    ggplot(mapping = aes(x = comparacao)) +
    geom_histogram(binwidth = 0.3, fill = "white", color = "darkblue") +
    geom_vline(xintercept = thetaChapeu[1], color = "darkred") +
    geom_vline(xintercept = -thetaChapeu[1], color = "darkred") +
    labs(title = "Up/Downvoting - Baseline") + 
    theme(plot.title = element_text(hjust = 0.5))

comparacao_l <- tibble(comparacao = comparacaoLike) %>% 
    ggplot(mapping = aes(x = comparacao)) +
    geom_histogram(binwidth = 0.3, fill = "white", color = "darkblue") +
    geom_vline(xintercept = thetaChapeu[2], color = "darkred") + 
    geom_vline(xintercept = -thetaChapeu[2], color = "darkred") + 
    labs(title = "Up/Downvoting - Like/Dislike") + 
    theme(plot.title = element_text(hjust = 0.5))

comparacao_s <- tibble(comparacao = comparacaoSkip) %>% 
    ggplot(mapping = aes(x = comparacao)) + 
    geom_histogram(binwidth = 0.3, fill = "white", color = "darkblue") + 
    geom_vline(xintercept = thetaChapeu[3], color = "darkred") +
    geom_vline(xintercept = -thetaChapeu[3], color = "darkred") + 
    labs(title = "Up/Downvoting - Skip") + 
    theme(plot.title = element_text(hjust = 0.5))

comparacao_c <- tibble(comparacao = comparacaoCombined) %>% 
    ggplot(mapping = aes(x = comparacao)) + 
    geom_histogram(binwidth = 0.3, fill = "white", color = "darkblue") + 
    geom_vline(xintercept = thetaChapeu[4], color = "darkred") + 
    geom_vline(xintercept = -thetaChapeu[4], color = "darkred") + 
    labs(title = "Up/Downvoting - Combined") + 
    theme(plot.title = element_text(hjust = 0.5))

grid.arrange(comparacao_b, comparacao_l, comparacao_s, comparacao_c)

Analisando os resultados obtidos e o gráfico acima, visualizamos que a diferença entre up/downvoting e os mecanismos combined e skip tem o Theta Chapéu dentro da distribuição das diferenças dos dados. Desse modo, não podemos rejeitar a hipótese nula e também não podemos afirmar que existe uma diferença significativa entre as variáveis, devido ao fato de que não podemos afirmar com confiança qual o valor da diferença entre os mecanismos. No entanto, em relação aos mecanismos de baseline e like/dislike, o valor do Theta Chapéu está fora da distribuição das diferenças. Sendo assim, podemos rejeitar H0 e afirmar que existe uma diferença significativa entre essas variáveis e o mecanismo up/downvoting.

Por fim, analisando os dois experimentos realizados, podemos afirmar que não podemos afirmar com confiança que existe uma diferença significativa entre o mecanismo de up/downvoting e os mecanismos de combined e skip utilizando a análise de teste de hipótese. No entanto, vimos que no experimento de intervalo de confiança foi obtido um resultado próximo a 1 em relação ao mecanismo skip, e baseando-se nisso podemos afirmar que há uma diferença moderada entre as variáveis, já no mecanismo de combined temos a mesma situação, pois o resultado foi bem próximo de 0. Em relação aos mecanismos de baseline e like/dislike nos dois experimentos foi concluído que há uma diferenca significativa entre o up/downvoting e os mecanismos like/dislike e baseline. Finalmente, podemos afirmar que os mecanismos que tem as melhores satisfações são: up/downvoting e combined.

Analisando o mecanismo com melhor desempenho

Experimento com jukeboxes

Dados

Intervalos de Confiança

Teste de Hipótese