Assignment 3: Prac0cal Group Assignment Based on Case Studies (80 marks, 40%
# Load necessary librarieslibrary(ggplot2)
Warning: package 'ggplot2' was built under R version 4.3.3
library(dplyr)
Attaching package: 'dplyr'
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
# Set the path to the CSV filefile_path <-read.csv(file.choose())# Read the CSV filebrand_data <- file_path# Display the structure of the datasetstr(brand_data)
'data.frame': 1000 obs. of 10 variables:
$ performance : int 2 1 2 1 1 2 1 2 2 3 ...
$ leadership : int 4 1 3 6 1 8 1 1 1 1 ...
$ productLatest: int 8 4 5 10 5 9 5 7 8 9 ...
$ fun : int 8 7 9 8 8 5 7 5 10 8 ...
$ serious : int 2 1 2 3 1 3 1 2 1 1 ...
$ bargain : int 9 1 9 4 9 8 5 8 7 3 ...
$ bestValue : int 7 1 5 5 9 7 1 7 7 3 ...
$ trendiness : int 4 2 1 2 1 1 1 7 5 4 ...
$ repeatBuy : int 6 2 6 1 1 2 1 1 1 1 ...
$ name : chr "a" "a" "a" "a" ...
# Summary statistics of the datasetsummary(brand_data)
performance leadership productLatest fun
Min. : 1.000 Min. : 1.000 Min. : 1.000 Min. : 1.000
1st Qu.: 1.000 1st Qu.: 2.000 1st Qu.: 4.000 1st Qu.: 4.000
Median : 4.000 Median : 4.000 Median : 7.000 Median : 6.000
Mean : 4.488 Mean : 4.417 Mean : 6.195 Mean : 6.068
3rd Qu.: 7.000 3rd Qu.: 6.000 3rd Qu.: 9.000 3rd Qu.: 8.000
Max. :10.000 Max. :10.000 Max. :10.000 Max. :10.000
serious bargain bestValue trendiness
Min. : 1.000 Min. : 1.000 Min. : 1.000 Min. : 1.00
1st Qu.: 2.000 1st Qu.: 2.000 1st Qu.: 2.000 1st Qu.: 3.00
Median : 4.000 Median : 4.000 Median : 4.000 Median : 5.00
Mean : 4.323 Mean : 4.259 Mean : 4.337 Mean : 5.22
3rd Qu.: 6.000 3rd Qu.: 6.000 3rd Qu.: 6.000 3rd Qu.: 7.00
Max. :10.000 Max. :10.000 Max. :10.000 Max. :10.00
repeatBuy name
Min. : 1.000 Length:1000
1st Qu.: 1.000 Class :character
Median : 3.000 Mode :character
Mean : 3.727
3rd Qu.: 5.000
Max. :10.000
# Generate a correlation matrixcor_matrix <-cor(brand_data[ ,1:9])print(cor_matrix)
# Create histograms for each numeric columnfor (col innames(brand_data)[1:9]) {ggplot(brand_data, aes_string(col)) +geom_histogram(binwidth =1, fill ="blue", color ="black") +labs(title =paste("Histogram of", col), x = col, y ="Frequency") +theme_minimal()}
Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
ℹ Please use tidy evaluation idioms with `aes()`.
ℹ See also `vignette("ggplot2-in-packages")` for more information.
# Boxplot for all numeric columnsmelted_data <- reshape2::melt(brand_data, id.vars ="name")ggplot(melted_data, aes(x = variable, y = value)) +geom_boxplot() +labs(title ="Boxplot of All Numeric Columns", x ="Attributes", y ="Values") +theme_minimal()
Perform relevant pre-processing to con0nue with the unsupervised and supervised
learning methods men0oned in the next few sec0ons.
library(ggplot2)library(reshape2)# Display the structure of the datasetstr(brand_data)
'data.frame': 1000 obs. of 10 variables:
$ performance : int 2 1 2 1 1 2 1 2 2 3 ...
$ leadership : int 4 1 3 6 1 8 1 1 1 1 ...
$ productLatest: int 8 4 5 10 5 9 5 7 8 9 ...
$ fun : int 8 7 9 8 8 5 7 5 10 8 ...
$ serious : int 2 1 2 3 1 3 1 2 1 1 ...
$ bargain : int 9 1 9 4 9 8 5 8 7 3 ...
$ bestValue : int 7 1 5 5 9 7 1 7 7 3 ...
$ trendiness : int 4 2 1 2 1 1 1 7 5 4 ...
$ repeatBuy : int 6 2 6 1 1 2 1 1 1 1 ...
$ name : chr "a" "a" "a" "a" ...
# Check for missing valuessum(is.na(brand_data))
[1] 0
# Handle missing values (if any)# For simplicity, we will remove rows with missing valuesbrand_data <-na.omit(brand_data)# Encode categorical variables (if any)# In this case, 'name' is a categorical variable# Convert 'name' to a factorbrand_data$name <-as.factor(brand_data$name)# Normalize the numeric datanumeric_columns <-names(brand_data)[1:9]preProc <-preProcess(brand_data[, numeric_columns], method =c("center", "scale"))brand_data[, numeric_columns] <-predict(preProc, brand_data[, numeric_columns])# Verify normalizationsummary(brand_data)
performance leadership productLatest fun
Min. :-1.0888 Min. :-1.3100 Min. :-1.6878 Min. :-1.84677
1st Qu.:-1.0888 1st Qu.:-0.9266 1st Qu.:-0.7131 1st Qu.:-0.75358
Median :-0.1523 Median :-0.1599 Median : 0.2615 Median :-0.02478
Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.00000
3rd Qu.: 0.7842 3rd Qu.: 0.6069 3rd Qu.: 0.9113 3rd Qu.: 0.70402
Max. : 1.7206 Max. : 2.1404 Max. : 1.2362 Max. : 1.43281
serious bargain bestValue trendiness
Min. :-1.1961 Min. :-1.22196 Min. :-1.3912 Min. :-1.53897
1st Qu.:-0.8362 1st Qu.:-0.84701 1st Qu.:-0.9743 1st Qu.:-0.80960
Median :-0.1163 Median :-0.09711 Median :-0.1405 Median :-0.08023
Mean : 0.0000 Mean : 0.00000 Mean : 0.0000 Mean : 0.00000
3rd Qu.: 0.6036 3rd Qu.: 0.65279 3rd Qu.: 0.6933 3rd Qu.: 0.64914
Max. : 2.0434 Max. : 2.15258 Max. : 2.3610 Max. : 1.74319
repeatBuy name
Min. :-1.0717 a :100
1st Qu.:-1.0717 b :100
Median :-0.2857 c :100
Mean : 0.0000 d :100
3rd Qu.: 0.5003 e :100
Max. : 2.4652 f :100
(Other):400
# Visualize the normalized datamelted_data <-melt(brand_data, id.vars ="name")ggplot(melted_data, aes(x = variable, y = value)) +geom_boxplot() +labs(title ="Boxplot of Normalized Numeric Columns", x ="Attributes", y ="Values") +theme_minimal()
# Save the preprocessed data to a new CSV filewrite.csv(brand_data, "preprocessed_brand_data.csv", row.names =FALSE)
Perform an appropriate unsupervised learning technique (only from the ones you have
learned in this course) to group respondents according to the brand percep0on variables. Describe the groups of respondents according to their ra0ng of the percep0on variables and their likelihood to buy the brand again.
Warning: package 'cluster' was built under R version 4.3.3
library(factoextra)
Warning: package 'factoextra' was built under R version 4.3.3
Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
# Normalize the numeric datanumeric_columns <-names(brand_data)[1:9]preProc <-preProcess(brand_data[, numeric_columns], method =c("center", "scale"))brand_data[, numeric_columns] <-predict(preProc, brand_data[, numeric_columns])# Determine the optimal number of clusters using the elbow methodset.seed(123)fviz_nbclust(brand_data[, numeric_columns], kmeans, method ="wss")
# Perform K-means clustering with the chosen number of clustersset.seed(123)kmeans_result <-kmeans(brand_data[, numeric_columns], centers =3, nstart =25)# Add the cluster assignments to the datasetbrand_data$cluster <-as.factor(kmeans_result$cluster)# Summarize the clusterscluster_summary <- brand_data %>%group_by(cluster) %>%summarise(across(everything(), mean))
Warning: There were 3 warnings in `summarise()`.
The first warning was:
ℹ In argument: `across(everything(), mean)`.
ℹ In group 1: `cluster = 1`.
Caused by warning in `mean.default()`:
! argument is not numeric or logical: returning NA
ℹ Run `dplyr::last_dplyr_warnings()` to see the 2 remaining warnings.
# Visualize the clustersfviz_cluster(kmeans_result, data = brand_data[, numeric_columns])
# Analyze the likelihood to buy the brand again for each clusterrepeat_buy_summary <- brand_data %>%group_by(cluster) %>%summarise(mean_repeatBuy =mean(repeatBuy))# Print the repeat buy summaryprint(repeat_buy_summary)
technique (only from the ones you have learned in this course) to reduce the dimension of the brand percep0on variables into a smaller number of components. Describe the components based on the variables used to combine them.
# Visualize the PCA scorespca_plot <-ggplot(brand_data, aes(x = PC1, y = PC2, color = name)) +geom_point() +labs(title ="PCA of Brand Perception Variables", x ="PC1", y ="PC2") +theme_minimal()print(pca_plot)
Obtain and interpret a descrip0ve analysis table or graph to compare the scores of the
components obtained in (iii) by groups obtained in (ii). Compare your interpreta0on of the results in (iv) with the interpreta0on in (iii)
::: {.cell}
```{.r .cell-code}
library(factoextra)
library(ggplot2)
library(corrplot)
library(dplyr)
library(tidyr)
library(tibble)
# Handle missing values (if any)
brand_data <- na.omit(brand_data)
# Select only the numeric columns for PCA
brand_numeric <- brand_data %>%
select(performance, leadership, productLatest, fun, serious, bargain, bestValue, trendiness, repeatBuy)
# Normalize the numeric data
normalized_data <- scale(brand_numeric)
# Perform PCA
pca_model <- prcomp(normalized_data, center = TRUE, scale. = TRUE)
# Get the PCA scores
pca_scores <- as.data.frame(pca_model$x)
# Ensure unique column names for PCA scores
colnames(pca_scores) <- paste0("PC", 1:ncol(pca_scores))
# Remove any existing PCA score columns if they exist
brand_data <- brand_data %>%
select(-starts_with("PC"))
# Add PCA scores to the original data
brand_data <- cbind(brand_data, pca_scores)
# Perform K-means clustering with 3 clusters (as an example)
set.seed(123)
kmeans_result <- kmeans(normalized_data, centers = 3, nstart = 25)
# Add the cluster assignment to the original data
brand_data$cluster <- as.factor(kmeans_result$cluster)
# Descriptive analysis of component scores by clusters
component_means <- brand_data %>%
group_by(cluster) %>%
summarise(across(starts_with("PC"), list(mean = mean, sd = sd)))
# Print the descriptive analysis table
print(component_means)
# Visualize the PCA scores by clusters
pca_plot <- ggplot(brand_data, aes(x = PC1, y = PC2, color = cluster)) +
geom_point() +
labs(title = "PCA of Brand Perception Variables by Cluster", x = "PC1", y = "PC2") +
theme_minimal()
print(pca_plot)
# Visualize the component scores by clusters
component_scores_plot <- brand_data %>%
pivot_longer(cols = starts_with("PC"), names_to = "Component", values_to = "Score") %>%
ggplot(aes(x = Component, y = Score, fill = cluster)) +
geom_boxplot() +
labs(title = "Component Scores by Cluster", x = "Component", y = "Score") +
theme_minimal()
print(component_scores_plot)
```
:::
After conducting the
unsupervised learning method in (iii), conduct a supervised learning method to determine the factors influencing repeatBuy. To develop your supervised learning model, you do not need to split your data into training and tes0ng as you are required to use the en0re dataset to develop your model. Your independent variables should consist of the components developed from the unsupervised learning in (iii), the grouping variable obtained from the unsupervised learning in (ii) and the brand names. Interpret the influence of all the independent variables on repeatBuy.
library(factoextra)library(ggplot2)library(corrplot)library(dplyr)library(tidyr)library(tibble)library(broom)# Handle missing values (if any)brand_data <-na.omit(brand_data)# Select only the numeric columns for PCAbrand_numeric <- brand_data %>%select(performance, leadership, productLatest, fun, serious, bargain, bestValue, trendiness, repeatBuy)# Normalize the numeric datanormalized_data <-scale(brand_numeric)# Perform PCApca_model <-prcomp(normalized_data, center =TRUE, scale. =TRUE)# Get the PCA scorespca_scores <-as.data.frame(pca_model$x)# Ensure unique column names for PCA scorescolnames(pca_scores) <-paste0("PC", 1:ncol(pca_scores))# Remove any existing PCA score columns if they existbrand_data <- brand_data %>%select(-starts_with("PC"))# Add PCA scores to the original databrand_data <-cbind(brand_data, pca_scores)# Perform K-means clustering with 3 clusters (as an example)set.seed(123)kmeans_result <-kmeans(normalized_data, centers =3, nstart =25)# Add the cluster assignment to the original databrand_data$cluster <-as.factor(kmeans_result$cluster)# Fit a linear regression model to determine factors influencing repeatBuylm_model <-lm(repeatBuy ~ PC1 + PC2 + PC3 + PC4 + PC5 + PC6 + PC7 + PC8 + PC9 + cluster + name, data = brand_data)# Summarize the linear modellm_summary <-summary(lm_model)print(lm_summary)
# Visualize the influence of independent variables on repeatBuycoefficients %>%filter(term !="(Intercept)") %>%ggplot(aes(x =reorder(term, estimate), y = estimate)) +geom_col() +coord_flip() +labs(title ="Influence of Independent Variables on repeatBuy", x ="Variables", y ="Coefficient Estimate") +theme_minimal()
