This section clears the environment, loads the dataset, and maps the 5-star rating system to binary sentiment labels, excluding neutral (3-star) reviews.
# Global options for the document
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.width = 10)
# Load required libraries
library(syuzhet)
library(sentimentr)
##
## Attaching package: 'sentimentr'
## The following object is masked from 'package:syuzhet':
##
## get_sentences
library(meanr)
library(paletteer)
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
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(ggplot2)
library(forcats)
library(mltools)
# Clear workspace
rm(list = ls())
# Load data using your specific Mac file path
data <- read.csv("/Users/rezwanesadik/Documents/DeskTop Old/Conference/AllProductReviews.csv", header = TRUE)
# read.csv(file.choose(), header = TRUE)
# Prepare labels: 1,2 -> Negative; 4,5 -> Positive; 3 -> Excluded
data$label <- factor(data$ReviewStar,
levels = c(1, 2, 4, 5),
exclude = 3,
labels = c("Negative", "Negative", "Positive", "Positive"))
# Remove empty reviews and NAs
data_amazon <- na.omit(data[data$ReviewBody != "" & !is.na(data$ReviewBody), ])
# Preview data
head(data_amazon)
## ReviewTitle
## 2 Unreliable earphones with high cost\n
## 3 Really good and durable.\n
## 4 stopped working in just 14 days\n
## 5 Just Awesome Wireless Headphone under 1000...😉\n
## 6 Charging port not working\n
## 7 Loved the color and sound !!\n
## ReviewBody
## 2 This earphones are unreliable, i bought it before 15 days meanwhile right side ear buds got cracked automatically and it got divided in two parts, and sound quality is also not that much good but ok, one more thing bass is not good as it is a boat earphones.Guys,Also for the proof i have attached picsPlease see and think before buying this unreliable product.Thanks.\n
## 3 i bought itfor 999,I purchased it second time, gifted first one to brother. This is really good.Sound quality is really good.You can connect 2 devices at a time.I connect laptop and mobile both.when listening muaic on Lappy, if u get a call, it switches to mobile,this switch between device is not good but again in this price its awesome.Battery stand by is 36 hours for me, and i have used it continously for 8 hours in one go. So Battery life is pretty awesome.Comfortable on ear.\n
## 4 Its sound quality is adorable. overall it was good but just for 2 weeks after that it stopped working and since then it never powered on again. I am claiming for warrenty and it is still undergoing.\n
## 5 Its Awesome... Good sound quality & 8-9 hrs battery life... Just waww look... 😉 I brought just 999 rupees...But Amazon's Packageing system is Very bad... Very poor packaging... Flipcart's packaging system is much better than Amazon...\n
## 6 After 11 days, the charging port isn't working and now I can't even return it. Wat to do ?? I know there is one year warranty but it is only been 11 days. C'mon boat, please send me new one.\n
## 7 Sound-4.5/5Build quality-4.5/5Battery life -4/5Earphones quality is good with strong magnetic lock... Straps is good quality and the earphones wires are too good... Buttons quality is good.. sound is full of punchy bass and and balanced treble and has sorrund effect.. good fitting in ears.. hope connectivity is good.. bcz my last boat Bluetooth bassheads 225 had connection issues... This is worth its price... Hope the packaging was good ...there was no bubble wrapping..\n
## ReviewStar Product label
## 2 1 boAt Rockerz 255 Negative
## 3 4 boAt Rockerz 255 Positive
## 4 1 boAt Rockerz 255 Negative
## 5 5 boAt Rockerz 255 Positive
## 6 1 boAt Rockerz 255 Negative
## 7 4 boAt Rockerz 255 Positive
We apply 11 different lexicon methods to calculate sentiment scores. These are then discretized into “Positive”, “Negative”, or “Neutral” based on their numerical value.
library(DT) # Added for interactive tables
# Global options for the document
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.width = 10)
afinn <- as_key(syuzhet:::afinn)
# Calculate sentiment scores (Lines broken down to prevent HTML overflow)
out1 <- data.frame(
data_amazon,
sentimentr_hu_liu = sentiment_by(
data_amazon$ReviewBody, polarity_dt = lexicon::hash_sentiment_huliu, question.weight = 0)[["ave_sentiment"]],
sentimentr_sentiword = sentiment_by(
data_amazon$ReviewBody, polarity_dt = lexicon::hash_sentiment_sentiword, question.weight = 0)[["ave_sentiment"]],
sentimentr_jockers = sentiment_by(
data_amazon$ReviewBody, polarity_dt = lexicon::hash_sentiment_jockers, question.weight = 0)[["ave_sentiment"]],
sentimentr_afinn = sentiment_by(
data_amazon$ReviewBody, polarity_dt = afinn, question.weight = 0)[["ave_sentiment"]],
sentimentr_nrc = sentiment_by(
data_amazon$ReviewBody, polarity_dt = lexicon::hash_sentiment_nrc, question.weight = 0)[["ave_sentiment"]],
sentimentr_loughran_mcdonald = sentiment_by(
data_amazon$ReviewBody, polarity_dt = lexicon::hash_sentiment_loughran_mcdonald, question.weight = 0)[["ave_sentiment"]],
meanr = meanr::score(data_amazon$ReviewBody)$score,
syuzhet_ = setNames(as.data.frame(lapply(c("syuzhet", "bing", "afinn", "nrc"),
function(x) get_sentiment(data_amazon$ReviewBody, method=x))),
paste0("", c("syuzhet", "bing", "afinn", "nrc"))),
stringsAsFactors = FALSE
)
# Isolate the 11 lexicon score columns
lexicon_cols <- c("sentimentr_hu_liu", "sentimentr_sentiword", "sentimentr_jockers",
"sentimentr_afinn", "sentimentr_nrc", "sentimentr_loughran_mcdonald",
"meanr", "syuzhet_.syuzhet", "syuzhet_.bing", "syuzhet_.afinn", "syuzhet_.nrc")
out <- out1[, lexicon_cols]
# Map numerical scores to discrete labels
out[out > 0] <- "Positive"
out[out < 0] <- "Negative"
out[out == 0 ] <- "Neutral"
# Append text and true labels
out$text <- out1$ReviewBody
out$label <- out1$label
# Use DT for an interactive, searchable table instead of static kable
datatable(head(out[,1:5], 100),
options = list(pageLength = 5, scrollX = TRUE),
caption = "Sample of Categorized Sentiment Scores (Interactive)")
We compare the predicted labels from each lexicon against the original star-rating labels to determine which lexicon performs best.
# Global options for the document
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.width = 10)
reference <- out$label
# Define accuracy function
calculate_accuracy <- function(predicted, reference, lexicon_name) {
u <- union(predicted, reference)
t <- table(factor(predicted, u), factor(reference, u))
accuracy <- tryCatch(confusionMatrix(t)$overall[1], error = function(e) NA)
data.frame(Lexicon = lexicon_name, Accuracy = accuracy)
}
# Calculate accuracy for all lexicons
df_results <- data.frame(Lexicon = character(), Accuracy = numeric())
for (lexicon in lexicon_cols) {
predicted <- out[[lexicon]]
accuracy_df <- calculate_accuracy(predicted, reference, lexicon)
df_results <- bind_rows(df_results, accuracy_df)
}
# Sort results
sorted_df <- df_results[order(df_results$Accuracy, decreasing = TRUE), ]
# Use DT to make the rankings interactive and format as percentages
datatable(sorted_df,
options = list(pageLength = 11, dom = 't'),
rownames = FALSE,
caption = "Lexicon Accuracy Rankings") %>%
formatPercentage('Accuracy', 1)
A comparison of the accuracy rates across all tested lexicons.
library(plotly) # Added for interactive plots
# Global options for the document
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.width = 10)
# Create the base ggplot
acc_plot <- ggplot(sorted_df, aes(x = fct_reorder(Lexicon, Accuracy), y = Accuracy, fill = Lexicon, text = paste("Accuracy:", sprintf("%.1f%%", Accuracy * 100)))) +
scale_fill_brewer(palette = "Paired", type = "qual") +
geom_col() +
labs(x = "Lexicon", y = "Accuracy", title = "Lexicon Based Sentiment Accuracy Comparison") +
theme_minimal() +
theme(legend.position = "none", axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip()
# Convert ggplot to interactive plotly graph
ggplotly(acc_plot, tooltip = "text")
In this section, we analyze how valence shifters (negators, amplifiers, de-amplifiers, and adversative conjunctions) affect the sentiment of the Amazon reviews.
# Global options for the document
knitr::opts_chunk$set(echo = TRUE, warning = FALSE, message = FALSE, fig.width = 10)
library(stringr)
library(lexicon)
library(knitr)
library(kableExtra)
# 1. Prepare text for manual extraction
text_clean <- tolower(as.character(out$text))
text_clean <- text_clean[!is.na(text_clean)]
# 2. Load valence shifter dictionary
shifters <- lexicon::hash_valence_shifters
# 3. Build exact word boundary regex patterns for each shifter type
regex_neg <- paste0("\\b(", paste(shifters$x[shifters$y == 1], collapse = "|"), ")\\b")
regex_amp <- paste0("\\b(", paste(shifters$x[shifters$y == 2], collapse = "|"), ")\\b")
regex_deamp <- paste0("\\b(", paste(shifters$x[shifters$y == 3], collapse = "|"), ")\\b")
regex_adv <- paste0("\\b(", paste(shifters$x[shifters$y == 4], collapse = "|"), ")\\b")
# 4. Count how many reviews contain at least one of each shifter type
count_neg <- sum(str_detect(text_clean, regex_neg))
count_amp <- sum(str_detect(text_clean, regex_amp))
count_deamp <- sum(str_detect(text_clean, regex_deamp))
count_adv <- sum(str_detect(text_clean, regex_adv))
total_reviews <- length(text_clean)
# 5. Calculate percentages relative to the total number of reviews
pct_neg <- paste0(round((count_neg / total_reviews) * 100), "%")
pct_amp <- paste0(round((count_amp / total_reviews) * 100), "%")
pct_deamp <- paste0(round((count_deamp / total_reviews) * 100), "%")
pct_adv <- paste0(round((count_adv / total_reviews) * 100), "%")
# 6. Construct the formatted dataframe
valance_table <- data.frame(
Text = "Amazon_Reviews",
Negator = pct_neg,
Amplifier = pct_amp,
Deamplifier = pct_deamp,
Adversative = pct_adv,
stringsAsFactors = FALSE
)
# 7. Render the styled table to match specifications
kable(valance_table, align = "c", caption = "Table 5: Valance Shifters output of the dataset.") %>%
kable_styling(bootstrap_options = "bordered", full_width = FALSE, position = "center", font_size = 14) %>%
row_spec(0, bold = TRUE, font_size = 14) %>%
column_spec(1, bold = TRUE, italic = TRUE) %>%
column_spec(2, background = "#FCE4D6", bold = TRUE) %>%
column_spec(3, background = "#E2EFDA", bold = TRUE) %>%
column_spec(4, background = "#F2F2F2", bold = TRUE) %>%
column_spec(5, background = "#DDEBF7", bold = TRUE)
| Text | Negator | Amplifier | Deamplifier | Adversative |
|---|---|---|---|---|
| Amazon_Reviews | 36% | 33% | 11% | 20% |
We isolate the predictions of the Jockers lexicon, filtering out common ambiguous (Neutral) predictions to assess its binary classification capabilities via a confusion matrix and Matthews correlation coefficient (MCC).
# Filter for reviews predicted as Neutral by all key lexicons
common_neutral_reviews <- out %>%
filter(
sentimentr_jockers == "Neutral" & syuzhet_.afinn == "Neutral" &
sentimentr_hu_liu == "Neutral" & sentimentr_sentiword == "Neutral" &
sentimentr_loughran_mcdonald == "Neutral" & sentimentr_afinn == "Neutral" &
sentimentr_nrc == "Neutral" & meanr == "Neutral" &
syuzhet_.syuzhet == "Neutral" & syuzhet_.bing == "Neutral" &
syuzhet_.nrc == "Neutral"
)
# Remove the common neutral reviews for binary evaluation
final_out <- out[!(out$text %in% common_neutral_reviews$text), ]
predicted_j <- factor(final_out$sentimentr_jockers, levels = c("Negative", "Positive"))
reference_j <- factor(final_out$label, levels = c("Negative", "Positive"))
# Create 2x2 confusion matrix
conf_matrix_ <- table(predicted_j, reference_j)
# Visualize confusion matrix
fourfoldplot(conf_matrix_, color = c("pink", "lightblue"), conf.level = 0, margin = 1, main = "Jockers Lexicon Confusion Matrix")
# Calculate Matthews Correlation Coefficient (MCC)
mcc_value <- mcc(TN=conf_matrix_[1,1], TP=conf_matrix_[2,2], FP=conf_matrix_[1,2], FN=conf_matrix_[2,1])
cat("Matthews Correlation Coefficient (MCC):", round(mcc_value, 4), "\n\n")
## Matthews Correlation Coefficient (MCC): 0.6565
# Detailed caret statistics
confusionMatrix(predicted_j, reference_j)
## Confusion Matrix and Statistics
##
## Reference
## Prediction Negative Positive
## Negative 2297 728
## Positive 851 8188
##
## Accuracy : 0.8691
## 95% CI : (0.863, 0.8751)
## No Information Rate : 0.7391
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6563
##
## Mcnemar's Test P-Value : 0.002139
##
## Sensitivity : 0.7297
## Specificity : 0.9183
## Pos Pred Value : 0.7593
## Neg Pred Value : 0.9059
## Prevalence : 0.2609
## Detection Rate : 0.1904
## Detection Prevalence : 0.2507
## Balanced Accuracy : 0.8240
##
## 'Positive' Class : Negative
##