Fundamentos de Pesquisa em Ciência da Computação II

Explorando os dados das Sessões, Buscas e Navegação da Wikimedia

No presente relatório é utilizada a exploração de dados do dataset disponibilizado pela Wikimedia Foundation. Nesta atividade buscamos responder duas perguntas por meio dos dados disponibilizados.

Nas seções seguintes são apresentadas as bibliotecas e dados utilizados nas análises, bem como as respostas e análises para as duas perguntas elencadas na atividade.

1. Bibliotecas utilizadas

library(tidyverse)
library(boot)
library(broom)
library(here)
library(lubridate)
library(ggplot2)
library(knitr)
theme_set(theme_bw())

2. Carregando os dados para análise

buscas = read_csv(here::here("data/search_data.csv")) %>%
head(100000) %>%
mutate (clicks = ifelse(num_clicks>0,1,0)) %>%
mutate(is_zero = results == 0)

3. Respostas para as questões

3.1 Qual é a diferença entre o clickthrough rate dos grupos A e B?

- Com teste de hipótese

clicks_rate = buscas %>%
    group_by(session_id, group) %>%
    summarise(click = max(clicks)) %>%
    ungroup()
theta_embaralhado = function(c){
    clicks = c %>%
        mutate(grupo_embaralhado = sample(group, n())) %>%
        group_by(grupo_embaralhado) %>%
        summarise(clickthrough_rate = (sum(click > 0)/n()))
    
    a = clicks %>% filter(grupo_embaralhado == "a") %>% pull(clickthrough_rate)
    b = clicks %>% filter(grupo_embaralhado == "b") %>% pull(clickthrough_rate)
    
    a-b
}
theta_embaralhado(clicks_rate)

[1] -0.002081456

theta_diferenca_grupo = function(d, i){
    clicks = d %>%
        slice(i) %>%
        group_by(group) %>%
        summarise(clickthrough_rate = (sum(click > 0)/n()))
    
    a = clicks %>% filter(group == "a") %>% pull(clickthrough_rate)
    b = clicks %>% filter(group == "b") %>% pull(clickthrough_rate)
    
    a-b
}
theta_diferenca_grupo(clicks_rate, 1:NROW(clicks_rate))

[1] 0.4970487

Gráfico

diffs1 = replicate(5000, {theta_embaralhado(clicks_rate)})
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_diferenca_grupo(clicks_rate, 1:NROW(clicks_rate)),
            color = "orange") +
    geom_vline(xintercept = - theta_diferenca_grupo(clicks_rate, 1:NROW(clicks_rate)),
            color = "orange") +
    geom_rug()

P-valor

mean(abs(diffs1) >= abs(theta_diferenca_grupo(clicks_rate, 1:NROW(clicks_rate))))

[1] 0

library(perm)
click_a = clicks_rate %>%
    filter(group == "a") %>%
    mutate(tem_click = as.numeric(click > 0)) %>%
    pull(tem_click)
click_b = clicks_rate %>%
    filter(group == "b") %>%
    mutate(tem_click = as.numeric(click > 0)) %>%
    pull(tem_click)
permTS(click_a, click_b)

    Permutation Test using Asymptotic Approximation

data:  click_a and click_b
Z = 112.4, p-value < 2.2e-16
alternative hypothesis: true mean click_a - mean click_b is not equal to 0
sample estimates:
mean click_a - mean click_b 
                  0.4970487 

- Com intervalo de confiança

clicks_rate %>% 
    boot(statistic = theta_diferenca_grupo, R = 4000) %>% 
    tidy(conf.level = 0.95, 
         conf.int = TRUE)

3.2 Qual é a diferença na proporção buscas com zero resultados nos grupos A e B?

- Com teste de hipótese

results_rate = buscas %>%
    group_by(results, group) %>%
    ungroup()
theta_embaralhado_2 = function(r){
    proportion = r %>%
        mutate(grupo_embaralhado = sample(group, n())) %>%
        group_by(grupo_embaralhado) %>%
        summarise(rate = (sum(is_zero)/n()))
    
    a = proportion %>% filter(grupo_embaralhado == "a") %>% pull(rate)
    b = proportion %>% filter(grupo_embaralhado == "b") %>% pull(rate)
    
    a-b
}
theta_embaralhado_2(results_rate)

[1] 0.0005643033

theta_diferenca_resultados = function(r, i){
    proportion = r %>%
        slice(i) %>%
        group_by(group) %>%
        summarise(rate = (sum(is_zero)/n()))
    
    a = proportion %>% filter(group == "a") %>% pull(rate)
    b = proportion %>% filter(group == "b") %>% pull(rate)
    
    a-b
}
theta_diferenca_resultados(results_rate, 1:NROW(results_rate))

[1] -0.003930332

Gráfico

diffs2 = replicate(5000, {theta_embaralhado_2(results_rate)})
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_diferenca_resultados(results_rate, 1:NROW(results_rate)),
            color = "orange") +
    geom_vline(xintercept = - theta_diferenca_resultados(results_rate, 1:NROW(results_rate)),
            color = "orange") +
    geom_rug()

P-valor

mean(abs(diffs2) >= abs(theta_diferenca_resultados(results_rate, 1:NROW(results_rate))))

[1] 0.1338

library(perm)
results_a = results_rate %>%
    filter(group == "a") %>%
    mutate(zero_result = as.numeric(is_zero == 0)) %>%
    pull(zero_result)
results_b = results_rate %>%
    filter(group == "b") %>%
    mutate(zero_result = as.numeric(is_zero == 0)) %>%
    pull(zero_result)
permTS(results_a, results_b)

    Permutation Test using Asymptotic Approximation

data:  results_a and results_b
Z = 1.4922, p-value = 0.1356
alternative hypothesis: true mean results_a - mean results_b is not equal to 0
sample estimates:
mean results_a - mean results_b 
                    0.003930332 

- Com intervalo de confiança

results_rate %>% 
    boot(statistic = theta_diferenca_resultados, R = 4000) %>% 
    tidy(conf.level = 0.95, 
         conf.int = TRUE)