Final Project

1.1 Recommender systems

The goal of a recommender system is to help users – usually consumers – find what they want and discover new information that will help them. Recommender systems are ubiquitous now in online marketing – for books, music, health care services, the arts. Recommender systems may follow different paradigms. Content-based systems recommend based on similarity between items or users; similarity can be quantified using a variety of measures: cosine similarity, k-nearest neighbors, Pearson correlation, logistic regression models and more.

In User-Based Collaborative Filtering (UBCF), items are recommended assuming that users with similar preferences will rate items similarly. In Item-Based Collaborative Filtering (IBCF), the presumption is that users will prefer items that are similar to other items they like. Information about users and items is stored in a matrix that is modeled and used to make predictions – the recommendations.

In this project, we use the recommenderlab package in R to design User-Based and Item-Based recommender systems based on a database of Amazon Fine Food reviews. Our models incorporate ratings from 71,188 Amazon users on 31,589 products.

Results: We built five different recommender models using three different similarity measures and evaluated them with ROC curves and confusion matrices. The best-performing model was User-Based Collaborative Filtering using Pearson correlation a recall of ~22 percent and precision of ~10 percent at k=40 (i.e., when 40 recommendations are used to compute similarity). At k > 40, the IBCF models peformed better. For reasons of computing efficiency, we select UBCF-Pearson as our preferred system.

In Appendix I, we also include code for our attempt at a recommender system using semantic analysis. Similarity is computed on a document-term matrix using a Support Vector Machine. Results appear to be more accurate than our UBCF model, although we ran out of time to thoroughly evaluate the semantic approach.

1.2 Amazon Fine Foods and the Recommender System

Amazon is an American electronic commerce and cloud computing company founded on July 5, 1994, by Jeff Bezos and is based in Seattle. It is the largest internet-based retailer in the world by total sales and market capitalization. Part of Amazon’s success is due to the company’s recommender systems and their incredible success in marketing products based on user preferences and product similarity. This as a result had led to increases in sales and an overall asset to the company. Amazon’s own recomender system, known as item-to-item collaborative filtering, is a hybrid approach designed to produce strong results using fast, efficient computing in a high-volume, information dense environment. By comparison, the recommender systems were offer here are basic.

Amazon’s recommender algorithms can be found here.

In this exercise, we will be creating a recommender system that will help guide its users for their next meals (or their pet’s, as is the case). Just like many other products on Amazon, a user would have purchased the food item and rated it from a 1 to 5 scale, with 1 being terrible and 5 being terrific. These ratings are the numeric basis for computing similarity in our models.

4.1 How many unique users and products?

Unique users: 71,308. Unique products: 31,864

4.2 What are most-reviewed products?

The most-reviewed item is Quaker Soft-Baked Cookies, with 913 reviews. Second most-reviewed product is Nature’s Way coconut oil moisturizer.

4.3 Who are the top reviewers?

The top reviewer, with 181 reviews, is ‘C. F. Hill’. Second-top reviewer, with 106 reviews, is ‘B. Davis, The Happy Hermit’.

4.4 What is the distribution of reviewer scores?

Most users only rate a single item – the distribution is strongly skewed to the left. By comparison, rating scores are skewed to the right – the average review score is 4.18. Reviewers tend to give positive reviews overall. (The plots show each user’s mean scores for products rated 50 or more times.)

# top products sort
# ungroup(data4) %>%
#   group_by(ProductId) %>%
#   summarize(Count=n()) %>%
#   arrange(desc(Count))

# top reviewers
# ungroup(data4) %>%
#   group_by(UserId) %>%
#   summarize(Count=n()) %>%
#   arrange(desc(Count))

# limit to products with more than median number of reviews
data4 <- data3[which(data3$Count >= medianProds),]

# remove any duplicate reviews
data4 <- data4[!duplicated(data4[,c(1,3)]),]

# add a reviewer count
reviewer_count <- ungroup(data4) %>%
                    group_by(UserId) %>%
                    summarize(RCount = n())

# merge into df
data4 <- merge(data4, reviewer_count, by.x='UserId', by.y='UserId', all.x=T)

avgScore <-round(mean(data4$Score), 2)

