Lab 9

library(tidyverse)
library(openintro)
library(ggplot2)
library(ggpubr)
library(rstatix)
library(GGally)

Exercise 1

This is an observational study. There are no variables that are tested nor the reviewers are not given a treatment for this to be a experiment.

There might be a clarity problem with the question, as how do we scale beauty or if other identifiers effect the beauty scale. We can rephrase the question as “If there is a correlation between the professor’s scaled beauty and the professor’s overall score?”.

Exercise 2

The score histogram is left-skewed. Generally, students given more positive reviews of their professors. I did expected it to be more right-skewed in reviews, as students might warn others about a professor’s performance before registration day.

ggplot(data = evals, aes(x = score)) +geom_histogram()+theme_classic()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Exercise 3

Lets see how professors dress depending on gender. It appears that the majority of the two genders listed do not wear formal outfits in class.

ggplot(data=evals,aes(x=gender,y=pic_outfit,fill=pic_outfit))+geom_bar(stat="identity")+theme_minimal()+theme(axis.text.y = element_blank())

Exercise 4

The initial leaves out the density of the beauty average points compared to the score. We can see more closely how the scores cluster around 4.5 in ratings.

Also, there appears to be a cluster of the beauty rating of 4 where its score is a 4.5.

g1<-ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_point()
g2<-ggplot(data = evals, aes(x = bty_avg, y = score)) +
  geom_jitter()
ggarrange(g1,g2,ncol=2)

Exercise 5

Using lm(), we retrieve the y-intercept at 3.8804 and the slope of bty_avg at .06664. Our linear regression line is y=.0664x+3.8804.

We can interpret that there is positive trend between the beauty average and score. There statistically significant between beauty average and score, as the p value is close to zero.

For practically significant, it varies across the beauty average. There are too many negligible effect sizes to confidently say its practically significant.

m_bty<-lm(score~bty_avg,data=evals)
summary(m_bty)

## 
## Call:
## lm(formula = score ~ bty_avg, data = evals)
## 
## 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

ggplot(data = evals, aes(x = bty_avg, y = score)) +geom_jitter() +
geom_smooth(method = "lm")

## `geom_smooth()` using formula 'y ~ x'

d<-evals %>% cohens_d(bty_avg ~ score, var.equal = TRUE)
summary(d$magnitude)

## negligible      small   moderate      large       NA's 
##         74        103         79         94          1

Exercise 6

The least squares regression conditions are met: the residuals have a linear trend, passed nearly normal histogram, passed normal probability plot.

g3<-ggplot(data = m_bty, aes(x = .fitted, y = .resid)) +
  geom_point() +
  geom_hline(yintercept = 0, linetype = "dashed") +
  xlab("Fitted values") +
  ylab("Residuals")+theme_classic()
g4<-ggplot(data = m_bty, aes(x = .resid)) +
    geom_histogram(binwidth = 25) +
    xlab("Residuals")+theme_classic()
g5<-ggplot(data = m_bty, aes(sample = .resid)) +
  stat_qq()+theme_classic()
ggarrange(g3,g4,g5)

Exercise 7

Beauty average with gender is statistically significant like beauty average alone, as its P values leads towards zero. We can also verify these results with the testings for least squares regression.

m_bty_gen <- lm(score ~ bty_avg + gender, data = evals)
summary(m_bty_gen)

## 
## Call:
## lm(formula = score ~ bty_avg + gender, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8305 -0.3625  0.1055  0.4213  0.9314 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.74734    0.08466  44.266  < 2e-16 ***
## bty_avg      0.07416    0.01625   4.563 6.48e-06 ***
## gendermale   0.17239    0.05022   3.433 0.000652 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5287 on 460 degrees of freedom
## Multiple R-squared:  0.05912,    Adjusted R-squared:  0.05503 
## F-statistic: 14.45 on 2 and 460 DF,  p-value: 8.177e-07

g6<-ggplot(data = m_bty_gen , aes(x = .fitted, y = .resid)) +
  geom_point() +
  geom_hline(yintercept = 0, linetype = "dashed") +
  xlab("Fitted values") +
  ylab("Residuals")+theme_classic()
