Introduction

The data set was a study on teacher evaluations. The data set included age, gender, minority status, a beauty standard and what evaluation score they received. I wanted to see if there was a correlation between attractiveness, gender, minority status and evaluation.

The data set has the following attributes:

minority
factor. Does the instructor belong to a minority (non-Caucasian)?
age
the professor’s age.

gender
factor indicating instructor’s gender.

credits
factor. Is the course a single-credit elective (e.g., yoga, aerobics, dance)?

beauty
rating of the instructor’s physical appearance by a panel of six students, averaged across the six panelists, shifted to have a mean of zero.

eval
course overall teaching evaluation score, on a scale of 1 (very unsatisfactory) to 5 (excellent).

division
factor. Is the course an upper or lower division course? (Lower division courses are mainly large freshman and sophomore courses)?

native
factor. Is the instructor a native English speaker?

tenure
factor. Is the instructor on tenure track?

students
number of students that participated in the evaluation.

allstudents
number of students enrolled in the course.

prof
factor indicating instructor identifier.

Hypothesis

Is there a suggested correlation between gender, age and “beauty” rating to teachers student evaluation and tenure status? Through graphical outputs I will show:

  1. Gender
    • Gender and student evaluations
    • Gender and tenure status
  2. Age
    • Age and student evaluations
    • Age and tenure status
  3. Beauty
    • Beauty and student evaluations
    • Beauty and tenure
library(curl)
## Using libcurl 7.64.1 with Schannel
teaching_ratings_url <- "https://raw.githubusercontent.com/moiyajosephs/R-Homework-2/main/TeachingRatings.csv"
teaching_ratings <- read.csv(curl(teaching_ratings_url))
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)

Data Exploration

summary(teaching_ratings)
##        X           minority              age           gender         
##  Min.   :  1.0   Length:463         Min.   :29.00   Length:463        
##  1st Qu.:116.5   Class :character   1st Qu.:42.00   Class :character  
##  Median :232.0   Mode  :character   Median :48.00   Mode  :character  
##  Mean   :232.0                      Mean   :48.37                     
##  3rd Qu.:347.5                      3rd Qu.:57.00                     
##  Max.   :463.0                      Max.   :73.00                     
##    credits              beauty                eval         division        
##  Length:463         Min.   :-1.4504940   Min.   :2.100   Length:463        
##  Class :character   1st Qu.:-0.6562689   1st Qu.:3.600   Class :character  
##  Mode  :character   Median :-0.0680143   Median :4.000   Mode  :character  
##                     Mean   : 0.0000001   Mean   :3.998                     
##                     3rd Qu.: 0.5456024   3rd Qu.:4.400                     
##                     Max.   : 1.9700230   Max.   :5.000                     
##     native             tenure             students       allstudents    
##  Length:463         Length:463         Min.   :  5.00   Min.   :  8.00  
##  Class :character   Class :character   1st Qu.: 15.00   1st Qu.: 19.00  
##  Mode  :character   Mode  :character   Median : 23.00   Median : 29.00  
##                                        Mean   : 36.62   Mean   : 55.18  
##                                        3rd Qu.: 40.00   3rd Qu.: 60.00  
##                                        Max.   :380.00   Max.   :581.00  
##       prof      
##  Min.   : 1.00  
##  1st Qu.:20.00  
##  Median :44.00  
##  Mean   :45.43  
##  3rd Qu.:70.50  
##  Max.   :94.00

Here I used the summary function to get a general view of the data set at hand. I could see that there are 463 data points in total. At an initial glance I can see the evaluation scores have a minimum of 2, even though the lowest score possible is 1. There is also teachers who received a rating of 5. This is a statistic that is subjective so it is interesting to note that the mean score of 3.99 indicates that most teachers have a high evaluation score.
In terms of the age attribute the youngest teacher is 29 years old while the oldest is 73. This is quite a large range and it would be interesting to see if the different age groups have any relationship to their evaluations.
The beauty attribute is subjective like the evaluation scores. According to the data set source, the beauty score was judged by 6 students and averaged to a mean of zero. There was a teacher who had a maximum of 1.97 which is only .03 away from the maximum beauty value of 2. In order to see any trends in the beauty scoring I will be dividing it in half based on 0.