# distributon of product mean scores
ggplot(data4[which(data4$RCount <= 50),], aes(x=Mean_score)) +
  geom_histogram(binwidth=.01, alpha=.5, position="identity") +
  geom_vline(aes(xintercept=mean(Score)), color="blue") +
  annotate("text", x=4.6, y=1500, label=paste("Mean = ", avgScore)) +
  labs(x="Mean Score", y="Count",
          title="Distribution of User Mean Ratings") +
  theme_tufte()

# number of reviews
ggplot(data4[which(data4$RCount <= 50),], aes(x=RCount)) +
    geom_histogram(binwidth=1, alpha=.5, position="identity") +
    labs(x="Count of Reviews", y="Count of Users",
         title="Distribution, Number of Reviews per User") +
    theme_tufte()

4.5 Differences among reviewers

Do users who review more products tend to give different scores? The chart below shows that reviewers are fairly consistent despite reviewer experience. Scores tend to be about the same, although they are skewed to be positive overall with averages above 4 in all groups.

# suggestion for further exploration: difference in average scores for bins of reviewers 0-5 reviews 5-10 reviews, etc.

data4$Rcut<-cut(data4$RCount, c(0,5,10,15,20,25,30,35,40,45,50,100,200))

# descriptive stats based on reviwer activity

statbox <- ungroup(data4) %>%
              group_by(Rcut) %>%
              summarize(avgScore = round(mean(Score, na.rm=T), 2),
                        medScore = median(Score),
                        sdScore = round(sd(Score, na.rm=T), 2))

colnames(statbox) <- c("Review Count", "Average Score",
                       "Median Score", "Std Deviation")
kable(statbox)

5.1 Matrix inspection

Recommenderlab provides functions to inspect the data. As with most sales websites with reviews, there will be many users, but the majority of users will not have reviewed most of the items (foods in this case) listed on the website. As a result, the matrix will be sparse (in other words, lots of empty fields!).

# This function shows what the sparse matrix looks like.
getRatingMatrix(r[c(1:5),c(1:4)])

## 5 x 4 sparse Matrix of class "dgCMatrix"
##                       0006641040 7310172001 7310172101 B00002N8SM
## A015565634RZNSDLJBE5M          .          .          .          .
## A06364072LBY1F3ING9XN          .          .          .          .
## A09539661HB8JHRFVRDC           .          .          .          .
## A1000WA98BFTQB                 .          .          .          .
## A1001H5ESPYUFH                 .          .          .          .

5.2 Reviewer bias

Sparse data is not the only issue. Most review sites suffer from reviewer bias. There will be some users who tend to rate nearly all 4s and 5s, while others rate 1s and 2s. To deal with these biases, we will normalize the data. In other words, this normalization will transform scores around a mean of 0.

A heatmap helps visualize overall ratings between the users and his/her items. The heatmap below suffers visually from sparse data but still shows which users are high raters and products that are rated frequently.

# Visualize only the users who have tried many differents foods and the foods that have been tried/eaten/rated by many users. To identify and select the most relevant users and foods, follow these steps:

# 1. Determine the minimum number of foods per user.
# 2. Determine the minimum number of users per food.
# 3. Select the users and foods matching these criteria.

min_n_foods <- quantile(rowCounts(r), 0.999)
min_n_users <- quantile(colCounts(r), 0.99)

# Now, we can visualize the rows and columns matching the criteria
image(r[rowCounts(r) > min_n_foods, colCounts(r) > min_n_users, main = "Heatmap of the top users and foods"])

5.3 Recommending by item popularity – Example

It’s always interesting to see the occurrences of the ratings. When customers go into a restaurant or into a grocery store, they naturally gravitate to popular items. If the items have been bought and have been high ratings, it seems reasonable that the customer would repurchase this food or item. Amazon’s job, however, is to increase sales by recommending similar products.

Recommenderlab offers multiple recommender algorithms. To demonstrate, this next chunk uses the “POPULAR” method – the number of times users have rated an item. More details on Recommenderlab algorithms can be found in the References section.

This code models Top 5 recommendations based on the first 10,000 users and predicts Top 5 recommendations for the next 500 users based on the model. Predictions for users 10,001 to 10,1003 are shown. Recommendations for the first three users in the matrix are shown below.