g7<-ggplot(data = m_bty_gen , aes(x = .resid)) +
    geom_histogram(binwidth = 25) +
    xlab("Residuals")+theme_classic()
g8<-ggplot(data = m_bty_gen , aes(sample = .resid)) +
  stat_qq()+theme_classic()
ggarrange(g3,g4,g5)

Exercise 8

The beauty average predictor is not as accurate as the new addition with gender. Its new estimate is 3.74734+ 0.07416* (bty_avg)+ 0.17239*(gendermale).

The estimate means with the average score of 3.7, there is a bonus of .07 given from the beauty average and .17 by the gender of the professor.

Exercise 9

The professor pictures who had black and white pictures had a higher slope for their lines compared to color picture. It is the assumption that the students cannot accurately distinguish the professor’s feature in black and white compared to color.

Exercise 10

R cannot handle levels above a 2, It did not retrieve data for professors ranked as teaching.

m_bty_rank <- lm(score ~ bty_avg + rank
, data = evals)
summary(m_bty_rank)

## 
## Call:
## lm(formula = score ~ bty_avg + rank, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8713 -0.3642  0.1489  0.4103  0.9525 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       3.98155    0.09078  43.860  < 2e-16 ***
## bty_avg           0.06783    0.01655   4.098 4.92e-05 ***
## ranktenure track -0.16070    0.07395  -2.173   0.0303 *  
## ranktenured      -0.12623    0.06266  -2.014   0.0445 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5328 on 459 degrees of freedom
## Multiple R-squared:  0.04652,    Adjusted R-squared:  0.04029 
## F-statistic: 7.465 on 3 and 459 DF,  p-value: 6.88e-05

Exercise 11

For my guess, I believe outfits do not have a effect on the professor’s score. From the previous chart in exercise two, the majority of them do not wear formal clothes.

m_full <- lm(score ~ rank + gender + ethnicity + language + age + cls_perc_eval 
             + cls_students + cls_level + cls_profs + cls_credits + bty_avg 
             + pic_outfit + pic_color, data = evals)

Exercise 12

The chart above confirms that non formal outfits do not effect the scores. It makes the variable not statically significant with the p score above a zero. There are few other variables which do not make the cut: ranktenured and ethnicitynot minority.

Exercise 13

I assume the coefficient of ethnicitynot minority means that if the professor is white, their score is not effect by their race.

Exercise 14

The removal of P values greater than 1 shifted upwards all the remaining p values. For comparison, the previous p value of age is 0.00427 and the new is 0.02551.

m_expect <- lm(score ~  gender  + language + age + cls_perc_eval + cls_credits + bty_avg 
+ pic_color, data = evals)
summary(m_expect)

## 
## Call:
## lm(formula = score ~ gender + language + age + cls_perc_eval + 
##     cls_credits + bty_avg + pic_color, data = evals)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.81919 -0.32035  0.09272  0.38526  0.88213 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            3.967255   0.215824  18.382  < 2e-16 ***
## gendermale             0.221457   0.049937   4.435 1.16e-05 ***
## languagenon-english   -0.281933   0.098341  -2.867  0.00434 ** 
## age                   -0.005877   0.002622  -2.241  0.02551 *  
## cls_perc_eval          0.004295   0.001432   2.999  0.00286 ** 
## cls_creditsone credit  0.444392   0.100910   4.404 1.33e-05 ***
## bty_avg                0.048679   0.016974   2.868  0.00432 ** 
## pic_colorcolor        -0.216556   0.066625  -3.250  0.00124 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5014 on 455 degrees of freedom
## Multiple R-squared:  0.1631, Adjusted R-squared:  0.1502 
## F-statistic: 12.67 on 7 and 455 DF,  p-value: 6.996e-15

Exercise 15

I used the step function eliminate the terms which raised the AIC score. The results of that function created the new lm called black_list.

