knitr::opts_chunk$set(echo=TRUE, warning=FALSE, message=FALSE, fig.width=12, fig.height=6)
# dataset 
avaliacoes <- read.csv("evals.csv")
# libs
library(dplyr, quietly=T)
library(ggplot2, quietly=T)
library(nortest, quietly=T)

library(broom, quietly=T)

#library(GGally, quietly=T)
#library(gridExtra, quietly=T)

Vários cursos universitários dão aos alunos a oportunidade de avaliar o curso e o professor de maneira anônima ao final do semestre. Contudo, o uso das avaliações dos alunos como um indicador da qualidade do curso e a eficácia do ensino é frequentemente criticado porque essas medidas podem refletir a influência de características não relacionadas à docência, tal como a aparência física do professor. Neste laboratório analisaremos os dados de um estudo que coletou dados para examinar a hipótese de que a beleza do professor influencia na percepção de competência dos alunos.

Os dados foram coletados a partir das avaliações discentes de final de semestre de uma grande amostra de professores da Universidade do Texas em Austin. Além disso, seis estudantes avaliaram a aparência física dos professores. O resultado é um banco de dados no qual cada linha contém diferentes disciplinas e cada coluna representa as variáveis sobre as disciplinas e os professores. Os dados estão disponíveis aqui. As variáveis contidas nele são as seguintes:

De posse desses dados, queremos avaliar se a beleza possui um efeito significativo no score dos professores, levando em conta os demais fatores que foram identificados como tento possíveis efeitos, que são as variáveis rank, ethnicity, gender, language, age, cls, pic-outfit e pic-color.

Para tanto, iremos partir de uma análise descritiva dos dados.

Parte 1 - Análise Descritiva

Como as variáveis presentes no dataset já foram brevemente explicadas, vamos explorar mais a fundo a natureza das mesmas. O dataset é comporto de 463 observações e 21 atributos, dentre os quais filtraremos algumas características nas quais temos mais interesse.

avaliacoesF <- avaliacoes %>%
  select(score, age, cls_perc_eval, cls_did_eval, cls_students, bty_avg, cls_level, 
         rank, ethnicity, gender, language, pic_outfit, pic_color, cls_profs, cls_credits)

# Sumário
summary(avaliacoesF)
##      score            age        cls_perc_eval     cls_did_eval   
##  Min.   :2.300   Min.   :29.00   Min.   : 10.42   Min.   :  5.00  
##  1st Qu.:3.800   1st Qu.:42.00   1st Qu.: 62.70   1st Qu.: 15.00  
##  Median :4.300   Median :48.00   Median : 76.92   Median : 23.00  
##  Mean   :4.175   Mean   :48.37   Mean   : 74.43   Mean   : 36.62  
##  3rd Qu.:4.600   3rd Qu.:57.00   3rd Qu.: 87.25   3rd Qu.: 40.00  
##  Max.   :5.000   Max.   :73.00   Max.   :100.00   Max.   :380.00  
##   cls_students       bty_avg      cls_level             rank    
##  Min.   :  8.00   Min.   :1.667   lower:157   teaching    :102  
##  1st Qu.: 19.00   1st Qu.:3.167   upper:306   tenure track:108  
##  Median : 29.00   Median :4.333               tenured     :253  
##  Mean   : 55.18   Mean   :4.418                                 
##  3rd Qu.: 60.00   3rd Qu.:5.500                                 
##  Max.   :581.00   Max.   :8.167                                 
##         ethnicity      gender           language        pic_outfit 
##  minority    : 64   female:195   english    :435   formal    : 77  
##  not minority:399   male  :268   non-english: 28   not formal:386  
##                                                                    
##                                                                    
##                                                                    
##                                                                    
##        pic_color      cls_profs         cls_credits 
##  black&white: 78   multiple:306   multi credit:436  
##  color      :385   single  :157   one credit  : 27  
##                                                     
##                                                     
##                                                     
## 
# GgPairs
#ggpairs(avaliacoesF, columns = 1:6)

Afim de encontrar alguma anormalidade, observamos o sumário geral dos dados. Não encontramos nenhum dado que destoasse dos valores de sua categoria, entretanto é interessante atentar para o atributo etnia - apenas 64 dos professores são minoria, enquanto 399 são não-minoria (caucasianos).