# Create a recommender from the first 10000 users in our rating matrix.
r.popular <- Recommender(r[1:10000], method = "POPULAR")

# Get the top 5 recommendation lists for the next user not used to learn the model.
recom <- predict(r.popular, r[10001:10500], n =5)

# View the recommendations top 5 recommendations for five users not in the The result contains ordered top-N (n = 5) recommendation lists, one for each user. The recommended items can be inspected as a list.

as(recom, "list")[1:3]

## $A1DMBZHY2EJGCE
## [1] "B0051COPH6" "B0045XE32E" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C"
## 
## $A1DMCHMEAH7B3T
## [1] "B0051COPH6" "B0045XE32E" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C"
## 
## $A1DMF3MR624OBE
## [1] "B0051COPH6" "B0045XE32E" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C"

unique(as(recom, "list"))

## [[1]]
## [1] "B0051COPH6" "B0045XE32E" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C"
## 
## [[2]]
## [1] "B0045XE32E" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C" "B003XDH6M6"
## 
## [[3]]
## [1] "B0051COPH6" "B004FEN3GK" "B001EO5U3I" "B008J1HO4C" "B003XDH6M6"
## 
## [[4]]
## [1] "B0051COPH6" "B0045XE32E" "B004FEN3GK" "B003XDH6M6" "B000HDK0DC"
## 
## [[5]]
## [1] "B0045XE32E" "B001EO5U3I" "B008J1HO4C" "B003XDH6M6" "B000HDK0DC"

users <- unique(as(recom, "list"))

products <- c("Baby Gourmet Organic Simple Stage", "Honey Maid Graham Crackers", "Newman's Own Dog Treats", "Fudge Drizzle Caramel Popcorn", "Back To Nature Golden Honey Oat Grahams", "Love Crunch Granola", "Prima Taste Rendance Curry", "Vanilla Blueberry Oat Clusters", "Love Crunch Chocolate Granola", "Mccann's Steel Cut Oatmeal", "Newman's Own Licorice Twists", "Mccann's Steel Cut Irish Oatmeal", "YumEarth Organic Lollipops")

prodIDs <- c("B0051COPH6", "B004FEN3GK", "B0045XE32E", "B004JGQ15E", "B004BKLHOS",  "B006J4MAIQ", "B0041CIP3M", "B008RWUHA6", "B006J4MAUE", "B008J1HO4C", "B003XDH6M6", "B001EO5U3I", "B000HDK0DC")

Product <- unlist(users)
RecNum <- rep(1:5, 5)
ID <- rep(1:5, each=5)
df <- cbind(ID, RecNum, Product)

items_df <- data.frame(cbind(prodIDs, products))

df <- merge(df, items_df, by.x="Product", by.y="prodIDs", all.x = TRUE)
df <- df[, c(2,3,1,4)]
colnames(df)[4] <- "Name"
df$Name <- strtrim(df$Name, 12)

pop_recs <- spread(df[, c(1,2,4)], RecNum, Name)

kable(pop_recs)

6.1 Preparing the item-based model

We will define the training and test set and create an IBCF recommender system based on cosine similarity between items. For ease of computation, we will limit the model to users who have rated at least 30 foods and foods that have been reviewed at least 100 times.

Our algorithm will compute the cosine similarity for all the items and identify the k=30 most similar items for making recommendations. The model returns an 815 x 815 matrix of similarity scores as indicated in the heat map.

# prune the data to users > 30 and products reviewed > 100
ratings_foods <- r[rowCounts(r) > 30, colCounts(r) > 100]
ratings_foods1 <- ratings_foods[rowCounts(ratings_foods) > 30,]
# ratings_foods1

# create training, test indices at 80/20
which_train <- sample(x = c(TRUE, FALSE), size = nrow(ratings_foods1), replace = TRUE, prob = c(0.8, 0.2))

# create the training and the test data sets
recc_data_train <- ratings_foods1[which_train, ]
recc_data_test <- ratings_foods1[!which_train, ]

# Build recommender IBCF - cosine:
recc_model <- Recommender(data = recc_data_train, method = "IBCF", parameter = list(k = 30))

