Lab 3 Case Study: Unsupervised Learning in Learning Analytics
James Frye
2024-04-24
Introduction
Learning analytics is the use of data to understand and improve learning. Unsupervised learning is a type of machine learning that can be used to identify patterns and relationships in data without the need for labeled data.
In this case study, you will use unsupervised learning to analyze learning data from a Simulated School course. You will use dimensionality reduction to reduce the number of features in the data, and then use clustering to identify groups of students with similar learning patterns.
Data
The data for this case study is generated with the simulated function below. The data contains the following features:
Student ID: A unique identifier for each student Feature 1: A measure of student engagement Feature 2: A measure of student performance
simulate_student_features <- function(n = 100) {
# Set the random seed
set.seed(260923)
# Generate unique student IDs
student_ids <- seq(1, n)
# Simulate student engagement
student_engagement <- rnorm(n, mean = 50, sd = 10)
# Simulate student performance
student_performance <- rnorm(n, mean = 60, sd = 15)
# Combine the data into a data frame
student_features <- data.frame(
student_id = student_ids,
student_engagement = student_engagement,
student_performance = student_performance
)
# Return the data frame
return(student_features)
}This function takes the number of students to simulate as an input and returns a data frame with three columns: student_id, student_engagement, and student_performance. The student_engagement and student_performance features are simulated using normal distributions with mean values of 50 and 60, respectively, and standard deviations of 10 and 15, respectively.
To use the simulate_student_features() function, we can simply pass the desired number of students to simulate as the argument:
student_features <- simulate_student_features(n = 100)
library(tidymodels)## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──## ✔ broom 1.0.5 ✔ recipes 1.0.10
## ✔ dials 1.2.1 ✔ rsample 1.2.1
## ✔ dplyr 1.1.4 ✔ tibble 3.2.1
## ✔ ggplot2 3.5.0 ✔ tidyr 1.3.1
## ✔ infer 1.0.7 ✔ tune 1.2.0
## ✔ modeldata 1.3.0 ✔ workflows 1.1.4
## ✔ parsnip 1.2.1 ✔ workflowsets 1.1.0
## ✔ purrr 1.0.2 ✔ yardstick 1.3.1## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ✖ recipes::step() masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.5
## ✔ lubridate 1.9.3 ✔ stringr 1.5.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ readr::col_factor() masks scales::col_factor()
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ stringr::fixed() masks recipes::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ readr::spec() masks yardstick::spec()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(janitor)##
## Attaching package: 'janitor'
##
## The following objects are masked from 'package:stats':
##
## chisq.test, fisher.testlibrary(cluster)
library(purrr)
library(ggplot2)
library(dendextend)##
## ---------------------
## Welcome to dendextend version 1.17.1
## Type citation('dendextend') for how to cite the package.
##
## Type browseVignettes(package = 'dendextend') for the package vignette.
## The github page is: https://github.com/talgalili/dendextend/
##
## Suggestions and bug-reports can be submitted at: https://github.com/talgalili/dendextend/issues
## You may ask questions at stackoverflow, use the r and dendextend tags:
## https://stackoverflow.com/questions/tagged/dendextend
##
## To suppress this message use: suppressPackageStartupMessages(library(dendextend))
## ---------------------
##
##
## Attaching package: 'dendextend'
##
## The following object is masked from 'package:dials':
##
## prune
##
## The following object is masked from 'package:stats':
##
## cutree#Losing Student_id so I can perform PCA
no.id <- student_features[,-1]
#Checking whether or not it needs scaled
colMeans(no.id)## student_engagement student_performance
## 50.42965 62.41808apply(no.id, 2, sd)## student_engagement student_performance
## 10.14143 13.99781#Scaling and performing PCA
pr.out <- prcomp(no.id, scale = FALSE, center = TRUE)
#summary of PCA
summary(pr.out)## Importance of components:
## PC1 PC2
## Standard deviation 14.0012 10.1368
## Proportion of Variance 0.6561 0.3439
## Cumulative Proportion 0.6561 1.0000#Preprocessing for the Skree Plot
pr.var <- pr.out$sdev^2
pve <- pr.var / sum(pr.var)
#Scree Plot
plot(pve, xlab = "Principal Component", ylab = "Proportion of Variance Explained", ylim = c(0, 0.8), type = "b")
plot(cumsum(pve), xlab = "Principal Component", ylab = "Proportion of Variance Explained", ylim = c(0, 1), type = "b")
#Varience Plot
biplot(pr.out)
#Checking which cluster would be best for kmeans
tot_withinss <- map_dbl(1:10, function(k){
model <- kmeans(x = no.id, centers = k)
model$tot.withinss
})
elbow_df <- data.frame(
k = 1:10,
tot_withinss = tot_withinss
)
ggplot(elbow_df, aes(x = k, y = tot_withinss)) +
geom_line() +
scale_x_continuous(breaks = 1:10)
#Kmeans model with 4 clusters
km.out <- kmeans(no.id, centers = 4, nstart = 25)
#grabbing cluster out of the kmeans model
clust_stu <- km.out$cluster
#putting the cluster column into the dataset
segment_stu <- mutate(no.id, cluster = clust_stu)
#How many students are in each cluster
count(segment_stu, cluster)## cluster n
## 1 1 30
## 2 2 19
## 3 3 23
## 4 4 28#Checking the mean of each cluster
segment_stu %>%
group_by(cluster) %>%
summarise_all(list(mean))## # A tibble: 4 × 3
## cluster student_engagement student_performance
## <int> <dbl> <dbl>
## 1 1 58.8 61.7
## 2 2 52.4 41.2
## 3 3 38.1 61.9
## 4 4 50.3 78.1#plotting the model
plot(no.id, col = km.out$cluster, main = "k-means with 2 clusters")
ggplot(student_features, aes(x = student_engagement, y = student_performance, color = factor(clust_stu))) +
geom_point() +
labs(title = "Student Data with K-Means Clustering",
x = "Student Engagement",
y = "Student Performance")
#Kmeans model with 2 clusters
km.out <- kmeans(no.id, centers = 2, nstart = 25)
#grabbing cluster out of the kmeans model
clust_stu <- km.out$cluster
#putting the cluster column into the dataset
segment_stu <- mutate(no.id, cluster = clust_stu)
#How many students are in each cluster
count(segment_stu, cluster)## cluster n
## 1 1 42
## 2 2 58#Checking the mean of each cluster
segment_stu %>%
group_by(cluster) %>%
summarise_all(list(mean))## # A tibble: 2 × 3
## cluster student_engagement student_performance
## <int> <dbl> <dbl>
## 1 1 50.1 49.1
## 2 2 50.7 72.1#plotting the model
plot(no.id, col = km.out$cluster, main = "k-means with 2 clusters")
ggplot(student_features, aes(x = student_engagement, y = student_performance, color = factor(clust_stu))) +
geom_point() +
labs(title = "Student Data with K-Means Clustering",
x = "Student Engagement",
y = "Student Performance")
#kmeans model
km.out## K-means clustering with 2 clusters of sizes 42, 58
##
## Cluster means:
## student_engagement student_performance
## 1 50.12445 49.08469
## 2 50.65065 72.07329
##
## Clustering vector:
## [1] 1 1 1 2 1 1 1 2 1 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 1 1 2 1 2 2 2 2 1 2 1 2
## [38] 2 2 2 1 2 1 1 2 1 2 2 1 1 1 2 2 1 1 2 2 2 2 2 2 2 1 2 2 2 2 1 2 1 1 1 2 2
## [75] 2 2 1 1 1 2 1 2 1 1 2 1 1 1 2 2 2 1 2 2 2 2 2 2 2 2
##
## Within cluster sum of squares by cluster:
## [1] 6950.383 9749.145
## (between_SS / total_SS = 43.5 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"pam_k2 <- pam(no.id, k = 2)
plot(silhouette(pam_k2))
pam_k <- pam(no.id, k = 4)
plot(silhouette(pam_k))
#grabbing the distance for hclust
dist.students <- dist(no.id)
#performing hclust on the dataset and returning complete
hc_students.complete <- hclust(dist.students, method = "complete")
#cutting the data to 2 clusters
cut.clusters <- cutree(hc_students.complete, k = 2)
#performing hclust on the data set, but to the average
hc_students.average <- hclust(dist.students, method = "average")
#making a dendro variable
dend_stu.complete <- as.dendrogram(hc_students.complete)
#coloring the dendrogram at cluster 2
dend_colored.complete <- color_branches(dend_stu.complete, k = 2)
plot(dend_colored.complete)
plot(hc_students.average)
#cutting the dataset at two clusters
cut.stu <- cutree(hc_students.complete, k = 2)
#grabbing the clusters and putting it into the dataset
clust.stu <- mutate(student_features, cluster = cut.stu)
#grabbing the data to be able to plot it out
gathered.stu <- gather(data = clust.stu, key = student_performance, value = student_engagement, -student_id, -cluster)
sort(cut.stu)## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [38] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2#plotting the data
ggplot(gathered.stu, aes(x = student_performance, y = student_engagement, color = factor(cluster))) + geom_line(aes(group = student_id))
We can then use this data frame to perform unsupervised learning to identify groups of students with similar learning patterns,
Tasks
- Simulate the data.
- Perform dimensionality reduction on the data using PCA.
- Cluster the data using KMeans and other clustering algorithms.
- Interpret the results of your analysis.
Submission
Submit a report containing the following:
A brief description of your approach to dimensionality reduction and clustering.
First before attempting dimensionality reduction I did some preprocessing on the data by getting rid of the student_id feature as it was useful for the prediction of the data. Once that was finished I used PCA to work through the data. I tried out a skree plot, and checked the data itself before to check if the data needed scaled and it did not as it was close to each other. I also checked the variance plot to see if anything stuck out that would work together but it did not show much.
For clustering I made an elbow plot first in order to determine which clusters it should use. The obvious cluster was 2, but I checked 4 as well as it also went down pretty quickly. I also used a silhouette plot in order to determine which of these clusters were better to use, which turned out to be 2.
Lastly I did hierarchical clustering in order to check how the data worked off each other, and how the 2 clusters fit into the data off a dendrogram. I did this to have some extra support for the rest of the model.
The results of your analysis, including the number of clusters identified, the characteristics of each cluster, and any other insights you gained from the data.
The optimal number for kmeans that I found was 2 clusters. My silhouette width for those 2 clusters was stated at 0.38, which was higher than any of the clusters above it. 42 numbers were in one cluster, while the other had 58. The variance was a bit off, as it has a 42.5% total sum of squares which is still under 50% but something to keep in mind. The first cluster was 50/50 on engagement to performance, while the second cluster was average in engagement, but above average in performance.
There seems to be something there in regards to the engagement feeding off the performance, but the variability makes it seem off and would need more data points for further analysis. When looking at the graph from the hierarchical clustering it shows the difference in how engagement will help performance in some ways. All in all I believe the model still needs to be optimized.
A discussion of the implications of your findings for learning analytics.
We would be trying to find if there is any correlation at all between being engaged in studies and seeing an improvement in that regard. According to model that was worked out it seems there is some merit to the engagement being higher then the performance will be higher. This doesn’t seem to be at an extreme rate, and there are a decent amount of outliers, but the students did end up getting grouped up in a way that put emphasis on their performance being higher.This would be what you would search for in any case with some findings like that in order to figure out what you could do in order to improve the students performance in anyway. If this didn’t include the engagement it would be great to find what would cause it in any case and how to improve those aspects themselves. This would later split up what it would take in order to improve each of the categories themselves to feed off one another.
Provide at least one scholarly reference.
Rodgers, T. (2008). Student engagement in the e-learning process and the impact on their grades. International Journal of Cyber Society and Education, 1(2), 143-156. ATISR. Retrieved April 24, 2024 from https://www.learntechlib.org/p/209167/.
Your report should include your code. Submit the published RPubs link to Blackboard.