Observando a correlação entre os dados, como era de se esperar, há uma alta correlação entre a quantidade de alunos da turma que completaram a avaliação e o número de alunos total da turma - entretanto isso nos diz apenas que ambas as variáveis tem um crescimento similar.

# Sumario
summary(avaliacoesF$score)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.300   3.800   4.300   4.175   4.600   5.000
# Variação
var(avaliacoesF$score)
## [1] 0.2957886
sd(avaliacoesF$score)
## [1] 0.5438645
# Histograma
ggplot(avaliacoesF, aes(x=score)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("Score - Histograma") + xlab("Score") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", score)) + geom_boxplot() + 
  xlab("") + ylab("Score") + ggtitle("Distribuição - Score") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$score)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$score
## W = 0.95228, p-value = 4.477e-11
ad.test(avaliacoesF$score)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$score
## A = 5.7969, p-value = 2.741e-14
qqnorm(avaliacoesF$score)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 2.3, 5; o histograma e os testes de normalidade nos sugerem que score não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. No boxplot vemos que 50% dos dados estão entre 3.5 e 4.7, o que significa uma grande concentração dos dados nesta faixa de valores. Percebemos também 3 avaliações extremamente baixas e nenhum valor demasiadamente alto.

# Sumario
summary(avaliacoesF$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   29.00   42.00   48.00   48.37   57.00   73.00
# Variação
var(avaliacoesF$age)
## [1] 96.09375
sd(avaliacoesF$age)
## [1] 9.802742
# Histograma
ggplot(avaliacoesF, aes(x=age)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("Age - Histograma") + xlab("Age") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", age)) + geom_boxplot() + 
  xlab("") + ylab("Age") + ggtitle("Distribuição - Age") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$age)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$age
## W = 0.97299, p-value = 1.522e-07
ad.test(avaliacoesF$age)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$age
## A = 3.1981, p-value = 5.041e-08
qqnorm(avaliacoesF$age)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 29, 73; o histograma e os testes de normalidade nos sugerem que age não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. No boxplot vemos que 50% dos dados estão entre 40 e 60 anos, o que significa uma grande concentração dos dados nesta faixa de valores.

Podemos supor que professores mais jovens sejam melhor avaliados pelos alunos por ‘serem de mundos mais próximos’, por outro lado também podemos supor que professores mais velhos sejam melhor avaliados por terem mais experiência no ensino.

# Sumario
summary(avaliacoesF$cls_perc_eval)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   10.42   62.70   76.92   74.43   87.25  100.00
# Variação
var(avaliacoesF$cls_perc_eval)
## [1] 280.774
sd(avaliacoesF$cls_perc_eval)
## [1] 16.75631
# Histograma
ggplot(avaliacoesF, aes(x=cls_perc_eval)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("cls_perc_eval - Histograma") + xlab("cls_perc_eval") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", cls_perc_eval)) + geom_boxplot() + 
  xlab("") + ylab("cls_perc_eval") + ggtitle("Distribuição - cls_perc_eval") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$cls_perc_eval)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$cls_perc_eval
## W = 0.96157, p-value = 1.223e-09
ad.test(avaliacoesF$cls_perc_eval)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$cls_perc_eval
## A = 4.2049, p-value = 1.83e-10
qqnorm(avaliacoesF$cls_perc_eval)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 10.41667, 100; o histograma e os testes de normalidade nos sugerem que cls_perc_eval não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. No boxplot vemos que 50% dos dados estão entre 60 e 80 %, o que significa uma grande concentração dos dados nesta faixa de valores.

# Sumario
summary(avaliacoesF$cls_did_eval)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    5.00   15.00   23.00   36.62   40.00  380.00
# Variação
var(avaliacoesF$cls_did_eval)
## [1] 2026.664
sd(avaliacoesF$cls_did_eval)
## [1] 45.01848
# Histograma
ggplot(avaliacoesF, aes(x=cls_did_eval)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("cls_did_eval - Histograma") + xlab("cls_did_eval") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", cls_did_eval)) + geom_boxplot() + 
  xlab("") + ylab("cls_did_eval") + ggtitle("Distribuição - cls_did_eval") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$cls_did_eval)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$cls_did_eval
## W = 0.54813, p-value < 2.2e-16
ad.test(avaliacoesF$cls_did_eval)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$cls_did_eval
## A = 54.764, p-value < 2.2e-16
qqnorm(avaliacoesF$cls_did_eval)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 5, 380; o histograma e os testes de normalidade nos sugerem que cls_did_eval não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. No boxplot vemos que 50% dos dados estão entre 15 e 40, o que significa uma grande concentração dos dados nesta faixa de valores.

# Sumario
summary(avaliacoesF$cls_students)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    8.00   19.00   29.00   55.18   60.00  581.00
# Variação
var(avaliacoesF$cls_students)
## [1] 5635.925
sd(avaliacoesF$cls_students)
## [1] 75.0728
# Histograma
ggplot(avaliacoesF, aes(x=cls_students)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("cls_students - Histograma") + xlab("cls_students") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", cls_students)) + geom_boxplot() + 
  xlab("") + ylab("cls_students") + ggtitle("Distribuição - cls_students") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$cls_students)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$cls_students
## W = 0.54396, p-value < 2.2e-16
ad.test(avaliacoesF$cls_students)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$cls_students
## A = 60.812, p-value < 2.2e-16
qqnorm(avaliacoesF$cls_students)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 8, 581; o histograma e os testes de normalidade nos sugerem que cls_students não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. A distribuição apresenta uma calda a direita. No boxplot vemos que 50% dos dados estão entre 19 e 60, o que significa uma grande concentração dos dados nesta faixa de valores. Notamos também uma grande variância desse dado.

# Sumario
summary(avaliacoesF$bty_avg)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.667   3.167   4.333   4.418   5.500   8.167
# Variação
var(avaliacoesF$bty_avg)
## [1] 2.33289
sd(avaliacoesF$bty_avg)
## [1] 1.52738
# Histograma
ggplot(avaliacoesF, aes(x=bty_avg)) + geom_histogram(binwidth = 0.5) + 
  ggtitle("Média da Avaliação de Beleza - Histograma") + xlab("bty_avg") + ylab("Ocorrências")

# Boxplot
ggplot(avaliacoesF, aes("-", bty_avg)) + geom_boxplot() + 
  xlab("") + ylab("Avaliação de Beleza") + ggtitle("Distribuição - bty_avg") +
  theme(axis.text.x = element_text(angle = 80, hjust = 1)) 

# Análise Normalidade
shapiro.test(avaliacoesF$bty_avg)
## 
##  Shapiro-Wilk normality test
## 
## data:  avaliacoesF$bty_avg
## W = 0.96236, p-value = 1.656e-09
ad.test(avaliacoesF$bty_avg)
## 
##  Anderson-Darling normality test
## 
## data:  avaliacoesF$bty_avg
## A = 5.3538, p-value = 3.151e-13
qqnorm(avaliacoesF$bty_avg)

Esta variável tem natureza quantitativa e escala de razão. No sumário vemos que a variável está no range de 1.667, 8.167; o histograma e os testes de normalidade nos sugerem que bty_avg não segue uma distribuição normal, ou seja, não podemos rejeitar a hipótese de que os dados não seguem uma distribuição normal. No boxplot vemos que 50% dos dados estão entre 3 e 5.

table(avaliacoesF$cls_level)
## 
## lower upper 
##   157   306
prop.table(table(avaliacoesF$cls_level))
## 
##     lower     upper 
## 0.3390929 0.6609071

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘lower’ e ‘upper’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$rank)
## 
##     teaching tenure track      tenured 
##          102          108          253
prop.table(table(avaliacoesF$rank))
## 
##     teaching tenure track      tenured 
##    0.2203024    0.2332613    0.5464363

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘teaching’, ‘tenure track’ e ‘tenured’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$ethnicity)
## 
##     minority not minority 
##           64          399
prop.table(table(avaliacoesF$ethnicity))
## 
##     minority not minority 
##    0.1382289    0.8617711

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘minority’ e ‘not minority’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$gender)
## 
## female   male 
##    195    268
prop.table(table(avaliacoesF$gender))
## 
##    female      male 
## 0.4211663 0.5788337

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘female’ e ‘male’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$language)
## 
##     english non-english 
##         435          28
prop.table(table(avaliacoesF$language))
## 
##     english non-english 
##  0.93952484  0.06047516

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘english’ e ‘non-english’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$pic_outfit)
## 
##     formal not formal 
##         77        386
prop.table(table(avaliacoesF$pic_outfit))
## 
##     formal not formal 
##  0.1663067  0.8336933

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘formal’ e ‘not formal’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$pic_color)
## 
## black&white       color 
##          78         385
prop.table(table(avaliacoesF$pic_color))
## 
## black&white       color 
##   0.1684665   0.8315335

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘black&white’ e ‘color’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$cls_profs)
## 
## multiple   single 
##      306      157
prop.table(table(avaliacoesF$cls_profs))
## 
##  multiple    single 
## 0.6609071 0.3390929

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘multiple’ e ‘single’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