# We have now created a IBCF Recommender Model

model_details <- getModel(recc_model)

print("Similarity Matrix Dimensions")

## [1] "Similarity Matrix Dimensions"

dim(model_details$sim)

## [1] 815 815

n_items_top <- 200
image(model_details$sim[1:n_items_top, 1:n_items_top], main = "Heatmap of the first 200 rows and columns")

6.2 Testing the item-based model

Now that we have trained the IBCF Recommender Model with the training set we will evaluate it using the test set. Our method is to return a Top 5 list for users in the test data. Recommendations are shown for the first three users.

# We will define n_recommended that defines the number of items to recommend to each user and with the predict function, create prediction(recommendations) for the test set.

n_recommended <- 5
recc_predicted <- predict(object = recc_model, newdata = recc_data_test, n = n_recommended)

# This is the recommendation for the first user
recc_predicted@items[[1]]

## [1] 64 66 67 68 71

# Now let's define a list with the recommendations for each user
recc_matrix <- lapply(recc_predicted@items, function(x){
  colnames(ratings_foods)[x]
})

# Let's take a look the recommendations for the first four users:
recc_matrix[1:3]

## $A13MKSASQ6YWL7
## [1] "B000CQC08C" "B000CQE3HS" "B000CQE3IC" "B000CQE3NM" "B000CQG8AS"
## 
## $A16AXQ11SZA8SQ
## [1] "B000084EZ4" "B00008CQVA" "B000CQE3HS" "B000CQE3IC" "B000CQID1A"
## 
## $A16WPA6JV83YXT
## [1] "B000YSRK7E" "B000YSTIL0" "B001AHFVHO" "B001AHJ2D8" "B001AHJ2FQ"

6.2.1 Exploration

The recommendations for User 1 are, respectively, Zukes Chicken Minis (dog treat), Zuke’s Mini Naturals (dog treat), Feline Pine Cat Litter, Zukes Mini Naturals and Bourbon Vanilla Beans.

Clearly a pet person. The similarities between products is obvious, with the exception of the vanilla beans.

For User 3, the recommendations are Havahart Critter Ridder, Lickety Stik (dog treat), another Lickety Stik, Bacon Flavor Lickety Stik, still another Lickety Stik treat. Clearly the products are similar.

7.1 Building the UBCF model

We’ll use UBCF and cosine similarity model our training data. The data is automatically normalized to control for rating bias.

# The method computes the similarity between users with cosine
recc_model2 <- Recommender(data = recc_data_train, method = "UBCF")

# A UBCF recommender has now been created
model2_details <- getModel(recc_model2)

print("Summary of UBCF matrix")

## [1] "Summary of UBCF matrix"

model2_details$data

## 77 x 815 rating matrix of class 'realRatingMatrix' with 2942 ratings.
## Normalized using center on rows.

names(model2_details)

## [1] "description" "data"        "method"      "nn"          "sample"     
## [6] "normalize"   "verbose"

7.2 Predictions on the test set.

As with IBCF, we use the model to predict a Top 5 list for each user.

# predict on test set
recc2_predicted <- predict(object = recc_model2, newdata = recc_data_test, n = n_recommended)

# Let's define a list with the recommendations to the test set users.
recc2_matrix <- sapply(recc2_predicted@items, function(x) {
  colnames(ratings_foods)[x]
})

# Again, let's look at the first three users:
#
top3 <- recc2_matrix[1:3]
top3

## $A13MKSASQ6YWL7
## [1] "B004FEN3GK" "B004BKLHOS" "B005CUU23S" "B005CUU25G" "B005GBIXZM"
## 
## $A16AXQ11SZA8SQ
## [1] "B007I7YZJK" "B007I7Z3Z0" "B004BKLHOS" "B007JFXWRC" "B004R8L71W"
## 
## $A16WPA6JV83YXT
## [1] "B004FEN3GK" "B004JGQ15E" "B007I7YZJK" "B007I7Z3Z0" "B005OVPK9G"

8.1 IBCF Model and Evaluation

The next step builds our model, tests it and computes the following:

1. Root mean square error (RMSE): The standard deviation of the difference between the real and predicted ratings.
2. Mean squared error (MSE): The mean of the squared difference between the real and predicted ratings.
3. Mean absolute error (MAE): This is the mean of the absolute difference between the real and predicted ratings.

The higher the error, the worse the model performs.

# name our models
model_to_evaluate <- "IBCF"
model_parameters <- NULL

eval_recommender <-Recommender(data = getData(eval_sets, "train"), method = model_to_evaluate, parameter = model_parameters)

# As before, we need to specify how many items we want to recommend: 5.
items_to_recommend <- 5

# We can build the matrix with the predicted ratings using the predict function:
eval_prediction <- predict(object = eval_recommender, newdata = getData(eval_sets, "known"), n = items_to_recommend, type = "ratings")

# calcPredictionAccuracy, we can computes the Root mean square error (RMSE), Mean squared error (MSE), and the Mean absolute error (MAE).
eval_accuracy <- calcPredictionAccuracy(
  x = eval_prediction, data = getData(eval_sets, "unknown"), byUser = TRUE
)

# This is a small sample of the results for the Prediction and Accuracy
kable(head(eval_accuracy), caption="Sample User Prediction Accuracy, IBCF")

# Now, let's take a look at the RMSE by each user
# qplot(eval_accuracy[,"RMSE"]) + geom_histogram(binwidth = 0.1) +
  # ggtitle("Distribution of the RMSE by user")

# We need to evaluate the model as a whole, so we will set the byUser to False
eval_accuracy <- calcPredictionAccuracy(
  x = eval_prediction, data = getData(eval_sets, "unknown"), byUser = FALSE
)

# for IBCF
kable(eval_accuracy, caption="Overall Error, IBCF")

8.2 Confusion Matrix for IBCF Evalulation

A confusion matrix allows us to examine accuracy by computing and comparing true positive, false positive, true negative and false negative rates. The definitions are:

• True Positive: Recommended items that were rated 4/5 (our threshold).
• False Postive: Recommended items that didn’t have a 4/5.
• True Negative: Not recommended but were highly rated.
• False Negative: Not recommended and had a low rating.

Recall (also called sensitivity) is the probability of getting a positive recommendation when the item has a positive rating. It is the ratio of the number of relevant items recommended to the total number of relevant items.

Specificity is the probability of getting a negative recommendation when the true rating is negative.

Precision is the ratio of correctly recommended items identified to all items, whether useful or not.

An ROC curve (for receiver operating curve, an archaic usage), charts Recall against Specificity. Models that have the largest area under the ROC curve have better performance – the highest probability of a correct (useful or relevant) recommendation. AUC is the fundamental statistic for comparison. We test the model using k= 10, 20, etc. in multiples of 10 items used to compute similarity.

# Confusion matrix construction
results <- evaluate(x = eval_sets, method = model_to_evaluate, n = seq(10, 100, 10))

## IBCF run fold/sample [model time/prediction time]
##   1  [3.153sec/0.015sec] 
##   2  [3.471sec/0.016sec] 
##   3  [3.271sec/0.013sec] 
##   4  [3.322sec/0.015sec]

# results is an evaluationResults object containing the results of the evaluation.
# Each element of the list corresponds to a different split of the k-fold.
# Let's look at the first element

kable(head(getConfusionMatrix(results)[[1]]))

# If we want to take account of all the splits at the same time, we can just sum up the indices:

columns_to_sum <- c("TP", "FP", "FN", "TN")
indices_summed <- Reduce("+", getConfusionMatrix(results))[, columns_to_sum]

kable(head(indices_summed))

# Building an ROC curve. Will need these factors
# 1. True Positive Rate (TPR): Percentage of purchased items that have been recommended. TP/(TP + FN)
# 2. False Positive Rate (FPR): Percentage of not purchased items that have been recommended. FP/(FP + TN)
plot(results, annotate = TRUE, main = "ROC curve")

# We can also look at the accuracy metrics as well
# Precision: Percentage of recommended items that have been purchased. FP/(TP + FP)
# Recall: Percentage of purchased items that have been recommended. TP/(TP + FN) = True Positive Rate

plot(results, "prec/rec", annotate = TRUE, main = "Precision-Recall")

