Formatting your lab

When you open your Markdown file, your first chunk likely looks like:

knitr::opts_chunk$set(echo = TRUE)

Change it to:

knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, fig.asp =.5)

The Data Set

One large task that is unique to text analysis is the detection of hate speech, or text that is directly and negatively targeted at a specific group, individuals with certain traits, or a certain individual.

Today, we are going to work with the text of \(n = 3500\) online X posts. Each post has been labelled as hate speech, offensive speech (but not hate speech), or neither. These labels were obtained by having 3 different trained individuals read the text and assign one of the 3 labels. In this case, a text was labeled as hate speech if at least one rater identified the text as hate speech.

We have two goals for our work today:

• Goal 1: Determine what traits distinguish hate speech from other text. In other words, what traits of a text seem to be associated with a label of hate speech?
• Goal 2: Predict whether or not a post is hate speech.

We have two data sets today, a training data set and a test data set. You can load them using the code below.

# Load the training data
train <- read.csv("https://www.dropbox.com/scl/fi/jnwph6015l4lrt3vbm1ds/hatespeech_train_fs.csv?rlkey=nosk4imet576l7k3xgkq2se3d&st=cehbw3vb&dl=1")
colnames(train)[1] <-"label"

# Load the test data
test <- read.csv("https://www.dropbox.com/scl/fi/qgkha7zru7ppc0ssfrzdx/hatespeech_test_fs.csv?rlkey=3hll0wibh6su79wqpvff58x8d&st=6oa57mcd&dl=1")
colnames(test)[1] <-"label"

The training data set should have \(n = 3500\) rows and the test set should have \(n^{*} = 1400\) rows, and both data sets should have 28 columns.

There are 27 features, all derived from LIWC:

• swear: % of words that are swear words.
• ethnicity: % of words that related to ethnicity (example: american, french, etc.)
• Dic: % of words in the post that are in the LIWC
• tone_pos: a score for positive tone; higher scores mean a more positive tone.
• BigWords: % of words with more than 6 letters
• socrefs: % of words that are social connection references (you, we, he, she, friend, parent, etc.)
• female: % of words that are female references (she, her, woman, etc.)
• sexual: % of words that has sexual references
• Affect: a score indicating words about emotions,
• tone_neg: a score for negative tone; higher scores mean a more negative tone.
• WC: the number of words in the post.
• Physical: % of words that relate to physical topics (body, eye, arm, doctor, etc.)
• power: % of words related to power (own, order, allow, power, etc.)
• food: % of words related to food
• negate: % of words that are negation (not, no, never, nothing, etc.)
• ppron: % of words that are person pronouns (I, you, my, me, etc.)
  
• verb: % of words that are verbs (is, was, be, have, etc.)
• focuspast: % of past focus words (was, had, were, been, etc.)
• acquire: % of acquire words (get, got, take, getting, etc.)
• det: % of words that are stop words
• need: % of words/phrases that are about need (have to, need, had to, must, etc.)
• Exclam: % of exclamation marks
• WPS: Words per sentence
  
• auxverb: auxiliary verbs (is, was, be, have, etc.)
• space: % of words about space (in, out, up, there , etc.)
• illness: % of words about illness (hospital, cancer, sick, pain, etc.)
• Culture: % of words about politics, culture, or technology

We are hoping to use these text features to describe how hate speech posts are different from other posts.

In addition to these features, we have our response variable (label) which identifies whether an X post is hate speech, offensive but not hate speech, or neither. This means label is a categorical variable with 3 levels. However, when we read in the data, it turns out that the variable label is not considered to be a categorical variable by R. We can see that by using the class function:

class(train$label)

If you get anything other than factor as a result when you run the class() function, this means R does not know that we want to treat the variable as a categorical variable. To fix this, we use the following code. It also allows us to set the ordering for the labels of the categorical variable, which will be helpful when we model later.

train$label <- factor(train$label, levels = c("Neither","Offensive", "Hate Speech"))

knitr::kable( table(test$label), col.names = c("Label", "Count") )

For our work today, there a few packages we will need. Go ahead and load those now. REMEMBER: If you get an error that says your computer does not have or cannot find a package, go to the top of your screen (the right of your camera for my Apple folks) and choose Tools. From there, choose Install Packages. From there, type in the name of the packages you need and install!

# For multinomial 
library(nnet)

# For LDA
library(MASS)

# For Naive Bayes 
library(naivebayes)

# For the correlation plot
library(corrplot)

# For plotting and general work
library(dplyr)
library(ggplot2)

Multinomial Regression