table(avaliacoesF$cls_credits)
## 
## multi credit   one credit 
##          436           27
prop.table(table(avaliacoesF$cls_credits))
## 
## multi credit   one credit 
##   0.94168467   0.05831533

Este atributo tem natureza qualitativa categórica, dividindo-se em ‘multi credit’ e ‘one credit’. Não fazendo sentido calcular outras estatísticas, vemos acima as proporções de cada uma.

Parte 2 - Regressão Linear Simples

Utilize regressão linear simples para avaliar a relação entre beleza e score quando consideramos apenas essa variável. Comente a significância estatística e a significânca prática da relação que você está investigando. Os pressupostos da regressão foram atendidos? Alguma medida a ser tomada nesse ponto?

# Seleção dos dados
sc_beau <- avaliacoesF %>%
  select(score, bty_avg)

# Sumário
summary(sc_beau)
##      score          bty_avg     
##  Min.   :2.300   Min.   :1.667  
##  1st Qu.:3.800   1st Qu.:3.167  
##  Median :4.300   Median :4.333  
##  Mean   :4.175   Mean   :4.418  
##  3rd Qu.:4.600   3rd Qu.:5.500  
##  Max.   :5.000   Max.   :8.167
# Scatterplot
ggplot(sc_beau, aes(score, bty_avg)) + geom_point() +
  ggtitle("Score x Beauty Avg") + xlab("Score") + ylab("Beauty Average")

