Introduction

This project explores how students describe professors in RateMyProfessor reviews and whether certain instructor archetypes receive higher ratings.

Research Question:
What professor archetypes emerge from RateMyProfessor comments, and which archetypes receive the highest ratings?

Setup

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(tidytext)
library(topicmodels)
library(ggplot2)
library(dplyr)
library(tidyr)

RateMyProfessor_Sample_data <- read_csv("RMPData.csv")

## Rows: 20000 Columns: 51
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (17): professor_name, school_name, department_name, local_name, state_na...
## dbl (34): year_since_first_review, star_rating, diff_index, num_student, stu...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

rmp_clean <- RateMyProfessor_Sample_data %>%
  select(comments, star_rating, diff_index, would_take_agains) %>%
  filter(!is.na(comments)) %>%
  mutate(doc_id = row_number())

custom_stop_words <- tibble(
  word = c(
    "professor","prof","teacher","class","course",
    "semester","students","student","lecture",
    "lectures","really","also","one","get","got",
    "would","take","taking","taken"
  )
)

topic_colors <- c(
  "#4E79A7",
  "#F28E2B",
  "#E15759",
  "#76B7B2",
  "#59A14F"
)

Professor Archetypes (Unigrams)

tokens <- rmp_clean %>% 
  unnest_tokens(word, comments) %>%
  anti_join(stop_words) %>%
  anti_join(custom_stop_words)

## Joining with `by = join_by(word)`
## Joining with `by = join_by(word)`

dtm <- tokens %>%
  count(doc_id, word) %>%
  cast_dtm(doc_id, word, n)

lda_model <- LDA(dtm, k = 5, control = list(seed = 1234))

beta_mat <- posterior(lda_model)$terms


topics <- as.data.frame(beta_mat) %>%
  mutate(topic = row_number()) %>%
  pivot_longer(
    cols = -topic,
    names_to = "term",
    values_to = "beta"
  )


top_terms <- topics %>%
  group_by(topic) %>%
  slice_max(beta, n = 10) %>%
  ungroup()

ggplot(top_terms,
       aes(beta,
           reorder_within(term, beta, topic),
           fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  scale_y_reordered() +
  scale_fill_manual(values = topic_colors) +
  labs(
    title = "Professor Archetypes Using Unigrams",
    x = NULL,
    y = "Importance"
  ) +
  theme_minimal(base_size = 11)

Diving Deeper: Bigrams

bigrams <- rmp_clean %>%
  unnest_tokens(bigram, comments, token = "ngrams", n = 2)

bigrams_sep <- bigrams %>%
  separate(bigram, into = c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_sep %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word) %>%
  filter(!word1 %in% custom_stop_words$word) %>%
  filter(!word2 %in% custom_stop_words$word)

bigrams_united <- bigrams_filtered %>%
  unite(bigram, word1, word2, sep = " ")

bigrams_counts <- bigrams_united %>%
  count(doc_id, bigram) %>%
  group_by(bigram) %>%
  filter(sum(n) > 20) %>%
  ungroup()

bigram_dtm <- bigrams_counts %>%
  cast_dtm(doc_id, bigram, n)

lda_bigram <- LDA(bigram_dtm, k = 5, control = list(seed = 1234))

# --- REPLACEMENT FOR tidy() ---
beta_mat_bigram <- posterior(lda_bigram)$terms

bigram_topics <- as.data.frame(beta_mat_bigram) %>%
  mutate(topic = row_number()) %>%
  pivot_longer(
    cols = -topic,
    names_to = "term",
    values_to = "beta"
  )
# --------------------------------

top_bigrams <- bigram_topics %>%
  group_by(topic) %>%
  slice_max(beta, n = 10) %>%
  ungroup()

bigram_labels <- c(
  "Supportive but Tough",
  "Easy Grader / Extra Credit",
  "Engaging / Real-World Teaching",
  "Easy & Multiple Choice",
  "Helpful & Approachable"
)

top_bigrams <- top_bigrams %>%
  mutate(
    archetype = bigram_labels[topic],
    archetype = str_wrap(archetype, width = 20)
  )

ggplot(top_bigrams,
       aes(beta,
           reorder_within(term, beta, archetype),
           fill = archetype)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ archetype, scales = "free") +
  scale_y_reordered() +
  labs(
    title = "Professor Archetypes Using Bigrams",
    x = NULL,
    y = "Importance"
  ) +
  theme_minimal(base_size = 11)

Ratings by Archetype

# assign reviews to topics (NO tidy())
gamma_mat <- posterior(lda_model)$topics

assignments <- as.data.frame(gamma_mat) %>%
  mutate(document = row_number()) %>%
  pivot_longer(
    cols = -document,
    names_to = "topic",
    values_to = "gamma"
  ) %>%
  mutate(topic = as.integer(gsub("V", "", topic))) %>%
  group_by(document) %>%
  slice_max(gamma) %>%
  ungroup()

rmp_topics <- assignments %>%
  left_join(rmp_clean, by = c("document" = "doc_id"))

# add bigram archetype labels
bigram_labels <- c(
  "Supportive but Tough",
  "Easy Grader / Extra Credit",
  "Engaging / Real-World Teaching",
  "Easy & Multiple Choice",
  "Helpful & Approachable"
)

ratings_by_topic <- rmp_topics %>%
  group_by(topic) %>%
  summarise(
    avg_rating = mean(star_rating, na.rm = TRUE),
    avg_difficulty = mean(diff_index, na.rm = TRUE),
    n = n()
  ) %>%
  mutate(archetype = bigram_labels[topic])

# plot
library(stringr)

ggplot(ratings_by_topic,
       aes(x = reorder(archetype, avg_rating),
           y = avg_rating,
           fill = archetype)) +
  geom_col() +
  coord_flip() +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 20)) +
  coord_cartesian(ylim = c(3.6, 3.7)) +
  labs(
    title = "Average Rating by Professor Archetype",
    x = NULL,
    y = "Average Rating"
  ) +
  theme_minimal(base_size = 11) +
  guides(fill = "none")

## Coordinate system already present.
## ℹ Adding new coordinate system, which will replace the existing one.

Key Findings

Distinct professor archetypes emerge from student comments. These reflect a mix of teaching style (engaging, supportive) and grading style (easy, extra credit).
Ratings are all relatively high and tightly clustered All archetypes fall in a narrow band (roughly 3.63–3.66). That means:
- No archetype is strongly disliked
- Differences in student perception are subtle rather than dramatic
Slight preference for “easier” and engaging professors. This suggests students reward:
- Perceived fairness or leniency
- Practical, engaging instruction
“Supportive but Tough” ranks lowest (but still strong) Although still well-rated, “Supportive but Tough” is the lowest of the group. This may indicate:
- Students appreciate support, but difficulty can slightly lower overall ratings. Rigor alone doesn’t translate to top ratings unless paired with engagement or ease.

Considerations and Limitations

While the analysis provides useful insight into perceived professor archetypes, it should be interpreted cautiously, with awareness of bias, limited representativeness, and the potential real-world impact on educators.

Professor Archetypes in RateMyProfessor Reviews