modelo_lm = lm(score ~ age, data = profs)

tabela1 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela1, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)
profs %>% 
  add_predictions(model = modelo_lm) %>% # add o que o modelo estima p cada humidade
  ggplot(mapping = aes(x = age, y = score)) + 
  geom_point(size = 2, alpha = 0.7, color = "#EB3737") + 
  geom_line(aes(y = pred), colour = "#710404", size = 1) +
  labs (y = "Score", x = "Age")

Score \(= -0.006*(Age) + 4.461\)

A idade tem um efeito muito pequeno e negativo no score. Quando comparados dois professores, A e B, com 30 e 70 anos, respectivamente, o professor A perderá -0.18 no score, enquanto o professor B perderá -0.42.

profs = profs %>%
    mutate(gender2 = if_else(gender == "female", 0, 1))


modelo_lm = lm(score ~ gender2, data = profs)

tabela2 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela2, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)
profs %>% 
  add_predictions(model = modelo_lm) %>% # add o que o modelo estima p cada humidade
  ggplot(mapping = aes(x = gender2, y = score)) + 
  geom_point(size = 2, alpha = 0.7, color = "#EDD53C") + 
  geom_line(aes(y = pred), colour = "#9C8B21", size = 1) +
  labs (y = "Score", x = "Gender")

\(score = 0.141*gender(male=1) + 4.23432\)

O gênero tem um efeito muito pequeno e positivo no score. Homens (gender = “male”) ganham +0.141 no score final, enquanto as mulheres não ganham nada.

modelo_lm = lm(score ~ bty_avg, data = profs)

tabela3 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela3, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)
profs %>% 
  add_predictions(model = modelo_lm) %>% # add o que o modelo estima p cada humidade
  ggplot(mapping = aes(x = bty_avg, y = score)) + 
  geom_point(size = 2, alpha = 0.7, color = "#5FE526") + 
  geom_line(aes(y = pred), colour = "#2E6418", size = 1) +
  labs (y = "Score", x = "Bty_avg")

Score \(= 0.0667*btyavg + 3.8803\)

Bty_avg tem um efeito muito pequeno e positivo no resultado do score. A cada 1 ponto adicionado à bty_avg, o professor ganha +0.0667 no score final.

profs = profs %>% 
    mutate(pic_outfit2 = if_else(pic_outfit == "formal", 1, 0))

modelo_lm = lm(score ~ pic_outfit2, data = profs)

tabela3 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela3, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)
profs %>% 
  add_predictions(model = modelo_lm) %>% # add o que o modelo estima p cada humidade
  ggplot(mapping = aes(x = pic_outfit2, y = score)) + 
  geom_point(size = 2, alpha = 0.7, color = "#42C7D6") + 
  geom_line(aes(y = pred), colour = "#1D6F78", size = 1) +
  labs (y = "Score", x = "Pic_outfit")

Score \(= -0.055*pic_outfit(formal = 1) + 4.22077\)

Pic_outfit tem um efeito muito pequeno e negativo sobre o score final. Quando a roupa não é formal, ela possui uma perda de -0.055 no resultado final do score.

profs = profs %>% 
    mutate(pic_color2 = if_else(pic_color == "black&white", 1, 0))

modelo_lm = lm(score ~ pic_color2, data = profs)

tabela4 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela4, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)
profs %>% 
  add_predictions(model = modelo_lm) %>%
  ggplot(mapping = aes(x = pic_color2, y = score)) + 
  geom_point(size = 2, alpha = 0.7, color = "#E04EF1") + 
  geom_line(aes(y = pred), colour = "#791E83", size = 1) +
  labs (y = "Score", x = "Pic_color")

\(score = -0.225*pic_color(black&white = 1) + 4.36153\)

Pic_color tem um efeito pequeno e negativo no resultado do score. Se for preto e branco a defasagem é de -0.225 no resultado final do score.

modelo_lm = lm(score ~ ., data = profs)

tabela5 = tidy(modelo_lm) %>% 
  select(term, estimate)

datatable(tabela5, options = list(pageLength = 10, dom = 'tip'), rownames = FALSE)

O melhor modelo linear encontrado é da forma:

\(score = 4.370124 - 0.007*age + 0.223*gender(male = 1) + 0.047*btyavg - 0.015*picoutfit(not formal = 1)\) \(- 0.212*piccolor(color = 1)\)

O efeito da idade é negativo e pequeno no resultado final do score, assim como os efeitos de picoutfit e piccolor. Já os efeitos de gender e bty_avg, apesar de também serem pequenos, é positivo.

Observando o resultado do R.squared abaixo, podemos concluir que o modelo encontrado tem pouco mais de 8% de chances de refletir a realidade.

tabela6 = glance(modelo_lm) %>% 
  select(r.squared)

datatable(tabela6, options = list(pageLength = 3, dom = 'tip'), rownames = FALSE)