Após selecionados os dados, vemos no scatterplot que não há uma relação evidente aos olhos entre a pontuação média na avaliação docente e a média da avaliação da aparência do professor. Quantificando essa relação, podemos calcular a correlação entre essas duas variáveis.

cor(sc_beau$score,sc_beau$bty_avg)
## [1] 0.1871424

O valor resultante da correlação nos indica que a força do relacionamento linear entre essas duas variáveis é fraca, ou seja, que a beleza do professor explica pouco do score da avaliação docente obtido pelo mesmo. A partir deste pressuposto, esperamos que após gerado o modelo linear entre as duas variáveis, este explique pouco da variação entre as duas variáveis (\(R^2\) baixo).

Partindo para o modelo matemático, de acordo com a questão, é esperado que score seja uma variável dependente de bty_avg, logo:

\[score = \beta_0 + \beta_1 btyAvg\]

# Modelo
modelo <- lm(score ~ bty_avg, data = sc_beau)

summary(modelo)
## 
## Call:
## lm(formula = score ~ bty_avg, data = sc_beau)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.9246 -0.3690  0.1420  0.3977  0.9309 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.88034    0.07614   50.96  < 2e-16 ***
## bty_avg      0.06664    0.01629    4.09 5.08e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5348 on 461 degrees of freedom
## Multiple R-squared:  0.03502,    Adjusted R-squared:  0.03293 
## F-statistic: 16.73 on 1 and 461 DF,  p-value: 5.083e-05
tidy(modelo, conf.int = TRUE)
##          term   estimate  std.error statistic       p.value   conf.low
## 1 (Intercept) 3.88033795 0.07614297 50.961212 1.561043e-191 3.73070764
## 2     bty_avg 0.06663704 0.01629115  4.090382  5.082731e-05 0.03462292
##    conf.high
## 1 4.02996827
## 2 0.09865116

Temos:

\[score = 3.880338 + 0.066637 btyAvg\]

