In karantibrewal/williams: Williams College Related Metrics

knitr::opts_chunk$set(tidy = FALSE,
                      echo = FALSE, 
                      message = FALSE, 
                      warning = FALSE)

Introduction

This document provides an overview of the data available in the wiliams package. We have data on the faculty and graduates of Williams College from the 2000--2001 through 2016--2017 academic years, obtained from archived course catalogs.

library(dplyr)
library(stringr)
library(ggplot2)
library(williams)
x <- create_graduates(complete = TRUE)

Graduates

There were r dim(x)[1] graduates of Williams from r min(x$year) through r max(x$year). The number of graduates averages about r round(mean(table(x$year))) per year. The largest class was r as.numeric(tail(sort(table(x$year)), n = 1)) in r as.numeric(names(tail(sort(table(x$year)), n = 1))). The smallest was r as.numeric(head(sort(table(x$year)), n = 1)) in r as.numeric(names(head(sort(table(x$year)), n = 1))).

Names

Names are interesting. The graduate with the longest name is r x %>% select(year, full.name) %>% filter(min_rank(-nchar(full.name)) < 2) %>% as.character() %>% tail(1) from the class of r x %>% select(year, full.name) %>% filter(min_rank(-nchar(full.name)) < 2) %>% as.character() %>% head(1). The students with the shortest names are:

x %>% select(year, full.name) %>% filter(min_rank(nchar(full.name)) < 2) %>% as.data.frame()

The students with the longest last name and first name are:

x %>% select(year, full.name, first.name, last.name) %>% filter(min_rank(-nchar(first.name)) < 2 | min_rank(-nchar(last.name)) < 2) %>% select(-first.name, -last.name) %>% as.data.frame()

The students with at least 5 separate parts to their full names are:

x[str_split(x$full.name, " ", simplify = TRUE)[,5] != "",] %>% select(year, full.name) %>% as.data.frame()

Gender

The course catalogs do not provide the gender of the graduates, so we estimate it by using the gender and genderizeR package.

These packages predict gender on the basis of names. We first use the gender package to predict gender according to the first and middle names of graduates. Alas, the gender package focuses heavily on American names, and therefore, this approach is ineffective for non-American names like DoHyun and Qiang.

To account for this shortcoming, we supplement the gender package with the genderizeR package which provides more global coverage. However, this is a paid service that limits free access. So, we used it once and then saved the results.

Our gender variable looks like:

table(x$gender, exclude = NULL)

x %>% filter(is.na(gender)) %>% select(first.name, gender) %>% group_by(first.name, gender) %>% summarize(count = n()) %>% arrange(desc(count)) %>% as.data.frame() %>% head(12)

Most of the NAs for gender are due to unique first names, names that appear only once amoung the r dim(x)[1] graduates. Eventually, we might fix some of these by hand. But, for now, we see no reason why these NA should bias any of the later analysis.

x %>% select(year, gender) %>% count(year, gender) %>% mutate(percentage = n/sum(n)) %>% ggplot(aes(year, percentage, color = gender)) + geom_line()

Race

We use the wru package to estimate race. The totals for the entire data set are:

table(x$race, exclude = NULL)

Judging by the the College's public statements and Common Data Set releases, we are significantly overestimating the percentage of white students.

round(prop.table(table(x$race)), 3)

The "Other" category includes only a handful of students:

x %>% filter(race == "Other") %>% select(full.name, race) %>% as.data.frame()

There is no publicly available source for the racial breakdown of the graduating class. (True? Check NEPS.) The 2015--2016 Common Data Set reports that, among all degree-seeking undergraduates at Williams, r round(243/2065, 2) Asian, r round(157/2065, 2) were Black, r round(261/2065, 2) Hispanic, r round(1106/2065, 2) White, and r round((161 + 4 + 133)/2065, 2) in other categories, including Nonresident Aliens, American Indian or Two-or-more races.