Gender

To begin evaluating based on gender I did a simple bar plot to see how much male teachers there are to female.

#count how much women and how much menu
count <- table(teaching_ratings$gender)
barplot(count, main="gender",
  xlab="Number of Females and Males", col=c("darkblue","red"),
  legend = rownames(count))

The bar plot above shows that there are far more male to female teachers in this study.

Gender and tenure status

counts <- table( teaching_ratings$tenure, teaching_ratings$gender)
barplot(counts, main="Gender and tenure status",
  xlab="Gender", col=c("darkblue","red"),
  legend = rownames(counts))

When comparing the gender of the teachers and the tenure status, the bar plot shows their are more male tenured teachers than female. From the looks of the bar plot, the tenured male teachers is about 200 teachers out of about 260, while the female tenured professors are about 150 out of a total 200. To get a more detailed picture I counted the amount of female and male teachers and grouped them by their tenure status as shown below.

teaching_ratings %>% group_by(tenure) %>% count(gender)
## # A tibble: 4 x 3
## # Groups:   tenure [2]
##   tenure gender     n
##   <chr>  <chr>  <int>
## 1 no     female    50
## 2 no     male      52
## 3 yes    female   145
## 4 yes    male     216

According to the table 216 male teachers and 145 female teachers that have tenure.

Student Evaluation and beauty rating based on gender

Next to get a look at the differences between the evaluation scores grouped by gender I made two new data sets for each gender, as shown below.

library(dplyr)
female_teachers = teaching_ratings %>% filter(gender == "female")
male_teachers = teaching_ratings %>% filter(gender == "male")

Next I used ggplot to plot both the female and male teachers beauty and evaluation. I hoped to see a trend, for example, the female teachers would have higher evaluation with their beauty. However, I found that since the data set was so large and not uniform, the line graph was not easy to read.

p = ggplot() + 
  geom_line(data = sample_n(female_teachers,100), aes(x = beauty, y = eval), color = "blue") +
  geom_line(data = sample_n(male_teachers,100), aes(x = beauty, y = eval), color = "red") +
  xlab('beauty') +
  ylab('eval')

print(p)

I decided to plot the female and male evaluations and beauty scores seperately. First the female line chart:

Female evaluation vs beauty

ggplot(data=female_teachers, aes(x=beauty, y=eval)) +
  geom_point() + geom_smooth(method = lm)
## `geom_smooth()` using formula 'y ~ x'

When using ggplots trend line function, there seems to be a trend where the higher the beauty score, the higher the evaluation. There is however a data point around the beauty score of 0 that has a evaluation of about 5. Still after a beauty score of 1, the evaluations are all 3 and higher.

Male evaluation vs beauty

When plotting the male evaluation vs beauty the slope is increasing. There are also more data sets at the maximum evaluation score line. Still, the evaluation and beauty trend line is increasing, suggesting the same as with the female professors. After a beauty score of 1, the evaluations are greater than 3.

ggplot(data=male_teachers, aes(x=beauty, y=eval)) +
  geom_point() + geom_smooth(method = lm)
## `geom_smooth()` using formula 'y ~ x'

Evaluations side by side

To get a side by side comparison I used boxplots to see the range in evaluation values.

female_eval <- female_teachers$eval
male_eval <- male_teachers$eval

boxplot(female_eval, male_eval, main = "Evaluations", names = c("female eval", "male eval"), col = c("orange","red"), xlab="gender", y="eval")

In case there is a correlation between beauty and evaluation it might be helpful to see the beauty range between females and males.

female_beauty <- female_teachers$beauty
male_beauty <- male_teachers$beauty

boxplot(female_beauty, male_beauty, main = "beauty", names = c("female beauty", "male beauty"), col = c("orange","red"), xlab="gender", y="beauty")

The female beauty score has a higher maximum when compared to the male beauty score, but the male evaluations achieved the maximum 5. It is difficult to see with the box plots whether or not there is a trend when combining three attributes of gender, beauty and evaluation. The box plot does highlight the males achieve higher evaluation scores than females.

Age

Next, I wanted to see any correlation based on age. For example if there was a trend between age and evaluation and beauty scores and tenure status.

Age by Evaluation

# age by eval

