load(url("http://www.openintro.org/stat/data/evals.RData"))
library(ggplot2)

Question 1: Create a scatter plot to explore the relationship between X = beauty score and Y = evaluation score. Make sure to label your axes!

ggplot(evals, aes(x=bty_avg, y = score)) + geom_point() + labs(title="Figure 1", x = "Beauty Score", y = "Evaluation Score")

Question 2: Based on the plot, does there seem to be a relationship between beauty score and evaluation score?

Based on Figure 1, there appears to be a very weak positive linear relationship with several outliers. These outliers appear to occur around (5, 2.5), (1.5, 2.5), (1.5, 2.4), and (4, 2.5). Based on this graph alone, I would not be confident to suggest that there is a relationship between the two variables without further analysis.

Question 3: Fit an LSLR model to predict Y based on X

evalsmodel <- lm(score ~ bty_avg, data = evals )
ggplot( evalsmodel , aes( x = bty_avg, y = score) ) + geom_point( ) + geom_smooth(method="lm", se=FALSE) + labs(title="Figure 2", x = "Beauty Score", y = "Evaluation Score")
## `geom_smooth()` using formula 'y ~ x'

summary(evalsmodel)
## 
## 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
evalsmodel$coefficients
## (Intercept)     bty_avg 
##  3.88033795  0.06663704

The LSLR line is \[\widehat{EvaluationScore} = 3.88034 + 0.06664(BeautyScore)\]

Question 4: Make and interpret a 95% confidence interval for the slope for beauty score.

N = 463, df = n-2, so df = 461

qt(0.95, df=461)
## [1] 1.648166

95% CI: 0.06664 (1.648166)(0.01629) 95% CI: 0.06664 (0.026849) 95% CI: (0.0398, 0.0935) We are 95% confident that for each point increase in beauty score, we expect the average evaluation score to increase between 0.0398 and 0.0935 points.

Question 5: What is the R-squared for your model? Based on this, would you recommend we put much trust in this confidence interval? Explain.

The R-squared of this model is 0.03502, meaning that this model accounts for 3.5% of the variance in the evaluation score. This is a very low number, so I do not think that this model suits this data set well. Therefore, I would not put trust into the confidence interval.

Question 6: Based on the interval, does beauty score appear to be a practically significant predictor? Explain.

The range of evaluation score in our 95% confidence interval is from 0.0398 to 0.0935 points. That small amount of predicted change for every one point increase in beauty score does not suggest that evaluation score is practically predicted by beauty score. Therefore, even if the amount is significant when looking at the p-values, in practicality beauty score does not appear to be a practically significant predictor.

Question 7: Write down the LSLR line for Y = evaluation score and X = class level. Interpret the slope and intercept

m_level <-lm(score~ cls_level, data = evals)
summary(m_level)
## 
## Call:
## lm(formula = score ~ cls_level, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8422 -0.3422  0.1578  0.4578  0.8578 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     4.23822    0.04330  97.881   <2e-16 ***
## cls_levelupper -0.09606    0.05326  -1.804    0.072 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5425 on 461 degrees of freedom
## Multiple R-squared:  0.007006,   Adjusted R-squared:  0.004852 
## F-statistic: 3.253 on 1 and 461 DF,  p-value: 0.07196

The LSLR line is \[\widehat{EvaluationScore} = 4.238 - 0.096(ClassLevelUpper)\] We predict that the average evaluation score for an upper class professor will be 0.096 points lower than a lower class professor. We predict that the average evaluation score for a lower class professor to be 4.238 points.

Question 8: What is the baseline for the variable pic_outfit?

The baseline for the pic_outfit variable is formal. There are two levels, formal and not formal, and formal comes first in the summary table. Therefore, R codes formal as the baseline variable, so not formal is the indicator variable.

m_outfit <-lm(score~ pic_outfit, data = evals)
summary(m_outfit)
## 
## Call:
## lm(formula = score ~ pic_outfit, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8655 -0.3655  0.1345  0.4345  0.8345 
## 
## Coefficients:
##                      Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           4.22078    0.06200  68.075   <2e-16 ***
## pic_outfitnot formal -0.05524    0.06790  -0.813    0.416    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5441 on 461 degrees of freedom
## Multiple R-squared:  0.001433,   Adjusted R-squared:  -0.0007329 
## F-statistic: 0.6617 on 1 and 461 DF,  p-value: 0.4164

Question 9: Using a significance level of 0.001, do we have evidence that the coefficient for beauty average is different from 0, even with our new predictor added in? Has the addition of class level to the model changed the estimated slope for beauty average? If so, by how much?

m_bty_level <- lm(score ~ bty_avg + cls_level, data = evals)
summary(m_bty_level)
## 
## Call:
## lm(formula = score ~ bty_avg + cls_level, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8938 -0.3452  0.1422  0.4132  0.9595 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.94321    0.08456  46.632  < 2e-16 ***
## bty_avg         0.06570    0.01627   4.039  6.3e-05 ***
## cls_levelupper -0.08885    0.05243  -1.695   0.0908 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5338 on 460 degrees of freedom
## Multiple R-squared:  0.04101,    Adjusted R-squared:  0.03684 
## F-statistic: 9.836 on 2 and 460 DF,  p-value: 6.565e-05