Ou seja, se incrementarmos bty_avg em uma unidade, o impacto em score será de 0.066637.

glance(modelo, conf.int = TRUE)[1:5]
##    r.squared adj.r.squared     sigma statistic      p.value
## 1 0.03502226    0.03292903 0.5348351  16.73123 5.082731e-05

Analisando o sumário do modelo, vemos que:

Mesmo que seja pouco provável que não exista nenhuma relação entre a beleza do professor e a avaliação recebida pelo mesmo, o baixo \(R^2\) indica que o modelo gerado explica muito pouco da variância compreendida pela variável score (apenas 3.2% da variância dos dados), assim como também indica que que o modelo não descreve bem a relação entre score e btyAvg.

ggplot(modelo, aes(bty_avg, score)) + geom_point() + geom_smooth(method="lm") + 
  ggtitle("Score x Beauty Avg - Linear Model") + xlab("Beauty Average") + ylab("Score")

O gráfico acima representa a reta criada pelo modelo para descrever o conjunto de dados passado. No próprio gráfico podemos notar que a reta em azul descreve, de fato, pouco das posições assumidas pelos pontos no plano cartesiano.

Em relação a significância prática: com base no modelo e na análise de correlação, podemos dizer que não há relação significativa evidenciada a partir das análises feitas. Em relação a significância estatística: podemos dizer com 95% de confiança que é improvável que a beleza reflita na avaliação docente do professor.

plot(modelo)

Na análise do modelo e dos resíduos devemos atentar a 4 pontos: 1) Variabilidade constante dos erros 2) Relacionamento linear das variáveis 3) Normalidade dos resíduos 4) Outliers Estranhos

No primeiro gráfico temos os resíduos em função dos valores estimados da variável resposta (Y - score). Vemos que a mancha dos pontos no gráfico se distribui de maneira uniforme em torno da reta de resíduo zero, o que nos dá a evidência de que os erros são independentes e média nula. Quando os resíduos seguem um padrão, a confição de independência dos erros não é satisfeita, o que pode indicar que: ou não existe relação linear significativa entre as variáveis, ou outras variáveis independentes influenciam significativamente a variável resposta.

No segundo gráfico temos que a grande maioria dos pontos tentem a concentrar-se em torno do declive da linha tracejada, o que nos dá evidência de que a distribuição dos erros é normal.

No terceiro gráfico podemos analisar a homoscedasticidade dos erros, ou seja, quando plotamos os erros individuais e os respectivos valores previstos, a variância dos erros é a mesma / constante. A reta gerada não é totalmente horizontal, neste caso o que podemos fazer é: transformar os valores de Y ou usar o Método dos Mínimos Quadrados Ponderados.

No quarto gráfico podemos visualizar possíveis outliers que atrapalharam o modelo ao longo da linha de regressão. Neste caso, caso existam outliers, podemos medir a influência dessas observações com a distância de Cook e eliminá-los ou mantê-los.

Parte 3 - Regressão Linear Múltipla

Queremos agora avaliar se o efeito da beleza é significativo quando levamos em conta outras variáveis que podem explicar a variação de avaliações que observamos. Antes de fazer o modelo, pense sobre cada uma delas e anote quais você espera que tenham um efeito significativo e quais teriam efeito positivo ou negativo. Em seguida, construa seu modelo e avalie os resultados encontrados. Comente os efeitos dos preditores, o fit do modelo e que implicações você acha que ele tem. Nos diga qual sua conclusão sobre o efeito da beleza na avaliação da docência dos professores.

Nesta questão utilizaremos variáveis que pensamos influenciarem na avaliação do professor.

sel <- avaliacoes %>%
  select(score, gender, ethnicity, language, age, cls_students, cls_profs, pic_outfit, pic_color, bty_avg)

Os atributos escolhidos foram: etnia, lingua, idade, número de estudantes da turma, número de professores ministrando a disciplina, tipo de roupa na foto (despojada ou formal), cor da foto (colorida ou preto e branco) e beleza.

Satisfazendo uma suposição que foi levantada anteriormente, calcularemos a correlação entre score e age.

cor(sel$score, sel$age)
## [1] -0.107032