8.3 Comparing multiple models

We have shown how to evaluate one model, but multiple models can be evaluated and their performance compared. AUC is our benchmark statistic.

Using k-fold sampling, we will build 5 models and store the results as eval_sets. The models are:

• Item-based collaborative filtering, using the cosine similarity.
• Item-based collaborative filtering, using the Pearson correlation.
• User-based collaborative filtering, using the cosine similarity.
• User-based collaborative filtering, using the Pearson correlation.
• Random recommendations for a baseline.

# a list of models and parameters
models_to_evaluate <- list(
  IBCF_cos = list(name = "IBCF", param = list(method = "cosine")),
  IBCF_cor = list(name = "IBCF", param = list(method = "pearson")),
  UBCF_cos = list(name = "UBCF", param = list(method = "cosine")),
  UBCF_cor = list(name = "UBCF", param = list(method = "pearson")),
  Random = list(name = "RANDOM", param = NULL))

# We will test with varying numbers of items.
n_recommendations <- c(1,5,seq(10,100,10))

# Now let's run using recommenderlab's evaluate function
list_results <- evaluate(x = eval_sets, method = models_to_evaluate, n = n_recommendations)

## IBCF run fold/sample [model time/prediction time]
##   1  [3.293sec/0.013sec] 
##   2  [3.15sec/0.013sec] 
##   3  [3.42sec/0.049sec] 
##   4  [3.374sec/0.015sec] 
## IBCF run fold/sample [model time/prediction time]
##   1  [3.595sec/0.015sec] 
##   2  [3.64sec/0.015sec] 
##   3  [3.313sec/0.016sec] 
##   4  [3.52sec/0.017sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0.029sec/0.112sec] 
##   2  [0.001sec/0.055sec] 
##   3  [0.002sec/0.048sec] 
##   4  [0.002sec/0.052sec] 
## UBCF run fold/sample [model time/prediction time]
##   1  [0.002sec/0.055sec] 
##   2  [0.002sec/0.046sec] 
##   3  [0.002sec/0.041sec] 
##   4  [0.002sec/0.045sec] 
## RANDOM run fold/sample [model time/prediction time]
##   1  [0.001sec/0.028sec] 
##   2  [0.023sec/0.026sec] 
##   3  [0.001sec/0.029sec] 
##   4  [0.001sec/0.026sec]

# We can extract the related average confusion matrices
avg_matrices <- lapply(list_results, avg)

kable(head(avg_matrices$IBCF_cos[, 5:8]))

plot(list_results, annotate = 1, legend = "topleft")
title("ROC curve, Five Models")

plot(list_results, "prec/rec", annotate = 1, legend = "topright", ylim = c(0,0.4))
title("Precision-recall")

8.4 Best model

Our plots show that User-based collaborative filtering using Pearson correlation as the similarity measure is the most robust model when only a small number of recommendations are required. By comparision, the IBCF models perform better when k > ~35. For reasons of computing efficiency, we select UBCF-Pearson as our preferred model.

kable(head(avg_matrices$UBCF_cor[, 5:8]))

1. Clean up, tokenize ‘summary’ variable

load("data4.rda")

# clean up data using bespoke function
# changes to lower case, eliminates punctionation, tokenizes

# regex to remove punctuation; note perl switch
cleanup_exp <- '[^a-z ]+'

cleanup <- function(sentence) {
  sentence <- tolower(sentence)
  sentence <- gsub(cleanup_exp, "", sentence, perl=T)
  sentence <- removeWords(sentence, stopwords('en'))
  sentence <- unlist(tokenize_sentences(sentence))
}

# create clean summaries in separate df
summaries <- data.frame(data4$Sentiment, data4$combine_summary)

# run cleanup function
summaries$clean_summary <- lapply(summaries[,2], cleanup)
summaries$clean_summary <- unlist(summaries$clean_summary)
colnames(summaries) <- c("Sentiment", "Summary", "Clean_summary")

# summaries$Clean_summary <- removeWords(summaries$Clean_summary, stopwords('en'))

# save(summaries, file="summaries.rda")


# summaries becomes original data table for sentiment analysis
# can get rid of the original text column
# summaries <- summaries[, -2]