The p-value for beauty average is 6.3e-05, which is marked as significant even at the significance level of 0.001. Therefore, we do have evidence that the coefficient for beauty average is different from 0, even with the new predictor added in. The addition of class level to the model made the slope for beauty score to be 0.0657, and it used to be 0.06664. Therefore, the addition of class level decreased the slope of beauty score by 9.4e-4.

Question 10: For your current model using beauty average and class level to predict evaluation score, write out the LSLR line corresponding to upper level classes.

The LSLR line is \[\widehat{EvaluationScore} = 3.943 - 0.0889(ClassLevelUpper) + 0.0657(BeautyScore)\]

ggplot(evals, aes(bty_avg, score, col = cls_level)) + geom_abline(intercept = 3.94321 , slope= 0.0657, lty=1, col="red") + geom_abline(intercept = 3.94321 - 0.08885 , slope= 0.0657, col="blue") + geom_point()

Question 11: Add a title and appropriate axis labels to the graph.

ggplot(evals, aes(bty_avg, score, col = cls_level)) + geom_abline(intercept = 3.94321 , slope= 0.0657, lty=1, col="red") + geom_abline(intercept = 3.94321 - 0.08885 , slope= 0.0657, col="blue") + geom_point() + labs(title="Figure 3", x = "Beauty Score", y = "Evaluation Score")

Question 12: For two classes, one lower level class and one upper level class, whose professors recieved the same beauty rating, the upper level course professor is predicted to have the higher course evaluation score.

False. The upper level course professors on average have lower course evaluation scores.

Question 13: Consider the variable rank. How many levels does this variable have? What are they? Which of these levels is the baseline?

The variable rank has three levels - teaching, tenure track, and tenured. The baseline is the first level to appear in the summary, which would be teaching.

m_rank <-lm(score~ rank, data = evals)
summary(m_rank)
## 
## Call:
## lm(formula = score ~ rank, data = evals)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.8546 -0.3391  0.1157  0.4305  0.8609 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       4.28431    0.05365  79.853   <2e-16 ***
## ranktenure track -0.12968    0.07482  -1.733   0.0837 .  
## ranktenured      -0.14518    0.06355  -2.284   0.0228 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.5419 on 460 degrees of freedom
## Multiple R-squared:  0.01163,    Adjusted R-squared:  0.007332 
## F-statistic: 2.706 on 2 and 460 DF,  p-value: 0.06786

Question 14: Create a new model called m_bty_rank with class removed and rank added in. How many coefficients for rank are in the model?

Rank has two coefficients, one for tenure track and one for tenured.

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

Question 15: Write down the LSLR lines for (1) tenure track, (2) tenured, and (3) teaching track faculty. This means you should have 3 lines. When you write out the model, you will have some terms that are just numbers, i.e., are not attached to an X. Combine these when you write down the models. Is the slope different across these three models? What about the intercept?

  1. The LSLR line for tenure track is is \[\widehat{EvaluationScore} = 3.982 - 0.161(1) - 0.126(0) + 0.0678(BeautyScore)\]

which can then be condensed to \[\widehat{EvaluationScore} = 3.821 + 0.0678(BeautyScore)\] (2) The LSLR line for tenured is \[\widehat{EvaluationScore} = 3.982 - 0.161(0) - 0.126(1) + 0.0678(BeautyScore)\] which can then be condensed to \[\widehat{EvaluationScore} = 3.856 + 0.0678(BeautyScore)\] (3) The LSLR line for teaching track faculty is \[\widehat{EvaluationScore} = 3.982 - 0.161(0) - 0.126(0) + 0.0678(BeautyScore)\] which can then be condensed to \[\widehat{EvaluationScore} = 3.982 + 0.0678(BeautyScore)\]

The slope of the line is not different across the LSLR lines, but the intercepts are different. ## Question 16: Adapt the code from Question 11 to plot the average beauty score vs the evaluation score by gender. Show the graph.

m_bty_gender <- lm(score ~ bty_avg + gender, data = evals)
summary(m_bty_gender)
## 
## 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
ggplot(evals, aes(bty_avg, score, col = gender)) + geom_abline(intercept = 3.94321 , slope= 0.0657, lty=1, col="red") + geom_abline(intercept = 3.94321 - 0.08885 , slope= 0.0657, col="blue") + geom_point() + labs(title="Figure 4", x = "Beauty Score", y = "Evaluation Score")

Question 17: Based on your model, interpret the slope for ranktenuretrack.

After controlling for beauty score, we predict that the average evaluation score for a professor on tenure track will be 0.161 points lower than a professor on a teaching track.

Question 18: Which of the following is the correct order of the three levels of rank is were to order them from lowest predicted course evaluation score to the highest predicted course evaluation score?

From lowest to highest predicted evaluation score, it would be tenure track, tenured, and teaching. (option C)