Notamos que a correlação entre tais variáveis é negativa e diferente de zero. Isso nos pode levar a crer que quanto mais velho é o professor, menores as notas assignadas a ele. Assim, removeremos age da construção do nosso modelo.

Temos:

\[score = \beta_0 + \beta_1 ethnicity + \beta_2 language + \beta_3 clsstudents + \beta_4 clsprofs + \beta_5 picoutfit + \beta_6 piccolor + \beta_7 btyavg \]

modelo2 <- lm(score ~ ethnicity + language + gender +
                cls_students + cls_profs + pic_outfit + pic_color + bty_avg,  data = sel)

summary(modelo2)
## 
## Call:
## lm(formula = score ~ ethnicity + language + gender + cls_students + 
##     cls_profs + pic_outfit + pic_color + bty_avg, data = sel)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.7791 -0.3568  0.1171  0.4129  0.8930 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            4.0090463  0.1567065  25.583  < 2e-16 ***
## ethnicitynot minority  0.0155081  0.0766436   0.202 0.839741    
## languagenon-english   -0.2905816  0.1118620  -2.598 0.009691 ** 
## gendermale             0.1883241  0.0509811   3.694 0.000248 ***
## cls_students          -0.0001716  0.0003554  -0.483 0.629532    
## cls_profssingle       -0.0320933  0.0539241  -0.595 0.552036    
## pic_outfitnot formal  -0.0389780  0.0737865  -0.528 0.597581    
## pic_colorcolor        -0.1950224  0.0708104  -2.754 0.006121 ** 
## bty_avg                0.0624506  0.0169701   3.680 0.000261 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.523 on 454 degrees of freedom
## Multiple R-squared:  0.09129,    Adjusted R-squared:  0.07528 
## F-statistic: 5.701 on 8 and 454 DF,  p-value: 6.356e-07
tidy(modelo2, conf.int = TRUE)
##                    term      estimate    std.error  statistic      p.value
## 1           (Intercept)  4.0090462653 0.1567064719 25.5831569 4.828236e-90
## 2 ethnicitynot minority  0.0155081146 0.0766435996  0.2023406 8.397411e-01
## 3   languagenon-english -0.2905815828 0.1118620437 -2.5976781 9.690567e-03
## 4            gendermale  0.1883240551 0.0509811310  3.6939952 2.476600e-04
## 5          cls_students -0.0001715738 0.0003554365 -0.4827128 6.295324e-01
## 6       cls_profssingle -0.0320932561 0.0539240783 -0.5951563 5.520355e-01
## 7  pic_outfitnot formal -0.0389780333 0.0737864772 -0.5282544 5.975809e-01
## 8        pic_colorcolor -0.1950224297 0.0708104421 -2.7541479 6.120795e-03
## 9               bty_avg  0.0624505717 0.0169701142  3.6800325 2.612033e-04
##        conf.low     conf.high
## 1  3.7010862408  4.3170062898
## 2 -0.1351121152  0.1661283443
## 3 -0.5104132037 -0.0707499619
## 4  0.0881357849  0.2885123252
## 5 -0.0008700787  0.0005269312
## 6 -0.1380650151  0.0738785029
## 7 -0.1839834376  0.1060273710
## 8 -0.3341793211 -0.0558655384
## 9  0.0291008529  0.0958002905
glance(modelo2, conf.int = TRUE)[1:5]
##    r.squared adj.r.squared     sigma statistic      p.value
## 1 0.09128933    0.07527681 0.5229939  5.701121 6.356462e-07

Utilizando a Regressão Linear Múltipla podemos observar que algumas variáveis possuem mais significância que outras. Das 8 variáveis independentes utilizadas, 4 possuem intervalos de confiança que incluem 0, ou seja, não é possível afirmar sobre os efeitos que essas variáveis podem exercer sobre a variável resposta. As variáveis com mais significância, para este modelo, são gender e bty_avg. O \(R^2\) baixo indica que o modelo explica pouco da variância dos dados, entretanto este segundo modelo gerado foi significativamente melhor do que proposto na questão anterior. A partir da análise feita, acredito que a beleza do professor não influencia na avaliação docente, entretando acredito que existam outros fatores não presentes neste estudo que tenham relação com a avaliação.

Referências