R Notebook

dados_leniency = read_csv(here::here("data/leniency.csv"))

-- Column specification ------------------------------------------------------------------
cols(
  smile = col_character(),
  leniency = col_double(),
  with_smile = col_character()
)

glimpse(dados_leniency)

Rows: 136
Columns: 3
$ smile      <chr> "false smile", "false smile", "false smile", "false smile", "false sm~
$ 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, 3.5, 6.0,~
$ with_smile <chr> "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes",~

dados_leniency  %>% 
    skimr::skim()

-- Data Summary ------------------------
                           Values    
Name                       Piped data
Number of rows             136       
Number of columns          3         
_______________________              
Column type frequency:               
  character                2         
  numeric                  1         
________________________             
Group variables            None      

-- Variable type: character --------------------------------------------------------------
# A tibble: 2 x 8
  skim_variable n_missing complete_rate   min   max empty n_unique whitespace
* <chr>             <int>         <dbl> <int> <int> <int>    <int>      <int>
1 smile                 0             1    10    18     0        4          0
2 with_smile            0             1     2     3     0        2          0

-- Variable type: numeric ----------------------------------------------------------------
# A tibble: 1 x 11
  skim_variable n_missing complete_rate  mean    sd    p0   p25   p50   p75  p100 hist 
* <chr>             <int>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1 leniency              0             1  4.83  1.67     2   3.5   4.5     6     9 ▅▇▆▃▂

dados_leniency %>% 
    drop_na() %>% 
  ggplot(aes(x = leniency)) + 
  facet_wrap(~ smile, ncol = 1) + 
  geom_histogram(binwidth = 0.4, boundary = 0, color = "darkblue", fill = "steelblue") + 
  geom_rug() +
  theme(text=element_text(size=16,  family="serif")) +
        labs(y = "", x = "leniency")

dados_leniency %>% 
    drop_na() %>% 
  ggplot(aes(x = leniency)) + 
  facet_wrap(~ smile, ncol = 1) + 
  geom_density(binwidth = 0.4, boundary = 0, color = "darkblue", fill = "steelblue") + 
  geom_rug() +
  theme(text=element_text(size=16,  family="serif")) +
        labs(y = "", x = "leniency")

Ignoring unknown parameters: binwidth, boundary

dados_leniency %>% 
  group_by(smile) %>% 
  summarise(media = mean(leniency))

dados_smile = dados_leniency %>% 
    filter(with_smile == "yes")

dados_no_smile = dados_leniency %>% 
    filter(with_smile == "no")

Fazendo as estimativas para fotos com sorriso

s <- function(d, i) {
    sumarizado = d %>% 
        slice(i) %>% 
        summarise(media_smile = mean(leniency))
    
    sumarizado %>% 
      pull(media_smile)
}

s(dados_smile, 1:(nrow(dados_smile))) # theta_chapeu

[1] 5.063725

booted <- boot(data = dados_smile, 
               statistic = s, 
               R = 2000)

ci_smile = tidy(booted, 
              conf.level = .95,
              conf.method = "basic",
              conf.int = TRUE)

ci_smile

ci_smile %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = "With Smile"
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 2) +
        scale_y_continuous(limits = c(0, 10)) +
        labs(x = "", y = "Laninency para fotos com sorriso") +
        coord_flip()

Fazendo as estimativas para fotos sem sorriso

s <- function(d, i) {
    sumarizado = d %>% 
        slice(i) %>% 
        summarise(media_no_smile = mean(leniency))
    
    sumarizado %>% 
      pull(media_no_smile)
}

s(dados_no_smile, 1:(nrow(dados_no_smile))) # theta_chapeu

[1] 4.117647

booted <- boot(data = dados_no_smile, 
               statistic = s, 
               R = 2000)

ci_no_smile = tidy(booted, 
              conf.level = .95,
              conf.method = "basic",
              conf.int = TRUE)

ci_no_smile

ci_no_smile %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = "No smile"
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 2) +
        scale_y_continuous(limits = c(0, 10)) +
        labs(x = "", y = "Laninency para fotos sem sorriso") +
        coord_flip()

juntando as visualizações

ics_smile_nosmile = rbind(ci_smile, ci_no_smile)
ics_smile_nosmile$smile = c("with_smile", "no_smile")

ics_smile_nosmile

ics_smile_nosmile %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = reorder(smile, statistic)
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 3) +
        scale_y_continuous(limits = c(0, 10)) +
        labs(x = "", y = "Leniency") +
        coord_flip()

Comparação com e sem sorriso

Diferença

comparacao = dados_leniency 

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(with_smile) %>% 
        summarise(media = mean(leniency))
    b = agrupado %>% filter(with_smile == "yes") %>% pull(media)
    l = agrupado %>% filter(with_smile == "no") %>% pull(media)
    l - b
}


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

[1] -0.9460784

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

ci_comp_smiles