Our estimates for non-White students are too low. First, we don't even find the same number of Asian/Black/Hispanic students are we know to be at Williams among the US citizen portion of the population. Second, we categorize some/many of the students in the other categories (most importantly the international and multi-racial students) as being in non-White categories even though they are not so classified by Williams.

As an example, we classify Paige Lauren Whidbee '16 as Black. She is the only Phi Beta Kappa member of the class of 2016 that we so classify. However, according to this photo, she probably isn't African-American.

x %>% select(year, race) %>% count(year, race) %>% mutate(percentage = n/sum(n)) %>% ggplot(aes(year, percentage, color = race)) + geom_line()

Effect of Race and Gender on Latin Honors, Phi Beta Kappa, and Sigma Xi

The College awards latin honors by the following rules:

• 35% of the graduating class -- Bachelor of Arts cum laude or higher
• 15% of the graduating class -- Bachelor of Arts magna cum laude or higher
• 2% of the graduating class -- Bachelor of Arts summa cum laude

The remaining 65% receive no honors.

round(prop.table(table(graduates$latin.honors))*100, 2)

The college inducts students of the highest academic standing to the Phi Beta Kappa Society. At the end of the junior year, all students in the highest five percent of the class, ranked by cumulative grade point average, shall be eligible for election. At the end of their senior year, students in the top 12.5 percent of the class, excluding those already elected, are eligible for election.

round(prop.table(table(graduates$Phi.Beta.Kappa))*100, 2)

The Williams College Sigma Xi Chapter recognizes students "graduating science students who have demonstrated exceptional ability and promise for further contributions to the advancement of scientific research".

round(prop.table(table(graduates$Sigma.Xi))*100, 2)

Since colleges are (rightly!) protective about GPA data, latin honors and membership of these societies can be effective proxies for academic excellence. Here, we will study the effect of race and gender on such measures of academic excellence.

Let us first look at Sigma Xi. Figure # shows the percentage of male and female students inducted into Sigma Xi from 2000 to 2016. We run a logistic regression of the binary variable indicating membership into Sigma Xi on gender. The regression equation is:

$$\hat{p} = \beta_0 + \beta_1 genderMale$$

where, $\hat{p}$ is the probability that a graduate is inducted into Sigma Xi, and $genderMale$ is an indicator variable with value $1$ if the graduate is male, and $0$ if the graduate is female. The results for this regression are summarized in Table # below. We find that on average, males are slightly more likely to be inducted into Sigma Xi, but the effect is neither statistically significant, nor large in magnitude.

