SORRISO

laniencia = read_csv(here::here("data/leniency.csv"), col_types = 'cdc')

laniencia = laniencia %>% 
  mutate(com_sorriso = if_else(with_smile=='yes', TRUE, FALSE))

glimpse(laniencia)

Rows: 136
Columns: 4
$ smile       <chr> "false smile", "false smile", "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, 6.5, 3.0, 8.0, 6.5, 8.0, 6.0,…
$ with_smile  <chr> "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "yes", "…
$ com_sorriso <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRU…

boxplot(leniency~with_smile,
data=laniencia,
main="Diferentes boxplot para cada tipo de sorriso",
xlab="Tipo de Sorriso",
ylab="Valores de Leniencia",
col="orange",
border="brown")

Bootstrap com diferença das medias de com sorriso e sem sorriso

s <- function(d, i) {
    a = d[i,] %>% 
          filter(leniency > 0, com_sorriso==TRUE) %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    b = d[i,] %>% 
        filter(leniency > 0, com_sorriso==FALSE) %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    a - b
}

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

estimado = tidy(booted, 
                conf.level = .95,
                conf.method = "bca",
                conf.int = TRUE)

glimpse(estimado)

Rows: 1
Columns: 5
$ statistic <dbl> 0.9460784
$ bias      <dbl> -0.005304589
$ std.error <dbl> 0.3066291
$ conf.low  <dbl> 0.337321
$ conf.high <dbl> 1.5049

estimado %>% 
    ggplot(aes(
        ymin = conf.low,
        y = statistic,
        ymax = conf.high,
        x = "cs - ss"
    )) +
    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 nas medias",
        x = "", y = "Proporção de efeito do laniency") +
    coord_flip()

s <- function(d, i) {
    a = d[i,] %>% 
        filter(leniency > 0, smile=="false smile") %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    b = d[i,] %>% 
        filter(leniency > 0, smile=='no smile (control)') %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    a - b
}

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

estimado = tidy(booted, 
                conf.level = .95,
                conf.method = "bca",
                conf.int = TRUE)

glimpse(estimado)

Rows: 1
Columns: 5
$ statistic <dbl> 1.25
$ bias      <dbl> 0.005526986
$ std.error <dbl> 0.4046521
$ conf.low  <dbl> 0.4775085
$ conf.high <dbl> 2.027598

estimado %>% 
    ggplot(aes(
        ymin = conf.low,
        y = statistic,
        ymax = conf.high,
        x = "false  s - 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, 3)) +
    labs(
        title = "Prop entre false smile e no smile",
        x = "", y = "Proporção de efeito do laniency") +
    coord_flip()

s <- function(d, i) {
    a = d[i,] %>% 
        filter(leniency > 0, smile=="felt smile") %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    b = d[i,] %>% 
        filter(leniency > 0, smile=='no smile (control)') %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    a - b
}

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

estimado = tidy(booted, 
                conf.level = .95,
                conf.method = "bca",
                conf.int = TRUE)

glimpse(estimado)

Rows: 1
Columns: 5
$ statistic <dbl> 0.7941176
$ bias      <dbl> 0.01223155
$ std.error <dbl> 0.3916718
$ conf.low  <dbl> 0.006788182
$ conf.high <dbl> 1.532258

estimado %>% 
    ggplot(aes(
        ymin = conf.low,
        y = statistic,
        ymax = conf.high,
        x = "felt s - no s"
    )) +
    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 = "Prop entre felt smile e no smile",
        x = "", y = "Proporção de efeito do laniency") +
    coord_flip()

s <- function(d, i) {
    a = d[i,] %>% 
        filter(leniency > 0, smile=="miserable smile") %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    b = d[i,] %>% 
        filter(leniency > 0, smile=='no smile (control)') %>% 
        summarise(do_grupo = mean(leniency)) %>% 
        pull(do_grupo)
    
    a - b
}

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

estimado = tidy(booted, 
                conf.level = .95,
                conf.method = "bca",
                conf.int = TRUE)

glimpse(estimado)

Rows: 1
Columns: 5
$ statistic <dbl> 0.7941176
$ bias      <dbl> -0.002849373
$ std.error <dbl> 0.3612944
$ conf.low  <dbl> 0.1101336
$ conf.high <dbl> 1.538426

estimado %>% 
    ggplot(aes(
        ymin = conf.low,
        y = statistic,
        ymax = conf.high,
        x = "miserable s - n s"
    )) +
    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 = "Prop entre miserable smile e no smile",
        x = "", y = "Proporção de efeito do laniency") +
    coord_flip()