The purpose of writing graded lab reports is to help students to stay on track and to provide summative feedback. Each lab report is just 1% of the total course mark. Please do not cheat - it is not worth it!
Solve the practical questions, knit your document into a PDF and submit to NTULearn before the deadline. The deadline is very tight because the task is simple. We are sure that everyone is capable to do it by themselves and we want to discourage taking someone else’s report and writing it with your own words.
15 Sep 2025, midnight
We will work with a dataset of New Year resolutions posted on twitter.
Source: https://data.world/crowdflower/2015-new-years-resolutions
Here, we load libraries, data and set the random seed. Replace the number “1729” with the numeric part of your matric no
library(tidyverse) # for manipulation with data
## ── 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) # for tidyverse-style text tokenization
library(caret) # for machine learning, including KNN
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(janitor) # for some helper functions
##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.test
library(rpart) # for training decision trees
library(rpart.plot) # for plotting decision trees
## Warning: package 'rpart.plot' was built under R version 4.6.1
library(ranger) # for training random forest
library(ggwordcloud) # for text visualization
N <- read_csv("new_years_resolutions.csv")
## Rows: 5011 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (13): other_topic, resolution_topics, gender, name, Resolution_Category,...
## dbl (2): retweet_count, tweet_id
##
## ℹ 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.
set.seed(73) # replace the number '1729' with your matric no
We will predict the overall category of a New Year resolution based on the text and the author’s gender.
N %>%
as_tibble %>%
sample_n(10) %>%
select(text, gender, Resolution_Category)
Here is the total count of tweets in each resolution category:
N %>% tabyl(Resolution_Category)
Because of the specific nature of this collection of tweets, we will remove the following words from word clouds (we will not remove them from the predictive models):
remove_from_wc <- c(stop_words$word,
"newyearsresolution",
"new", "years", "resolution",
"twacc", "htag", "year", "http")
Clean the raw twitter data as follows:
Remove all characters except for alphabet, “@” and “#”
Change all characters to lower case
Change “@” to “twacc” and “#” to “htag”
Introduce a new variable Y whose value is
Resolution_Category converted to factor
(categorical variable in R)
Extract only cleaned text, gender and Y from the data
Then plot the word clouds for tweets in the category “Health &
Fitness”. Note that words in remove_from_wc should not be
plotted.
Explain in you own words what seems to be most important themes and challenges for people who tweeted about their “Health & Fitness” resolutions.
Solution First, we will clean the data. The cleaned dataset
is called clean_tweets.
clean_tweets <- N %>%
mutate(
cleaned_text = text %>%
str_replace_all("[^A-Za-z@#]", " ") %>%
str_squish() %>%
str_to_lower() %>%
str_replace_all("@", "twacc ") %>%
str_replace_all("#", "htag ")
) %>%
mutate(Y = as_factor(Resolution_Category)) %>%
select(cleaned_text, gender, Y)
head(clean_tweets)
First, we create a tidy dataset of word counts:
tidy_counts <- clean_tweets %>%
mutate(doc_id = row_number()) %>%
select(doc_id, cleaned_text, gender, Y) %>%
unnest_tokens(word, cleaned_text) %>%
count(doc_id, gender, Y, word, sort = FALSE)
tidy_counts %>%
sample_n(10)
Here is the word cloud for “Health & Fitness” tweets. Note that we made a special function to plot a word cloud from a character vector:
df_to_word_cloud <- function(word_data) {
word_data %>%
slice_max(freq, n = 67) %>%
ggplot(aes(label = word, size = freq)) +
geom_text_wordcloud() +
scale_size_area(max_size = 15) +
theme_void()
}
plot_word_cloud <- function(tidy_data) {
tidy_data %>%
count(word, wt = n, name = "freq") %>%
arrange(-freq) %>%
filter(!word %in% remove_from_wc) %>%
df_to_word_cloud()
}
tidy_counts %>%
filter(Y == "Health & Fitness") %>%
plot_word_cloud()
Answer Most important challenges seem to be quitting smoking, losing weight, and eating healthier.
Create the document-term-matrix that only contains words whose
overall frequency is at least 15. Then create 60% training and 40% test
datasets with words coming from the document-term-matrix as predictors.
Also include the author’s gender and the response variable
Y. Report dimensions of training and test sets.
Solution
keep_words <- tidy_counts %>%
count(word, wt = n, name = "freq") %>%
filter(freq >= 15, !word %in% stop_words$word)
all_data <- tidy_counts %>%
filter(word %in% keep_words$word) %>%
pivot_wider(
id_cols = c(doc_id, Y, gender),
names_from = "word",
values_from = "n",
values_fill = 0,
names_prefix = "w_") %>%
select(-doc_id)
p <- 0.6
ind <- runif(nrow(all_data)) < p
train_data <- all_data[ind , ]
test_data <- all_data[!ind , ]
cat("Dimensions of the training set are", dim(train_data),"\n")
## Dimensions of the training set are 3024 239
cat("Dimensions of the test set are", dim(test_data),"\n")
## Dimensions of the test set are 1987 239
Remark Column names here are not just words, but words with
the prefix w_. The main reason is that there are reserved R
words, such as “if”, “for”, “function” etc., that may cause errors if
used as column names. Besides, column names that start with
w_ make it easy to distinguish variables that are word
frequencies from other variables (in this case, Y and
gender).
Train and plot a decision tree to predict the resolution category
Y based on word occurrence in a tweet text and the author’s
gender. Also report the overall accuracy of the model. Note that not all
the 10 categories will be actually predicted by the tree - this is
alright, don’t worry about.
Solution
First, we train and plot the decision tree.
mod_tree <- train(Y ~ ., data = train_data, method = "rpart")
rpart.plot(mod_tree$finalModel,
legend.x = 0.8, legend.y = 1)
The overall accuracy is
### Helper function
test_accuracy <- function(caret_model, dataset = test_data, response_var = "Y") {
cm <- caret_model %>%
predict(dataset, type = "raw") %>%
confusionMatrix(dataset[[response_var]])
cm$overall['Accuracy']
}
mod_tree %>% test_accuracy() %>% round(3) %>%
cat("Decision tree test accuracy =", . ,"\n")
## Decision tree test accuracy = 0.386
Train a random forest to predict the resolution category
Y based on word occurrence in a tweet text and the author’s
gender. When you tune hyperparameter values, use the OOB Error as the
measure of your models’ goodness of fit. Set
splitrule = gini and set the number of trees to 50 for
tuning and then retrain one model with 500 trees with the optimal
hyperparamter values.
Finally, report variable importance for 10 most imporant predictors
(you can just print it, do a simple diagonstic base R plot, or
ggplot()) and report the overall accuracy of the final
model.
Solution
First, we tune random forest
mini_data <- train_data %>% slice_sample(n = 500)
rfGrid <- expand.grid(mtry = c(8, 10, 15, 20, 30),
min.node.size = c(3, 5, 10, 20),
splitrule = "gini")
mod_rf_tune <- train(Y ~ . , data = mini_data, method = "ranger",
num.trees = 50,
importance = 'impurity',
tuneGrid = rfGrid,
trControl = trainControl("oob"))
mod_rf_tune
## Random Forest
##
## 500 samples
## 238 predictors
## 10 classes: 'Health & Fitness', 'Humor', 'Personal Growth', 'Philanthropic', 'Recreation & Leisure', 'Family/Friends/Relationships', 'Career', 'Finance', 'Education/Training', 'Time Management/Organization'
##
## No pre-processing
## Resampling results across tuning parameters:
##
## mtry min.node.size Accuracy Kappa
## 8 3 0.388 0.1120964
## 8 5 0.384 0.1263997
## 8 10 0.382 0.1198838
## 8 20 0.384 0.1311020
## 10 3 0.376 0.1090602
## 10 5 0.396 0.1487587
## 10 10 0.384 0.1253826
## 10 20 0.384 0.1337462
## 15 3 0.376 0.1364517
## 15 5 0.388 0.1486947
## 15 10 0.406 0.1835680
## 15 20 0.384 0.1473010
## 20 3 0.394 0.1654180
## 20 5 0.378 0.1505842
## 20 10 0.384 0.1548446
## 20 20 0.394 0.1699085
## 30 3 0.354 0.1239443
## 30 5 0.374 0.1532943
## 30 10 0.388 0.1661898
## 30 20 0.384 0.1620051
##
## Tuning parameter 'splitrule' was held constant at a value of gini
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were mtry = 15, splitrule = gini
## and min.node.size = 10.
Now we retrain it with the best combination of hyperparameter values and report the overall accuracy of the final model.
mod_rf_tuned <- train(Y ~ . , data = train_data, method = "ranger",
num.trees = 500,
importance = 'impurity',
tuneGrid = expand.grid(mod_rf_tune$bestTune),
trControl = trainControl("oob"))
mod_rf_tuned %>% test_accuracy() %>% round(3) %>%
cat("Random forest test accuracy =", . ,"\n")
## Random forest test accuracy = 0.486
And here is the variable importance plot:
plot(varImp(mod_rf_tuned), top = 10)
Modify the following:
I used ChatGPT 5.0 to make my old codes more aligned with
tidyverse philosophy
Type your name to confirm: Fedor Duzhin