ci_comp_smiles %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = "no smile - with smile"
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 3) +
        scale_y_continuous(limits = c(-3, 3)) +
        labs(x = "", y = "Leniency") +
        coord_flip()

---

miserable_smile = dados_leniency %>% 
    filter(smile == "miserable smile")

felt_smile = dados_leniency %>% 
    filter(smile == "felt smile")

false_smile = dados_leniency %>% 
    filter(smile == "false smile")

miserable_smile

miserable

s <- function(d, i) {
    sumarizado = d %>% 
        slice(i) %>% 
        summarise(media = mean(leniency))
    
    sumarizado %>% 
      pull(media)
}

s(miserable_smile, 1:(nrow(miserable_smile))) # theta_chapeu

[1] 4.911765

booted <- boot(data = miserable_smile, 
               statistic = s, 
               R = 2000)

ci_miserable_smile = tidy(booted, 
              conf.level = .95,
              conf.method = "basic",
              conf.int = TRUE)

ci_miserable_smile

felt smile

s <- function(d, i) {
    sumarizado = d %>% 
        slice(i) %>% 
        summarise(media = mean(leniency))
    
    sumarizado %>% 
      pull(media)
}

s(felt_smile, 1:(nrow(felt_smile))) # theta_chapeu

[1] 4.911765

booted <- boot(data = felt_smile, 
               statistic = s, 
               R = 2000)

ci_felt_smile = tidy(booted, 
              conf.level = .95,
              conf.method = "basic",
              conf.int = TRUE)

ci_felt_smile

false smile

s <- function(d, i) {
    sumarizado = d %>% 
        slice(i) %>% 
        summarise(media = mean(leniency))
    
    sumarizado %>% 
      pull(media)
}

s(false_smile, 1:(nrow(false_smile))) # theta_chapeu

[1] 5.367647

booted <- boot(data = false_smile, 
               statistic = s, 
               R = 2000)

ci_false_smile = tidy(booted, 
              conf.level = .95,
              conf.method = "basic",
              conf.int = TRUE)

ci_false_smile

putting together

ics_all_smile = rbind(ci_no_smile, ci_false_smile, ci_felt_smile, ci_miserable_smile)
ics_all_smile$smile = c("no smile", "false smile", "felt smile", "miserable smile")

ics_all_smile

ics_all_smile %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = reorder(smile, statistic)
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 3) +
        scale_y_continuous(limits = c(2, 7.5)) +
        labs(x = "", y = "Leniency") +
        coord_flip()

Fazendo a diferença

No smile - False Smile

Diferença

comparacao_false_smile = dados_leniency 

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(smile) %>% 
        summarise(media = mean(leniency))
    b = agrupado %>% filter(smile == "false smile") %>% pull(media)
    l = agrupado %>% filter(smile == "no smile (control)") %>% pull(media)
    l - b
}


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

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

ci_comp_false_smile

No smile - Felt Smile

Diferença

comparacao_felt_smile = dados_leniency 

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(smile) %>% 
        summarise(media = mean(leniency))
    b = agrupado %>% filter(smile == "felt smile") %>% pull(media)
    l = agrupado %>% filter(smile == "no smile (control)") %>% pull(media)
    l - b
}


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

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

ci_comp_felt_smile

No smile - Miserable Smile

Diferença

comparacao_miserable_smile = dados_leniency 

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(smile) %>% 
        summarise(media = mean(leniency))
    b = agrupado %>% filter(smile == "miserable smile") %>% pull(media)
    l = agrupado %>% filter(smile == "no smile (control)") %>% pull(media)
    l - b
}


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

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

ci_comp_miserable_smile

visualizando as difereças

ics_diff_smile = rbind(ci_comp_false_smile, ci_comp_felt_smile, ci_comp_miserable_smile)
ics_diff_smile$diff = c("no smile - false smile", "no smile - felt smile", "no smile - miserable smile")

ics_diff_smile

ics_diff_smile %>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = reorder(diff, statistic)
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 3) +
        scale_y_continuous(limits = c(-3, 3)) +
        labs(x = "", y = "Leniency") +
        coord_flip()

---

Difference entre False smile e Felt smile No smile - Felt Smile

comparacao_felt_miseralbe = dados_leniency 

theta <- function(d, i) {
    agrupado = d %>% 
        slice(i) %>% 
        group_by(smile) %>% 
        summarise(media = mean(leniency))
    b = agrupado %>% filter(smile == "felt smile") %>% pull(media)
    l = agrupado %>% filter(smile == "miserable smile") %>% pull(media)
    l - b
}


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

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

ci_comparacao_felt_miseralbe

ci_comparacao_felt_miseralbe%>% 
  ggplot(aes(
            ymin = conf.low,
            y = statistic,
            ymax = conf.high,
            x = "Miserable - Felt"
        )) +
        geom_linerange() +
        geom_point(color = "coral", size = 2) +
        scale_y_continuous(limits = c(-2, 2)) +
        labs(x = "", y = "Leniency") +
        coord_flip()