ggplot(data=teaching_ratings, aes(x=age, y=eval)) +
  geom_point() + geom_smooth(method = lm)
## `geom_smooth()` using formula 'y ~ x'

As you can see there is a trend line going downwards but not by a steep slope. To get a better sense of the differences between the ages I separated the teacher ratings data set to be two different data sets, middle aged and senior. I know from my summary function the range of the ages for the teachers, and there is a maximum of 73 years old, so I split it at 50 years old.

teaching_middleage = teaching_ratings %>% filter(age < 50)
teaching_senior = teaching_ratings %>% filter(age >= 50)

Now with the teaching_middle age representing the data sets less than 50 years old and the teaching_senior representing the teachers 50 and older I used a box plot to see the difference in evaluation based on the two age groups.

boxplot(teaching_middleage$eval, teaching_senior$eval, main = "evaluation by age group", names = c("middle age evaluations", "senior evaluations"), col = c("orange","red"), xlab = "age", y="eval")

As shown in the box plot above the middle age teachers evaluations had a smaller range and smaller maximum than those of teachers 50 and older. However they did have a few minimum outliers that were less than those of the middle age evaluations.

Age by Beuaty

Out of curiosity since I did gender and beauty comparison I did an age and beauty comparison as well.

# age by beauty

ggplot(data=teaching_ratings, aes(x=age, y=beauty)) +
  geom_point() + geom_smooth(method = lm)
## `geom_smooth()` using formula 'y ~ x'

This trend line was the most pronounced as it decreases as teachers age, an interesting observation. There are some outliers, for example, a teacher about 35 years old did receive a beauty score below -1. Around 50, the beauty score maintains around the averaged mean of 0. After 65, the beauty score did not go above -0.5. It is further emphasized when comparing the two age groups.

boxplot(teaching_middleage$beauty, teaching_senior$beauty, main = "beauty by age group", names = c("middle age evaluations", "senior evaluations"), col = c("orange","red"), xlab = "age", y="eval")

Tenure status and age groups

tenure_status_middle <- table(teaching_middleage$tenure)
tenure_status_senior <- table(teaching_senior$tenure)
test <- cbind(tenure_status_middle,tenure_status_senior)
barplot(test,beside=T,col=c("darkblue","red"), xlab="Age Group",legend = rownames(tenure_status_middle))

According to the above histogram the tenured positions are held in majority by middle ages teachers than senior ones. There are also a wider range between the middle age tenured teachers than the senior. Again to get a more detailed view I grouped by tenures position and filtered the ages.

teaching_ratings %>% group_by(tenure) %>% count(age > 50)
## # A tibble: 4 x 3
## # Groups:   tenure [2]
##   tenure `age > 50`     n
##   <chr>  <lgl>      <int>
## 1 no     FALSE         59
## 2 no     TRUE          43
## 3 yes    FALSE        200
## 4 yes    TRUE         161

The table above shows that the amount of teachers who have tenure and are less than 50 years old is 200, while the amount that do have tenure and are greater than 50 is 161. Again quantifying the graphical output above where there are more middle ages teachers with tenure.

Beauty

Finally, I took a look at the beauty attribute in comparison to evaluation scores and tenured status.

Beauty and evaluation

Below, I used the plot function to chart the evaluation score compared to beauty. I already had an idea it would trend upwards due to the previous plot lines when comparing based on gender.

## evaluation score vs. beauty
plot(eval ~ beauty, data = teaching_ratings)
fm <- lm(eval ~ beauty, data = teaching_ratings)
abline(fm)

library(ggplot2)
ggplot(data=teaching_ratings, aes(x=beauty, y=eval)) +
  geom_point() + geom_smooth(method = lm)
## `geom_smooth()` using formula 'y ~ x'

Here is the same graph but using ggplot instead. The difference here there is a standard deviation region shaded in. As expected as beauty scores increase the evaluation scores also increase. Even thought there are varied data sets throughout the graph, towards the maximum beauty score, the evaluations are all greater than 3. When looking at a poor beauty score, less than -1 for example, the evaluation scores trends to about 2.

Beauty and Tenure

For beauty and tenure I used a pie chart to show the difference between beauty scores and tenured position. I achieved this by dividing the data set to be either higher than 0, indicating a high score, or less than 0 for a poor score.