y= 3.9+gendermale* (0.2)+ ethnicitynot minority* (0.16)+languagenon-english * (-0.25)+age* (-0.01)+cls_perc_eval * (0.004)+ cls_creditsone credit* (0.51)+bty_avg* (0.05)+ pic_outfitnot formal* (-0.11)+pic_colorcolor* (-0.18)

step(m_full,direction = "backward")

## Start:  AIC=-630.9
## score ~ rank + gender + ethnicity + language + age + cls_perc_eval + 
##     cls_students + cls_level + cls_profs + cls_credits + bty_avg + 
##     pic_outfit + pic_color
## 
##                 Df Sum of Sq    RSS     AIC
## - cls_profs      1    0.0197 111.11 -632.82
## - cls_level      1    0.2740 111.36 -631.76
## - cls_students   1    0.3599 111.44 -631.40
## - rank           2    0.8930 111.98 -631.19
## <none>                       111.08 -630.90
## - pic_outfit     1    0.5768 111.66 -630.50
## - ethnicity      1    0.6117 111.70 -630.36
## - language       1    1.0557 112.14 -628.52
## - bty_avg        1    1.2967 112.38 -627.53
## - age            1    2.0456 113.13 -624.45
## - pic_color      1    2.2893 113.37 -623.46
## - cls_perc_eval  1    2.9698 114.06 -620.69
## - gender         1    4.1085 115.19 -616.09
## - cls_credits    1    4.6495 115.73 -613.92
## 
## Step:  AIC=-632.82
## score ~ rank + gender + ethnicity + language + age + cls_perc_eval + 
##     cls_students + cls_level + cls_credits + bty_avg + pic_outfit + 
##     pic_color
## 
##                 Df Sum of Sq    RSS     AIC
## - cls_level      1    0.2752 111.38 -633.67
## - cls_students   1    0.3893 111.49 -633.20
## - rank           2    0.8939 112.00 -633.11
## <none>                       111.11 -632.82
## - pic_outfit     1    0.5574 111.66 -632.50
## - ethnicity      1    0.6728 111.78 -632.02
## - language       1    1.0442 112.15 -630.49
## - bty_avg        1    1.2872 112.39 -629.49
## - age            1    2.0422 113.15 -626.39
## - pic_color      1    2.3457 113.45 -625.15
## - cls_perc_eval  1    2.9502 114.06 -622.69
## - gender         1    4.0895 115.19 -618.08
## - cls_credits    1    4.7999 115.90 -615.24
## 
## Step:  AIC=-633.67
## score ~ rank + gender + ethnicity + language + age + cls_perc_eval + 
##     cls_students + cls_credits + bty_avg + pic_outfit + pic_color
## 
##                 Df Sum of Sq    RSS     AIC
## - cls_students   1    0.2459 111.63 -634.65
## - rank           2    0.8140 112.19 -634.30
## <none>                       111.38 -633.67
## - pic_outfit     1    0.6618 112.04 -632.93
## - ethnicity      1    0.8698 112.25 -632.07
## - language       1    0.9015 112.28 -631.94
## - bty_avg        1    1.3694 112.75 -630.02
## - age            1    1.9342 113.31 -627.70
## - pic_color      1    2.0777 113.46 -627.12
## - cls_perc_eval  1    3.0290 114.41 -623.25
## - gender         1    3.8989 115.28 -619.74
## - cls_credits    1    4.5296 115.91 -617.22
## 
## Step:  AIC=-634.65
## score ~ rank + gender + ethnicity + language + age + cls_perc_eval + 
##     cls_credits + bty_avg + pic_outfit + pic_color
## 
##                 Df Sum of Sq    RSS     AIC
## - rank           2    0.7892 112.42 -635.39
## <none>                       111.63 -634.65
## - ethnicity      1    0.8832 112.51 -633.00
## - pic_outfit     1    0.9700 112.60 -632.65
## - language       1    1.0338 112.66 -632.38
## - bty_avg        1    1.5783 113.20 -630.15
## - pic_color      1    1.9477 113.57 -628.64
## - age            1    2.1163 113.74 -627.96
## - cls_perc_eval  1    2.7922 114.42 -625.21
## - gender         1    4.0945 115.72 -619.97
## - cls_credits    1    4.5163 116.14 -618.29
## 
## Step:  AIC=-635.39
## score ~ gender + ethnicity + language + age + cls_perc_eval + 
##     cls_credits + bty_avg + pic_outfit + pic_color
## 
##                 Df Sum of Sq    RSS     AIC
## <none>                       112.42 -635.39
## - pic_outfit     1    0.7141 113.13 -634.46
## - ethnicity      1    1.1790 113.59 -632.56
## - language       1    1.3403 113.75 -631.90
## - age            1    1.6847 114.10 -630.50
## - pic_color      1    1.7841 114.20 -630.10
## - bty_avg        1    1.8553 114.27 -629.81
## - cls_perc_eval  1    2.9147 115.33 -625.54
## - gender         1    4.0577 116.47 -620.97
## - cls_credits    1    6.1208 118.54 -612.84