x <- graduates %>% dplyr::filter(Sigma.Xi) %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(gender, total, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
ggplot(x, aes(x = year, y = percent, fill = gender)) + geom_bar(stat = "identity", position = "dodge") + labs(x = "Year", y = "Percent")

l.gender.Sigma.Xi <- lm(graduates$Sigma.Xi~graduates$gender)
summary(l.gender.Sigma.Xi)

Consider race: we run a similar logistic regression of the binary variable indicating membership into Sigma Xi on the race. The regression equation is of the form:

$$\hat{p} = \beta_0 + \beta_1 raceBlack + \beta_2 raceHispanic + \beta_3 raceWhite$$

where, $\hat{p}$ is the probability that a graduate is inducted into Sigma Xi, and $raceBlack$ is an indicator variable with value $1$ if and only if the graduate is Black, $raceHispanic$ is an indicator variable with value $1$ if and only if the graduate is Hispanic, and $raceWhite$ is an indicator variable with value $1$ if and only if the graduate is White. The results are summarized below in table #.

We find that asians are the most likely to be inducted into Sigma Xi, followed by Whites, Hispanics, and Blacks (in that order). Evidence to support this assertion is significant at the 0.001 level. In fact, our point estimates suggest that Asians are almost twice as likely to be inducted into Sigma Xi, compared to Blacks or Hispanics.

x <- graduates %>% dplyr::filter(Sigma.Xi, ! race == "Other") %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(race, total, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
ggplot(x, aes(x = year, y = percent, fill = race)) + geom_bar(stat = "identity", position = "dodge") + labs(x = "Year", y = "Percent")

l.race.Sigma.Xi <- lm(x$Sigma.Xi~x$race)
summary(l.race.Sigma.Xi)

Indeed, membership into Sigma Xi is not the perfect proxy for academic excellence. For starters, membership recognizes "exceptional ability and promise for further contributions to the advancement of scientific research", and therefore, obviously disadvantages students in non-scientific discplines. Further, membership is by nomination, which opens the question of any artificial bias.

On the other hand, Suma Cum Laude and Phi Beta Kappa recognizes students solely by academic performance (their GPA). As of such, they are perhaps, better proxies for academic excellence. Let us look at how race and gender effects these at Williams College.

x <- graduates %>% dplyr::filter(Phi.Beta.Kappa) %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(gender, total, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
p1 <- ggplot(x, aes(x = year, y = percent, fill = gender)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Gender and Phi Beta Kappa at Williams College", x = "Year", y = "Percent") 
x <- graduates %>% dplyr::filter(latin.honors == "Summa Cum Laude") %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(gender, total, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
p2 <- ggplot(x, aes(x = year, y = percent, fill = gender)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Gender and Suma Cum Laude at Williams College", x = "Year", y = "Percent")
p1
p2

As before, we run logistic regressions of membership in Phi Beta Kappa and conferral of Suma Cum Laude on gender. As with Sigma Xi, these proxies for academic excellence seem to be completely unaffected by gender. The results of the regression are summarized in Table # and Table #.

l.gender.PBK <- lm(graduates$Phi.Beta.Kappa~graduates$gender)
summary(l.gender.PBK)

graduates$is.suma <- graduates$latin.honors == "Summa Cum Laude"
l.gender.Summa <- lm(graduates$is.suma~graduates$gender)
summary(l.gender.Summa)

What about race? Figure # shows the distribution of races in Phi Beta Kappa members and Summa Cum Laude awardees from 2000 to 2016.

x <- graduates %>% dplyr::filter(Phi.Beta.Kappa) %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(race, total, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
p1 <- ggplot(x, aes(x = year, y = percent, fill = race)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Race and Phi Beta Kappa at Williams College", x = "Year", y = "Percent") 
x <- graduates %>% dplyr::filter(latin.honors == "Summa Cum Laude") %>% dplyr::group_by(year) %>% mutate(total = n()) %>% group_by(race, add = TRUE) %>% dplyr::mutate(percent = n()/ total * 100)
p2 <- ggplot(x, aes(x = year, y = percent, fill = race)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Race and Suma Cum Laude at Williams College", x = "Year", y = "Percent")
p1
p2

In a decade and half worth data, we do not classify a single graduate receiving Summa Cum Laude honors as Hispanic. Is this, in fact, true? Indeed, we performed Google searches on Summa Cum Laude graduates over the last 10 years (Good news: Finishing on the top 2% of your class at Williams almost certainly garauntees that you are very Google-able), but we do not find any data to suggest otherwise.

Black graduates follow a similar pattern. In fact, in the last 10 years, we classify 2 graduates receiving Summa Cum Laude as Black. Unfortonately, neither of the two, Blake Mackall nor Erika Williams, is in fact black. Then, as far as we can tell, no Black Williams student graduated with Suma Cum Laude in the last decade.

Results from our regression models are summarized in Tables # and #. We find that Asians are significantly (at the 0.01 level) more likely to be members of Phi Beta Kappa and awarded Suma Cum Laude than Blacks or Hispanics.

l.race.PBK <- lm(graduates$Phi.Beta.Kappa~graduates$race)
summary(l.race.PBK)

graduates$is.suma <- graduates$latin.honors == "Summa Cum Laude"
l.race.Summa <- lm(graduates$is.suma~graduates$race)
summary(l.race.Summa)

Our data provides strong evidence that on average, Asians at Williams College academically out perform their counterparts from other minority groups. What might be driving this effect?

• The Athlete Effect
  The 2009 Report by the Athletics Committee: Varsity Athletes and Academics finds that athletes in high-profile varsity sports under perform even after accounting for academic qualifications prior to enrolling at Williams College, socio-economic status, and the individual’s year (e.g. sophomore, senior). Asians are definitely underrepresented at these sports, and therefore, controlling for "high-profile varsity athlete" status will give us a clearer picture on the effect of race on academic excellence at Williams.

• Asians are over represented in international students
  Although there is no publically available work studying the academic performance of international students at Williams, there is (some evidence)[http://ephblog.com/2006/05/25/international-student-qualifications-and-performance/] to suggest that they fare better academically than their domestic counterparts. In so much that there are more Asian international students than those from other minority groups, this effect maybe biasing our findings.

• It's a preference thing
  On average, do Asians value academic recognition more than their counterparts from other minority groups? This line of thinking advocates that in reality, other minority groups are academically as capable as Asians at Williams, but Asians value academic recognition more highly, and therefore, have more incentive to spend, say, another 10 hours in the library every week to boost their GPAs from 3.90 to 4.00, while others rather spend this time joining an a cappella group, or even just hang out more in the common room. That is, if other minority groups really wanted that 4.00, they could get it.
  If this was true, we might expect Asians, in their pursuit of academic recognition, to cut corners and take easier classes. Figure # shows number of Asians who wrote a thesis during their senior year at Williams by department. We see that a fair amount of Asians major in disciplines like Physics, Chemistry, and Mathematics that a recent Record article finds to be the "most rigorous majors" according to Williams College students. Of course, this data is far from conclusive: firstly, we only have department information about Asians that wrote a thesis; secondly, it might so be that Asians major in these rigorous disciplines, but tend to take easier classes within the discplines.

asianSumma <- filter(graduates, race == "Asian", ! is.na(major)) %>% group_by(major) %>% summarise(total = n())
ggplot(asianSumma, aes(x = major, y = total)) + geom_bar(stat = "identity", position = "dodge", fill = "purple") + labs(title = "Race and Suma Cum Laude at Williams College", x = "Year", y = "Percent") + theme(axis.text.x = element_text(angle = 90, hjust = 1))

• Admission Discrimination In so much that the above don't fully explain the huge disparity between academic performance of Asians and that of other minority groups, we have reason to believe that there is discrimination against Asians at the Williams College Admissions Office. Such discrimination in college admissions has some fan following. Students for Fair Admissions (SFFA)—a group representing primarily Asian American students and parents- recently sued Harvard College for using implicit racial quotas. At least one recent Williams graduate has also taken the matter to court.

x %>% select(year, race) %>% count(year, race) %>% mutate(percentage = n/sum(n)) %>% ggplot(aes(year, percentage, color = race)) + geom_line()

Faculty

data("faculty")
faculty_details <- create_faculty(complete = TRUE)

There were r dim(faculty_details)[1] faculty at Williams from r min(faculty_details$year) through r max(faculty_details$year). The number of faculty averages about r round(mean(table(faculty_details$year))) per year. The largest class was r as.numeric(tail(sort(table(faculty_details$year)), n = 1)) in r as.numeric(names(tail(sort(table(faculty_details$year)), n = 1))). The smallest was r as.numeric(head(sort(table(faculty_details$year)), n = 1)) in r as.numeric(names(head(sort(table(faculty_details$year)), n = 1))).

Names

We have records of faculty first names and last names.

The most common first names for the entire dataset are:

 sort(table(faculty_details$first.name), decreasing = T)[1:5] %>% as.data.frame() %>% dplyr::select(title = Var1, count = Freq)

The most common last names are:

 sort(table(faculty_details$last.name), decreasing = T)[1:5] %>% as.data.frame() %>% dplyr::select(title = Var1, count = Freq)

faculty_details$full.name <- paste(faculty_details$first.name, faculty_details$last.name, sep = " ")

The longest name is r faculty_details %>% select(year, full.name) %>% filter(min_rank(-nchar(full.name)) < 2) %>% as.character() %>% tail(1) and the shortest name is r faculty_details %>% select(year, full.name) %>% filter(min_rank(nchar(full.name)) < 2) %>% head(1).

Gender

We infer the gender for faculty using the gender and genderizeR package, as in the case of graduates. The gender variable for faculty currently employed at Williams looks like the following:

round(prop.table(table(faculty$gender)), 3)

These figures are similar to those reported by the Williams 2016-2017 Common Data Set.

faculty_details %>% select(year, gender) %>% count(year, gender) %>% mutate(percentage = n/sum(n)) %>% ggplot(aes(year, percentage, color = gender)) + geom_line() + labs(title = "Comosition of Williams Faculty by Gender", x = "Year", y = "Percentage")

Race

As with graduates, we use the wru package to estimate race. The totals for the year r paste(faculty$year[1], faculty$year[1] + 1, sep = ','):

tab <- table(faculty$race, exclude = NULL)

Once again, we seem to be overestimating the number of white faculty. Information about racial breakdown of faculty at Williams is unavailable, but the Williams 2016-2017 Common Data Set reports that the percentage of minority faculty is r round(60/278, digits = 2), while we predict it to be r round(sum(tab[1:4])/ sum(tab), digits = 2). The individual breakdown is:

round(prop.table(table(faculty$race)), 3)

For the most part, our prediction for Asian and Hispanic faculty seems to be correct. In fact, in 2016-2017, James A. Blair is the only faculty member misclasified as "Asian", and Janis Bravo and Peter Monteil were the two misclassified as Hispanic.

The problem lies in differentiating between White and Black faculty. In 2016-2017, about half of faculty classified as "Black", are not in fact, African-American. For example, consider Richard De Veaux.

faculty_details %>% select(year, race) %>% count(year, race) %>% mutate(percentage = n/sum(n)) %>% ggplot(aes(year, percentage, color = race)) + geom_line() + labs(title = "Comosition of Williams Faculty by Race", x = "Year", y = "Percentage")

Undegraduate Degree

The course catalogs provide information about academic degrees earned by faculty. For a given faculty, we infer their undergraduate, or lowest degree, as the first degree we have information about.

The faculty and faculty_details datasets provide information about faculty's undergraduate college degree (as defined above), the conferring school, and the year the degree was received.

The top 10 most common undergraduate programs that faculty attended are:

college.summary <- dplyr::filter(faculty, !is.na(first.degree.school)) %>% dplyr::group_by(first.degree.school) %>% summarise(n = n())
college.summary <- college.summary[with(college.summary, order(-n)), ]
college.summary[1:10, ] %>% as.data.frame()

Highest Degree

The faculty and faculty_details datasets provide information about the highest degree earned by faculty (as inferred by course catalogs), the conferring school, and the year the degree was received.

The top 10 most common graduate programs that faculty attended are:

college.summary <- dplyr::filter(faculty, !is.na(last.degree.school), department == "Computer Science") %>% dplyr::group_by(last.degree.school) %>% summarise(n = n())
college.summary$percent <- round(college.summary$n / sum(college.summary$n) * 100,2)
college.summary <- college.summary[with(college.summary, order(-n)), ]
college.summary[1:20, ] %>% as.data.frame()

Title

The college's course catalogs provide the job title for faculty members. They are interesting because, as we will see later, they give us information about facultys' rank and department.

The five most common titles are:

 sort(table(faculty$title), decreasing = T)[1:5] %>% as.data.frame() %>% dplyr::select(title = Var1, count = Freq)

Rank

We infer the rank of faculty as one of Professor, Assistant Professor, Lecturer, Associate Professor, Artist-in-Residence, or Fellow from their job title. For example, we classify the rank of "Daniel P. Aalberts, Assistant Professor of Physics" as "Assistant Professor", and that for "Irma Mayorga, Gauius Charles Bolin Fellow" as "Fellow".

grouped <- dplyr::filter(faculty, !is.na(rank)) %>% dplyr::group_by(race, rank)
summarised <- dplyr::summarise(grouped, n = n())
ggplot(data = summarised, aes(x = rank, y = n, fill = race)) + 
  geom_bar(stat = "identity", position = "dodge") + 
  labs(title = "Faculty Rank by Race", x = "Rank", y = "Count") + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

grouped <- dplyr::filter(faculty, !is.na(rank)) %>% dplyr::group_by(gender, rank)
summarised <- dplyr::summarise(grouped, n = n())
ggplot(data = summarised, aes(x = rank, y = n, fill = gender)) + 
  geom_bar(stat = "identity", position = "dodge") + 
  labs(title = "Faculty Rank by Gender", x = "Rank", y = "Count") + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

We find that of the r total = sum(faculty_start.rank$rank == "Professor", na.rm = T) r total faculty members with rank Professor currently employed at Williams, r round(sum(faculty_start.rank$rank == "Professor" & faculty_start.rank$start.rank == "Assistant Professor", na.rm = T)/total * 100, 2)% were first employed as Assistant Professor and at average, took r round(mean(assistant_prof$promotion_time), 2) years to be promoted. r round(sum(faculty_start.rank$rank == "Professor" & faculty_start.rank$start.rank == "Associate Professor", na.rm = T)/total * 100, 2)% were first employed as Associate Professor, and at average, took r round(mean(assoc_prof$promotion_time), 2) years to be promoted.

Department

faculty.na <- faculty_details[which(!is.na(faculty_details$department)), ]
grouped <-  group_by(faculty.na, year, department)
summary.df <- summarise(grouped, number_of_faculty = n())
summary.df.top10 <- summary.df[with(summary.df, order(-number_of_faculty)), ] %>% filter(year == max(summary.df$year))
summary.df.top10 <- summary.df.top10[1:10, ]

The course catalogs do not directly provide the department for faculty. Instead, we try to infer the department by a faculty's title. For some, this is easy. For example, "Daniel P. Aalberts, Assistant Professor of Physics" definitely belongs to Physics, and "Colin C. Adams, Francis Christopher Oakley Third Century Professor of Mathematics" to Mathematics.

Others are more complicated. For example, consider "Bernadette Brooten, Croghan Bicentennial Visiting Professor in Biblical and Early Christian Studies, Spring Semester". Although, from Bernadette Brooten's title, it is fairly obvious that she is a Professor of Religion, her department cannot be inferred from the naive procedure with which we infer Colin Adams' or Daniel Alberts' department. We need to handle these cases separately.

Alas, others are, still, more complicated. "Jennifer Austin, Assistant Professor of Romance Languages" is a case in point: it is obvious that she teaches Romance Languages, but does she teach French, Italian, or Spanish? These cases need to be handled explicitly.

According to our findings, the top 10 departments in terms of faculty employed for the latest year we have data for (r paste(max(faculty_details$year), max(faculty_details$year) + 1, sep = '-')) are:

summary.df.top10  %>% as.data.frame()

filter.summary <- summary.df %>% filter(department %in% summary.df.top10$department)
p <- ggplot(data = filter.summary, aes(x = year, y = number_of_faculty, color = department)) + geom_line() + labs(x = "Year", y = "Number of faculty", title = "Number of Faculty by Department")

p 

Birth Year

The course catalogs provide the year a faculty member graduated from college. Assuming (perhaps incorrectly in some cases) that she is 22 when she graduates, we infer her birth year.

faculty$age <- 2017 - faculty$birth.year
oldest <- paste(faculty$first.name[which(faculty$age == max(faculty$age, na.rm = T))], faculty$last.name[which(faculty$age == max(faculty$age, na.rm = T))], sep = ' ')
youngest <- paste(faculty$first.name[which(faculty$age == min(faculty$age, na.rm = T))], faculty$last.name[which(faculty$age == min(faculty$age, na.rm = T))], sep = ' ')

We find that the oldest faculty currently in the college is r oldest[1]. The youngest faculty currently in the college is r youngest[1]. The age variable for faculty currently employed at Williams looks like:

summary(faculty$age)

faculty$age <- 2017 - faculty$birth.year
qplot(faculty$age, geom="histogram", fill = I("purple"), color = I("black") ) + labs(title = "Distribution of Age of Faculty currently employed at Williams", y = "Count", x = "Age")

The average age for both male and female faculty has constantly decreased over the years (with the only exception of slight increases during 2007 to 2009. This is, perhaps, expected in view of the financial crisis when Williams had to considerably downsize its faculty. Presumably, newer, and hence, younger faculty, were disproportionately axed).

r tufte::margin_note("Note: College catalogs for 2015-2016 do not contain information about faculty's age." )

faculty_details$age <- 2017 - faculty_details$birth.year
grouped.year <- dplyr::group_by(faculty_details, year, gender)
summary.year <- dplyr::summarise(grouped.year, avg_age = mean(age, na.rm = T))
ggplot(data = summary.year, aes(x = year, y = avg_age, fill = gender)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Average Age of Faculty by Gender", x = "Year", y = "Average Age")

The average age of all but Black faculty has fallen steadily over the years. The average age of Black faculty increased during the first few years of 2000, and then steadily decreased to reach similar levels as other races.

r tufte::margin_note("Note: College catalogs for 2015-2016 do not contain information about faculty's age." )

grouped.year <- dplyr::group_by(faculty_details, year, race)
summary.year <- dplyr::summarise(grouped.year, avg_age = mean(age, na.rm = T))
ggplot(data = summary.year, aes(x = year, y = avg_age, fill = race)) + geom_bar(stat = "identity", position = "dodge") + labs(title = "Average Age of Faculty by Race", x = "Year", y = "Average Age")

Start Year

We infer a faculty's start.year, or the first year they joined Williams, as the year of the first catalog that lists them as faculty of the college.

r tufte::margin_note(paste("Note: this inference is correct for all faculty, but for whom we infer the year to be the first year we have data about, that is ", min(faculty_details$year, na.rm = T), ". This is because these faculty may have very well started their career at Williams earlier than ", min(faculty_details$year, na.rm = T), "and we just don't have any data to know precisely. For these faculty, the start.year should be perhaps more accurately interpreted as <= ", min(faculty_details$year, na.rm = T), ".", sep = " "))

The start.year variable gives us insight into how long the current faculty at Williams have been around:

faculty$term <- 2017 - faculty$start.year
summary(faculty$term)

qplot(faculty$term, geom="histogram", fill = I("purple"), color = I("black") ) + labs(title = "Length of Tenure of Williams College faculty", y = "Count", x = "Years") + scale_y_continuous(limits = c(0, 100))

dplyr::filter(faculty, !is.na(gender)) %>% ggplot(aes(term, fill = gender)) + geom_histogram(aes(y = ..density..), position = 'dodge') + labs(title = "Length of Tenure of Williams College Faculty by Gender", y = "Count", x = "Years")

dplyr::filter(faculty, !is.na(gender)) %>% ggplot(aes(term, fill = race)) + geom_histogram(aes(y = ..density..), position = 'dodge') + labs(title = "Length of Tenure of Williams College Faculty by Race", y = "Count", x = "Years")

karantibrewal/williams documentation built on May 3, 2019, 9:40 p.m.