2. Make a document-term matrix

# make train, test sets
## 75% of the sample size
smp_size <- floor(0.75 * nrow(summaries))

## set the seed to reproduce
set.seed(123)
train_index <- sample(seq_len(nrow(summaries)), size = smp_size)

train <- summaries[train_index, ]
test <- summaries[-train_index, ]

corpus <- Corpus(VectorSource(c(train$Clean_summary, test$Clean_summary)))

#create the ungodly huge dtm; this takes forever in R but is lightning fast in Python with sckikit
dtm <- DocumentTermMatrix(corpus)

# nbow shrink it; good at 96 terms
sparse <- removeSparseTerms(dtm, 0.65)
save(sparse, file="sparse.rda")

3. We have a sparse matrix that can now be fed to a classifier.

load("summaries.rda")
load("sparse.rda")

# Now we want to convert this matrix into a data frame that we can use to train a classifier in the next section.
important_words_df <- as.data.frame(as.matrix(sparse))
colnames(important_words_df) <- make.names(colnames(important_words_df))

# split into train and test
important_words_train_df <- head(important_words_df, nrow(train))
important_words_test_df <- tail(important_words_df, nrow(test))

# continue to model building
# table(summaries$Sentiment)

# Add to original dataframes
train_data_words_df <- cbind(train, important_words_train_df)
test_data_words_df <- cbind(test, important_words_test_df)

# Get rid of the original Text fields
train_data_words_df$Clean_summary <- NULL
test_data_words_df$Clean_summary <- NULL
train_data_words_df$Summary <- NULL
test_data_words_df$Summary <- NULL

set.seed(1234)
# first we create an index with 80% True values based on Sentiment
spl <- sample.split(train_data_words_df$Sentiment, 0.80)

# now we use it to split our data into train and test
eval_train_data_df <- train_data_words_df[spl==T,]
eval_test_data_df <- train_data_words_df[spl==F,]


# try caret and knn; no good also bombs
# trctrl <- trainControl(method = "cv", number = 4)

# knn_fit <- train(Sentiment ~., data = eval_train_data_df,
#                 method = "knn",
#                 trControl=trctrl,
#                 preProcess = c("center", "scale"),
#                 tuneLength = 10)

# try support vector machine
set.seed(1234)

fit.svm <- svm(Sentiment~., data=eval_train_data_df[c(1:10000),])

svm.pred <- predict(fit.svm, na.omit(eval_test_data_df[c(1:10000),]))
svm.perf <- table(eval_test_data_df$Sentiment[1:10000], svm.pred,
                  dnn=c('Actual', 'Predicted'))

svm.perf

performance <- function(table, n=2){
  if(!all(dim(table) == c(2,2)))
  stop("Must be a 2 x 2 table")
  tn = table[1,1]
  fp = table[1,2]
  fn = table[2,1]
  tp = table[2,2]
  sensitivity = tp/(tp+fn)
  specificity = tn/(tn+fp)
  ppp = tp/(tp+fp)
  npp = tn/(tn+fn)
  hitrate = (tp+tn)/(tp+tn+fp+fn)
  result <- paste("Sensitivity = ", round(sensitivity, n) ,
             "\nSpecificity = ", round(specificity, n),
             "\nPositive Predictive Value = ", round(ppp, n),
             "\nNegative Predictive Value = ", round(npp, n),
             "\nAccuracy = ", round(hitrate, n), "\n", sep="")
  cat(result)
}

performance(svm.perf)

#> performance(svm.perf)

# Sensitivity = 0.99
# Specificity = 0.04
# Positive Predictive Value = 0.78
# Negative Predictive Value = 0.48
# Accuracy = 0.78


# logistic model
# log_model <- glm(Sentiment~., data=eval_train_data_df, family=binomial)

# log.probs <- predict(log_model, eval_test_data_df, type="response")

# log.probs[1:5]

# log.pred <- rep(0, length(log.probs))
# log.pred[log.probs > 0.5] <- 1

# log.pred[1:5]

# log.perf <- table(eval_test_data_df$Sentiment,
                  # log.pred,
                  # dnn=c('Actual', 'Predicted'))
# log.perf

# performance(log.perf)