## 
## Call:
## lm(formula = score ~ gender + ethnicity + language + age + cls_perc_eval + 
##     cls_credits + bty_avg + pic_outfit + pic_color, data = evals)
## 
## Coefficients:
##           (Intercept)             gendermale  ethnicitynot minority  
##              3.907030               0.202597               0.163818  
##   languagenon-english                    age          cls_perc_eval  
##             -0.246683              -0.006925               0.004942  
## cls_creditsone credit                bty_avg   pic_outfitnot formal  
##              0.517205               0.046732              -0.113939  
##        pic_colorcolor  
##             -0.180870

back_list<-lm(formula = score ~ gender + ethnicity + language + age + cls_perc_eval + 
    cls_credits + bty_avg + pic_outfit + pic_color, data = evals)
summary(back_list)

## 
## Call:
## lm(formula = score ~ gender + ethnicity + language + age + cls_perc_eval + 
##     cls_credits + bty_avg + pic_outfit + pic_color, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8455 -0.3221  0.1013  0.3745  0.9051 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            3.907030   0.244889  15.954  < 2e-16 ***
## gendermale             0.202597   0.050102   4.044 6.18e-05 ***
## ethnicitynot minority  0.163818   0.075158   2.180 0.029798 *  
## languagenon-english   -0.246683   0.106146  -2.324 0.020567 *  
## age                   -0.006925   0.002658  -2.606 0.009475 ** 
## cls_perc_eval          0.004942   0.001442   3.427 0.000666 ***
## cls_creditsone credit  0.517205   0.104141   4.966 9.68e-07 ***
## bty_avg                0.046732   0.017091   2.734 0.006497 ** 
## pic_outfitnot formal  -0.113939   0.067168  -1.696 0.090510 .  
## pic_colorcolor        -0.180870   0.067456  -2.681 0.007601 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.4982 on 453 degrees of freedom
## Multiple R-squared:  0.1774, Adjusted R-squared:  0.161 
## F-statistic: 10.85 on 9 and 453 DF,  p-value: 2.441e-15

Exercise 16

It passes all its test!

g9<-ggplot(data = back_list , aes(x = .fitted, y = .resid)) +
  geom_point() +
  geom_hline(yintercept = 0, linetype = "dashed") +
  xlab("Fitted values") +
  ylab("Residuals")+theme_classic()
g10<-ggplot(data = back_list , aes(x = .resid)) +
    geom_histogram(binwidth = 25) +
    xlab("Residuals")+theme_classic()
g11<-ggplot(data = back_list , aes(sample = .resid)) +
  stat_qq()+theme_classic()
ggarrange(g3,g4,g5)

Exercise 17

Yes, the new information influences the results given. The students who had took their courses will have a stronger opnion compared to students who will make assumptions at face value

Exercise 18

Professors who were white men with a education in a non speaking country who teaches one credit courses has higher evulations and rated with a higher beauty score.

Exercise 19

No, I would not generalized for all professors. Theses results are only relevant to the University At Austin professors, where the professor pool reflect these results. Other schools in Texas may have varying professor pools which will have different lm lines than UAA.