Aluno: Thiago Yuri Evaristo de Souza
Matrícula: 117211156
Para iniciar a analise carregamos o arquivo data/leniency.csv e visualizamos como são nossos dados:
leniency = read_csv(here::here("data/leniency.csv"),
col_types = "cdc")
glimpse(leniency)
## Rows: 136
## Columns: 3
## $ smile <chr> "false smile", "false smile", "false smile", "false smile",…
## $ leniency <dbl> 2.5, 5.5, 6.5, 3.5, 3.0, 3.5, 6.0, 5.0, 4.0, 4.5, 5.0, 5.5,…
## $ with_smile <chr> "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "ye…
Observamos abaixo algumas informações sobre os dados de cada coluna, não há dados faltantes. O valor mínimo e máximo para coluna leniency (índice feito de respostas para 5 perguntas em uma escala de 0 a 9) é de 2 e 9, não houve valor entre 0 a 2.
summary(leniency)
## smile leniency with_smile
## Length:136 Min. :2.000 Length:136
## Class :character 1st Qu.:3.500 Class :character
## Mode :character Median :4.500 Mode :character
## Mean :4.827
## 3rd Qu.:6.000
## Max. :9.000
Abaixamos vemos o comportamento do índice leniency de acordo as colunas with_smile e smile, observamos que há 4 categorias para coluna smile, “false smile”, “felt smile”, “miserable smile” e “no smile (control)”, cada uma com 34 amostras. Já para coluna with_smile há 2 categorias, yes ou no, em que “no” é o caso de “no smile (control)” na coluna smile. Observamos tambem que:
Para with_smile:
Para smile:
leniency %>%
ggplot(aes(x=leniency, y=with_smile)) +
geom_jitter(height = .2, width = 0, alpha = .5, color = "coral") +
labs(
title = "Gráfico de dispersão dos valores de leniency versus with_smile",
y = "with smile"
)
leniency %>%
group_by(with_smile) %>%
count()
leniency %>%
ggplot(aes(x=leniency, y=smile)) +
geom_jitter(height = .2, width = 0, alpha = 0.5, color = "coral") +
labs(
title = "Gráfico de dispersão dos valores de leniency\nversus smile",
y = "smile"
)
leniency %>%
group_by(smile) %>%
count()
Analisando novamente os valores para o smile temos:
Agora vejamos nossas pesquisas …
leniency %>%
ggplot(aes(x=leniency, y=smile, fill = ..x..)) +
geom_density_ridges_gradient(scale = 1, rel_min_height = 0.01) +
scale_fill_viridis(name = "Leniency", option = "C") +
labs(
title = "Gráfico de densidade dos valores de leniency\nversus smile",
y = "smile",
x = ""
)
## Picking joint bandwidth of 0.67
Observemos então como a média da leniency das amostras com sorriso (with_smile = “yes”) menos a média da leniency das amostras sem sorriso (with_smile = “no”). Fazendo boostrap para reamostragem dos dados temos com uma confiança de 95% em que a diferença esperada entre with_smile = yes e with_smile = no é de 0.94 IC [0.37, 1.55]. A uma diferença entre os casos pode ser considerada relevante (> que 0.5) ou representativa (0.3 < diff < 0.5).
s <- function(d, i) {
a = d[i,] %>%
filter(with_smile == "yes") %>%
summarise(mean_leniency_with_smile_yes = mean(leniency)) %>%
pull(mean_leniency_with_smile_yes)
b = d[i,] %>%
filter(with_smile == "no") %>%
summarise(mean_leniency_with_smile_no = mean(leniency)) %>%
pull(mean_leniency_with_smile_no)
a - b
}
booted <- boot(data = leniency,
statistic = s,
R = 2000)
estimado = tidy(booted,
conf.level = .95,
conf.method = "basic",
conf.int = TRUE)
glimpse(estimado)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.9460784
## $ bias <dbl> -0.0004310443
## $ std.error <dbl> 0.3083595
## $ conf.low <dbl> 0.3530647
## $ conf.high <dbl> 1.556124
estimado %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = "Leniência"
)) +
geom_linerange() +
geom_point(color = "steelblue", size = 2) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.05,
show.legend = F
) +
scale_y_continuous(limits = c(0, 2)) +
labs(
title = "Diferença entre média do índice de\nleniência com sorriso e sem sorriso",
x = "", y = "") +
coord_flip()
Observamos que:
s_miserable <- function(d, i) {
a = d[i,] %>%
filter(smile == "miserable smile") %>%
summarise(miserable_smile_leniency = mean(leniency)) %>%
pull(miserable_smile_leniency)
b = d[i,] %>%
filter(smile == "no smile (control)") %>%
summarise(no_smile_control_leniency = mean(leniency)) %>%
pull(no_smile_control_leniency)
a - b
}
booted <- boot(data = leniency,
statistic = s_miserable,
R = 2000)
estimado_miserable = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_miserable)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.7941176
## $ bias <dbl> -0.003002503
## $ std.error <dbl> 0.3598541
## $ conf.low <dbl> 0.0625743
## $ conf.high <dbl> 1.442503
s_felt <- function(d, i) {
a = d[i,] %>%
filter(smile == "felt smile") %>%
summarise(felt_smile_leniency = mean(leniency)) %>%
pull(felt_smile_leniency)
b = d[i,] %>%
filter(smile == "no smile (control)") %>%
summarise(no_smile_control_leniency = mean(leniency)) %>%
pull(no_smile_control_leniency)
a - b
}
booted <- boot(data = leniency,
statistic = s_felt,
R = 2000)
estimado_felt = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_felt)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.7941176
## $ bias <dbl> 0.02347787
## $ std.error <dbl> 0.3833557
## $ conf.low <dbl> 0.03718265
## $ conf.high <dbl> 1.530495
s_false <- function(d, i) {
a = d[i,] %>%
filter(smile == "false smile") %>%
summarise(false_smile_leniency = mean(leniency)) %>%
pull(false_smile_leniency)
b = d[i,] %>%
filter(smile == "no smile (control)") %>%
summarise(no_smile_control_leniency = mean(leniency)) %>%
pull(no_smile_control_leniency)
a - b
}
booted <- boot(data = leniency,
statistic = s_false,
R = 2000)
estimado_false = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_false)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 1.25
## $ bias <dbl> 0.002979248
## $ std.error <dbl> 0.4167125
## $ conf.low <dbl> 0.4443666
## $ conf.high <dbl> 2.093359
estimado_miserable %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = "ms - ns"
)) +
geom_linerange() +
geom_point(color = "steelblue", size = 2) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.05,
show.legend = F
) +
scale_y_continuous(limits = c(-0.5, 2.5)) +
labs(
title = "Diferença entre intervalo estimado para leniência",
subtitle = str_glue("misarable smile (ms) - no smile (ns)"),
x = "", y = "") +
coord_flip()
estimado_felt %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = "fs - ns"
)) +
geom_linerange() +
geom_point(color = "steelblue", size = 2) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.05,
show.legend = F
) +
scale_y_continuous(limits = c(-0.5, 2.5)) +
labs(
title = "Diferença entre intervalo estimado para leniência",
subtitle = str_glue("felt smile (fs) - no smile (ns)"),
x = "", y = "") +
coord_flip()
estimado_false %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = "fls - ns"
)) +
geom_linerange() +
geom_point(color = "steelblue", size = 2) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.05,
show.legend = F
) +
scale_y_continuous(limits = c(-0.5, 2.5)) +
labs(
title = "Diferença entre intervalo estimado para leniência",
subtitle = str_glue("false smile (fls) - no smile (ns)"),
x = "", y = "") +
coord_flip()
Para iniciar esta proxima analise carregamos o arquivo data/requests-portais.csv e visualizamos como são nossos dados:
requests_portais = read_csv(here::here("data/requests-portais.csv"),
col_types = "cd")
glimpse(requests_portais)
## Rows: 120
## Columns: 2
## $ site <chr> "g1", "g1", "g1", "g1", "g1", "g1", "g1", "g1", "g1", "g1", "g1",…
## $ time <dbl> 1.600459, 1.471800, 1.398192, 1.380360, 1.386828, 1.529101, 1.393…
Observamos abaixo algumas informações sobre os dados de cada coluna, não há dados faltantes. O valor mínimo e máximo para coluna time (tempo de resposta em segundos de cada requisição) é de 0.3422 e 1.6824.
summary(requests_portais)
## site time
## Length:120 Min. :0.3422
## Class :character 1st Qu.:0.3616
## Mode :character Median :0.5872
## Mean :0.7127
## 3rd Qu.:1.0004
## Max. :1.6824
Abaixamos vemos o comportamento do tempo de acordo a coluna site, observamos que há 4 tipos de site, “uol”, “terra”, “g1” e “folha”, cada uma com 30 amostras. Observamos tambem que:
Para site:
requests_portais %>%
ggplot(aes(x=time, y=site)) +
geom_jitter(height = .2, width = 0, alpha = .5, color = "coral") +
labs(
title = "Gráfico de dispersão dos tempos para\nrequisições versus site",
y = "site",
x = "tempo em segundos"
)
requests_portais %>%
group_by(site) %>%
count()
Agora vejamos nossas pesquisas …
Observa-se que os sites folha e uol possuem os melhores tempos (mais rapidos = menos segundos) de requisições. Podemos ver que a média do uol é de 0.3556272 e a do folha é de 0.3791591, o que é ligeramente maior. Se observamos o seu intervalo de confiança (com 95%) não há uma intersecção de valores, mas é algo bem próximo. Na próxima verificamos melhor a diferença entre eles.
s_uol <- function(d, i) {
d[i,] %>%
filter(site == "uol") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
}
booted <- boot(data = requests_portais,
statistic = s_uol,
R = 2000)
estimado_times_uol = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_times_uol)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.3556272
## $ bias <dbl> -6.791626e-05
## $ std.error <dbl> 0.003619449
## $ conf.low <dbl> 0.3512425
## $ conf.high <dbl> 0.3698038
s_terra <- function(d, i) {
d[i,] %>%
filter(site == "terra") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
}
booted <- boot(data = requests_portais,
statistic = s_terra,
R = 2000)
estimado_times_terra = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_times_terra)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.6723314
## $ bias <dbl> -4.641199e-05
## $ std.error <dbl> 0.009130755
## $ conf.low <dbl> 0.6595155
## $ conf.high <dbl> 0.7001364
s_folha <- function(d, i) {
d[i,] %>%
filter(site == "folha") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
}
booted <- boot(data = requests_portais,
statistic = s_folha,
R = 2000)
estimado_times_folha = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_times_folha)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 0.3791591
## $ bias <dbl> -2.056824e-05
## $ std.error <dbl> 0.006142776
## $ conf.low <dbl> 0.37153
## $ conf.high <dbl> 0.4011573
s_g1 <- function(d, i) {
d[i,] %>%
filter(site == "g1") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
}
booted <- boot(data = requests_portais,
statistic = s_g1,
R = 2000)
estimado_times_g1 = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_times_g1)
## Rows: 1
## Columns: 5
## $ statistic <dbl> 1.443589
## $ bias <dbl> -0.0003831165
## $ std.error <dbl> 0.01393562
## $ conf.low <dbl> 1.421372
## $ conf.high <dbl> 1.477266
estimado_times_folha = estimado_times_folha %>%
mutate(site = "folha")
estimado_times_uol = estimado_times_uol %>%
mutate(site = "uol")
estimado_times_g1 = estimado_times_g1 %>%
mutate(site = "g1")
estimado_times_terra = estimado_times_terra %>%
mutate(site = "terra")
a = merge(estimado_times_folha, estimado_times_uol, all = TRUE)
a = merge(a, estimado_times_terra, all = TRUE)
a = merge(a, estimado_times_g1, all = TRUE)
a %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = site
)) +
geom_linerange() +
geom_point(color = "red", size = 1) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.2,
show.legend = F
) +
scale_y_continuous(limits = c(0.25, 1.5)) +
labs(
title = "Tempo estimado em segundos para sites",
x = "sites", y = "") +
coord_flip()
A partir do gráfico anterior esperamos que os sites mais rápidos são uol e folha, como consequência, os mais lentos são terra e g1. Fazendo o bootstrap da diferença da média na reamostragem dos tempos de requisição aos sites podemos ver que o uol é ligeramente mais rápido que o folha. Já para o caso dos sites terra e g1, o terra possui uma diferença significamente maior (bem mais rápido) quando comparado ao g1 se vermos a comparação entre os mais rápidos.
s_uol_folha <- function(d, i) {
a = d[i,] %>%
filter(site == "uol") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
b = d[i,] %>%
filter(site == "folha") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
a - b
}
booted <- boot(data = requests_portais,
statistic = s_uol_folha,
R = 2000)
estimado_uol_folha = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_uol_folha)
## Rows: 1
## Columns: 5
## $ statistic <dbl> -0.02353193
## $ bias <dbl> 0.000116549
## $ std.error <dbl> 0.007111144
## $ conf.low <dbl> -0.04322706
## $ conf.high <dbl> -0.01317664
s_terra_g1 <- function(d, i) {
a = d[i,] %>%
filter(site == "terra") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
b = d[i,] %>%
filter(site == "g1") %>%
summarise(mean_time = mean(time)) %>%
pull(mean_time)
a - b
}
booted <- boot(data = requests_portais,
statistic = s_terra_g1,
R = 2000)
estimado_terra_g1 = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_terra_g1)
## Rows: 1
## Columns: 5
## $ statistic <dbl> -0.7712579
## $ bias <dbl> 0.0008017462
## $ std.error <dbl> 0.01663017
## $ conf.low <dbl> -0.8078898
## $ conf.high <dbl> -0.7416515
estimado_uol_folha %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = ""
)) +
geom_linerange() +
geom_point(color = "red", size = 1) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.2,
show.legend = F
) +
scale_y_continuous(limits = c(-0.07, 0.07)) +
labs(
title = "Diferença de tempo estimado em segundos do\nsite uol versus folha",
subtitle = str_glue("média"),
x = "", y = "tempo em segundos") +
coord_flip()
estimado_terra_g1 %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = ""
)) +
geom_linerange() +
geom_point(color = "red", size = 1) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.2,
show.legend = F
) +
scale_y_continuous(limits = c(-1, -0.5)) +
labs(
title = "Diferença de tempo estimado em segundos do\nsite terra versus g1",
subtitle = str_glue("média"),
x = "", y = "tempo em segundos") +
coord_flip()
Não, as mudanças foram insignificantes para ambos se compararmos a analise anterior utilizando 75-percentil.
s_q_uol_folha <- function(d, i) {
a = d[i,] %>%
filter(site == "uol") %>%
summarise(mean_time = quantile(time, 0.75)) %>%
pull(mean_time)
b = d[i,] %>%
filter(site == "folha") %>%
summarise(mean_time = quantile(time, 0.75)) %>%
pull(mean_time)
a - b
}
booted <- boot(data = requests_portais,
statistic = s_q_uol_folha,
R = 2000)
estimado_uol_folha_q = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_uol_folha_q)
## Rows: 1
## Columns: 6
## $ term <chr> "75%"
## $ statistic <dbl> -0.019703
## $ bias <dbl> -0.0009815809
## $ std.error <dbl> 0.003935678
## $ conf.low <dbl> -0.02655079
## $ conf.high <dbl> -0.01331481
s_q_terra_g1 <- function(d, i) {
a = d[i,] %>%
filter(site == "terra") %>%
summarise(mean_time = quantile(time, 0.75)) %>%
pull(mean_time)
b = d[i,] %>%
filter(site == "g1") %>%
summarise(mean_time = quantile(time, 0.75)) %>%
pull(mean_time)
a - b
}
booted <- boot(data = requests_portais,
statistic = s_q_terra_g1,
R = 2000)
estimado_terra_g1_q = tidy(booted,
conf.level = .95,
conf.method = "bca",
conf.int = TRUE)
glimpse(estimado_terra_g1_q)
## Rows: 1
## Columns: 6
## $ term <chr> "75%"
## $ statistic <dbl> -0.8024518
## $ bias <dbl> 0.002349222
## $ std.error <dbl> 0.02621153
## $ conf.low <dbl> -0.8430855
## $ conf.high <dbl> -0.73326
estimado_uol_folha_q %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = ""
)) +
geom_linerange() +
geom_point(color = "red", size = 1) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.2,
show.legend = F
) +
scale_y_continuous(limits = c(-0.07, 0.07)) +
labs(
title = "Diferença de tempo estimado em segundos do\nsite uol versus folha",
subtitle = str_glue("75-percentil"),
x = "", y = "tempo em segundos") +
coord_flip()
estimado_terra_g1_q %>%
ggplot(aes(
ymin = conf.low,
y = statistic,
ymax = conf.high,
x = ""
)) +
geom_linerange() +
geom_point(color = "red", size = 1) +
geom_text(
aes(
y = conf.high,
label = str_glue("[{round(conf.low, 2)}, {round(conf.high, 2)}]")
),
size = 3,
nudge_x = -.2,
show.legend = F
) +
scale_y_continuous(limits = c(-1, -0.5)) +
labs(
title = "Diferença de tempo estimado em segundos do\nsite terra versus g1",
subtitle = str_glue("75-percentil"),
x = "", y = "tempo em segundos") +
coord_flip()