We are going to start off with multinomial regression. Yes, I know, we already did a lab on multinomial. However, we have just learned how we can do inference with multinomial regression. Recall that our first goal is:

• Goal 1: Determine what traits distinguish hate speech from other text. In other words, what traits of a text seem to be associated with a label of hate speech?

Without inference, we could only answer the question of what traits are related to being labeled hate speech in the sample of data that we have. With inference, we can use our sample data to assess what might be traits of hate speech in the population of all posts.

knitr::kable( t( coefficients(multimodel) ))

randomizationCI <- function(data, modelin, Y, beta){
  
  Y = which(colnames(data)==Y)
  
  # Confidence Intervals and Predictive Intervals 
  
  coefs1 <- NA
  coefs2 <- NA

  for( i in 1:100){
    set.seed(i)
    bootsample <- sample( 1:nrow(data), nrow(data), replace = TRUE)
    bootsample <- data[bootsample,]
    
    check <- apply(bootsample, 2, function(x) length(unique(x)))
    while( length(which(check==1)) >0){
      bootsample <- sample( 1:nrow(data), nrow(data), replace = TRUE)
      bootsample <- data[bootsample,]
      check <- apply(bootsample, 2, function(x) length(unique(x)))
    }
    
    # Fit the model 
    mboot <- multinom( bootsample[,Y] ~ ., data = bootsample[,-Y], trace = FALSE)
    coefs <-  data.frame(t(coefficients(mboot)))
    
    # Store the coefficients 
    coefs1 <- c( coefs1, coefs[beta+1,1])
    coefs2 <- c( coefs2, coefs[beta+1,2])

  }
  
  coefs1 <- coefs1[-1]
  coefs2 <- coefs2[-1]
  
  # Now, we can make 95% CIS
  upper1 <- round(quantile(coefs1, .975 ),3)
  lower1 <- round(quantile(coefs1, .025 ),3)
  level1 <- levels(data[,Y])[2]
  
  # Now, we can make 95% CIS
  upper2 <- round(quantile(coefs2, .975 ),3)
  lower2 <- round(quantile(coefs2, .025 ),3)
  level2 <- levels(data[,Y])[3]
  
  row1 <- c(level1, lower1,upper1)
  row2 <- c(level2, lower2,upper2)
  
  holder <- rbind(row1,row2)
  holder <- data.frame(holder)
  rownames(holder) <- c("Level 2", "Level 3")
  colnames(holder) <- c("Label", "Lower", "Upper")

  
  holder
 
}

# Build the Bootstrap CI
out <- randomizationCI(data, modelin, Y, beta)

# Format the output 
knitr::kable(out)

knitr::kable(confint(multimodel)[,,"Offensive"])

knitr::kable(confint(multimodel)[,,"Offensive"][1,])

Linear Discriminant Analysis

So far, we have worked with a model that we already know, just in a slightly new way. In this next section of the lab, we are going to work with something brand new: linear discriminant analysis (LDA).

I will be clear upfront that the mathematics of how this approach works is beyond the scope of our course. It requires understanding eigenvalues and eigenvectors and other work with matrices. This means that we are not going to focus on so much how it works, but how we can use it.

The goal of LDA is similar to the goal of classification trees. We will use our features to create clusters in the data, with the goal of using the features to define a cluster containing hate speech posts, or neither posts, or offensive posts.

To see what I mean by this, let’s go ahead and fit LDA to our data. The code we need is very short:

lda_out <- MASS::lda(label ~ ., data = train)

As a result of LDA, we have three distinct clusters, one for each level of \(Y\). To see this, we can use:

knitr::kable(round(t(lda_out$means),2))

The result of running the code above is a matrix with 27 rows (one for each feature) and 3 columns (one for each cluster). The numbers that you see indicate the average value of each feature for each cluster. For example, for posts in the Neither cluster, on average 1.15% of words are swear words. For posts in the Offensive cluster, on average 11.08% of words are swear words. In other words, the mean for swear words percentage is almost 11 times larger in the offensive cluster than in the neither cluster.

We cannot build confidence intervals with LDA as we can with multinomial regression, but we can still use the results to describe relationships highlighted in our sample. By looking at how the means differ across the clusters, we can see key features that define each label (neither, offensive, hate speech).

One way to assess how well LDA is able to separate the data into clusters is by looking at a visualization of the clusters. To teach R the function it needs to learn to do this, copy and paste the following into a chunk and press play:

lda_scatter <- function(lda){
  
  var_ex <- (lda$svd)^2/sum(lda$svd^2) * 100
  
  per_ex_1 <- paste0("(", round(var_ex[1], 2), "%)")
  per_ex_2 <- paste0("(", round(var_ex[2], 2), "%)")
  
  scores <- predict(lda) %>%
    data.frame() %>%
    select(class, x.LD1, x.LD2)
  
  max_x <- scores[,2] %>% abs() %>% max() %>% ceiling()+.5
  max_y <- scores[,3] %>% abs() %>% max() %>% ceiling()+.5
  
  p1 <- ggplot() +
    geom_hline(yintercept = 0, linewidth = .25) +
    geom_vline(xintercept = 0, linewidth = .25) +
    geom_point(data = scores, aes(x = x.LD1, y = x.LD2, fill = class),
               shape = 21, size = 1.5) +
    viridis::scale_fill_viridis(discrete = T) +
    xlab(paste0("LD1", " ", per_ex_1)) +
    ylab(paste0("LD2", " ", per_ex_2)) +
    ylim(-max_y, max_y) +
    xlim(-max_x, max_x) +
    theme_linedraw() +
    theme(panel.grid.minor.x = element_blank()) +
    theme(panel.grid.minor.y = element_blank()) +
    theme(panel.grid.major.x = element_blank()) +
    theme(panel.grid.major.y = element_blank())
  return(p1)
}

Citation for this function: DeLuca, L. S., Reinhart, A., Weinberg, G., Laudenbach, M., Miller, S., & Brown, D. W. (2025). Developing Students’ Statistical Expertise Through Writing in the Age of AI. Journal of Statistics and Data Science Education, 33(3), 266–278. https://doi.org/10.1080/26939169.2025.2497547

To plot the output, we then use:

lda_scatter(lda_out)

In this picture, we are hoping to see clearly defined clusters, which means the model is able to effectively divide the text into groups.

If we look a little deeper, we will notice that there are two axes labelled LD1 (linear discriminant 1) and LD2 (linear discriminant 2). The percentage with those labels essentially says how important that axis is in defining the clusters (telling the labels apart).

We now have two different approaches that we can use to discuss what features might be related to a label of hate speech. In practice, it is particularly powerful if multiple techniques indicate that the same features are important - this means that regardless of the technique we choose, we are getting similar results.

Predictions

Recall that we have two goals today:

• Goal 1: Determine what traits distinguish hate speech from other text.
• Goal 2: Predict whether or not a post is hate speech.

So far, we have focused on Goal 1, but both multinomial regression and LDA can be used to make predictions. Before we get to that, let’s add one more option: Naive Bayes.

swearLarge <- ifelse( train$swear > 10, "Large", "Not Large")

knitr::kable(table(train$label, swearLarge))

set.seed(279)  # Setting Seed

nb <- naive_bayes(label ~., data= train)

preds <- predict(nb, type = "class", newdata = test[,-1])

holder <- table(preds, test$label)
colnames(holder) <- c("True: Neither", "True: Offensive", "True: Hate Speech")
rownames(holder) <- c("Pred: Neither", "Pred: Offensive", "Pred: Hate Speech")

knitr::kable( holder )

corrplot(cor( features ), type = "upper")

holder <- table(predict(multimodel, type = "class", newdata = test), test$label)
colnames(holder) <- c("True: Neither", "True: Offensive", "True: Hate Speech")
rownames(holder) <- c("Pred: Neither", "Pred: Offensive", "Pred: Hate Speech")

knitr::kable( holder )

holder <- predict(lda_out, newdata = test)$class
holder <- table(holder, test$label)
colnames(holder) <- c("True: Neither", "True: Offensive", "True: Hate Speech")
rownames(holder) <- c("Pred: Neither", "Pred: Offensive", "Pred: Hate Speech")

knitr::kable( holder )

holder <- table(preds, test$label)
colnames(holder) <- c("True: Neither", "True: Offensive", "True: Hate Speech")
rownames(holder) <- c("Pred: Neither", "Pred: Offensive", "Pred: Hate Speech")

knitr::kable( holder )

References

Data

LIWC Features

Boyd, R. L., Ashokkumar, A., Seraj, S., & Pennebaker, J. W. (2022). The development and psychometric properties of LIWC-22. The University of Texas at Austin. https://www.liwc.app

Plotting lda:

DeLuca, L. S., Reinhart, A., Weinberg, G., Laudenbach, M., Miller, S., & Brown, D. W. (2025). Developing Students’ Statistical Expertise Through Writing in the Age of AI. Journal of Statistics and Data Science Education, 33(3), 266–278. https://doi.org/10.1080/26939169.2025.2497547