library(dplyr)

teaching_beauty_poor = teaching_ratings %>% filter(beauty <= 0)
teaching_beauty_pretty = teaching_ratings %>% filter(beauty > 0)

pie(table(teaching_beauty_poor$tenure), main="Pie chart of beauty tenure")

The pie chart above shows there amount of people tenured and have a beauty score below 0 is greater than the people who are not tenured.

pie(table(teaching_beauty_pretty$tenure), main="Pie chart of beauty tenure")

Following, the beauty score of over 0 did not change the amount of people who have tenure in comparison to the amount that do not. From the pie chart alone it is hard to see if there is a difference between the two groups, so I used the library lessR to get the percentages and to get a more detailed conclusion.

tenure_poor <- data.frame(ten_poor = teaching_beauty_poor$tenure)
#install.packages("lessR")
library(lessR)
## 
## lessR 4.1.3  feedback: gerbing@pdx.edu  web: lessRstats.com/new
## ---------------------------------------------------------------
## > d <- Read("")   Read text, Excel, SPSS, SAS, or R data file
##   d is default data frame, data= in analysis routines optional
## 
## Learn about reading, writing, and manipulating data, graphics,
## testing means and proportions, regression, factor analysis,
## customization, and descriptive statistics from pivot tables.
##   Enter:  browseVignettes("lessR")
## 
## View changes in this new version of lessR.
##   Enter: help(package=lessR)  Click: Package NEWS
##   Enter: interact()  for access to interactive graphics
## 
## Attaching package: 'lessR'
## The following object is masked from 'package:dplyr':
## 
##     recode
PieChart(ten_poor, hole = 0, values = "%", data = tenure_poor,
         fill = c("lightblue", "pink"), main = "")

## >>> Suggestions
## PieChart(ten_poor, hole=0)  # traditional pie chart
## PieChart(ten_poor, values="%")  # display %'s on the chart
## BarChart(ten_poor)  # bar chart
## Plot(ten_poor)  # bubble plot
## Plot(ten_poor, values="count")  # lollipop plot 
## 
## --- ten_poor --- 
## 
##                   no    yes     Total 
## Frequencies:      59    217       276 
## Proportions:   0.214  0.786     1.000 
## 
## Chi-squared test of null hypothesis of equal probabilities 
##   Chisq = 90.449, df = 1, p-value = 0.000

According to the pie chat above 79% of the teachers who have a beauty score below 0 are tenured.

tenure_pretty <- data.frame(ten_pretty = teaching_beauty_pretty$tenure)
PieChart(ten_pretty, hole = 0, values = "%", data = tenure_pretty,
         fill = c("lightblue", "pink"), main = "")

## >>> Suggestions
## PieChart(ten_pretty, hole=0)  # traditional pie chart
## PieChart(ten_pretty, values="%")  # display %'s on the chart
## BarChart(ten_pretty)  # bar chart
## Plot(ten_pretty)  # bubble plot
## Plot(ten_pretty, values="count")  # lollipop plot 
## 
## --- ten_pretty --- 
## 
##                   no    yes     Total 
## Frequencies:      43    144       187 
## Proportions:   0.230  0.770     1.000 
## 
## Chi-squared test of null hypothesis of equal probabilities 
##   Chisq = 54.551, df = 1, p-value = 0.000

While the amount of tenured teachers who have a beauty score above 0 is 77% of the teachers. The percentages are not wide in range but it does show, at least in this data set, that the beauty score under 0 has a higher amount teachers with tenure.

Conclusion

Basic transformations on the data to help analyze like dividing by age and dividing by gender to see better trends in the graphical outputs.
From these graphical outputs I can conclude there is possible trend between beauty and evaluation scores. Even when separating by gender the higher the beauty score, the trend line indicated that the evaluation score would increase as well. However when looking at the evaluation scores and not including beauty, males tend to perform better than females. They also had a higher population of tenured teachers. The most surprising statistic was the fact that teachers younger than 50 had a higher percentage of tenured status. There does not seem to be a direct correlation between beauty scores and tenured status. The strongest correlation seems to be gender and student evaluations/tenure status and I would conclude based on this data set that males have a higher chance of having both a high evaluation score and tenure.