Introduction - Instacart Background¶
Instacart is a grocery ordering and delivery service app, which aims to make the process of ordering groceries more convenient for stores and shoppers
Shoppers place orders to partnering stores (ie Whole Foods, Trader Joe’s, etc.) and are connected to in-person shoppers who drive to the store location and purchase and deliver the goods
Instacart shoppers are able to use the grocery delivery service for a one-time fee of \$3.99, or for free if they have a membership (\$99/year) and orders are above \$35
About the Data¶
The data set was released by Instacart as a machine learning competition via Kaggle
The data sets consisted of over 3 million grocery orders of anonymized information based on the products that belong to each order, and the orders that belong to each user
Additionally there was also information the times and days the orders were placed, the relative amount of time between orders per user, grocery department and aisle information, and the sequence of the products being placed in the basket
The goal of the kaggle competition was to predict which items were likely to be reordered again by the same customers
Exploratory Data Analysis¶
The files provide a combination of categorical data, both ordinal and nominal pertaining to the features of the actual goods being ordered such as “dairy,” “produce,” “organic,” etc.
head(products, n=10)
length(unique(products$product_id)) # 49688 total products
head(order_products_train, n=15)
head(orders, n=5)
Days of the week when people order¶
orders %>%
ggplot(aes(x=order_dow, height=.2)) +
geom_histogram(stat="count",fill="slateblue", position=position_dodge(width=1))
Relative Time Between Orders¶
orders %>%
ggplot(aes(x=days_since_prior_order)) +
geom_histogram(stat="count",fill="slateblue")
What are the most popular items ordered on Instacart?¶
mostcommon <- order_products_train %>%
group_by(product_id) %>%
summarize(count = n()) %>%
top_n(10, wt = count) %>%
left_join(select(products,product_id,product_name),by="product_id") %>%
arrange(desc(count))
head(mostcommon, n=10)
mostcommon %>%
ggplot(aes(x=reorder(product_name,-count), y=count))+
geom_bar(stat="identity",fill="slateblue")+
theme(axis.text.x=element_text(angle=90, hjust=1),axis.title.x = element_blank())
What items are most often reordered?¶
item_reorders <- order_products_train %>%
group_by(product_id) %>%
summarize(proportion_reordered = mean(reordered), n=n()) %>%
filter(n>40) %>%
top_n(10,wt=proportion_reordered) %>%
arrange(desc(proportion_reordered)) %>%
left_join(products,by="product_id")
head(data.frame(item_reorders), n=15)
item_reorders %>%
ggplot(aes(x=reorder(product_name,-proportion_reordered), y=proportion_reordered))+
geom_bar(stat="identity",fill="slateblue")+
theme(axis.text.x=element_text(angle=90, hjust=1),axis.title.x = element_blank())+coord_cartesian(ylim=c(0.85,0.95))
Proportion of Products Reordered¶
reorder %>%
ggplot(aes(x=reordered,y=count, fill=reordered))+
geom_bar(stat="identity")
reorder.table<- order_products_train %>%
count(reordered) %>%
mutate(prop = prop.table(n))
as.data.frame(reorder.table)
reorder <- order_products_train %>%
group_by(reordered) %>%
summarize(count = n()) %>%
mutate(proportion = count/sum(count))
Limitations:¶
- When working with such a large data set, iterative techniques such as cross-validation become a very challenging task. These methods are computationally expensive and many of these techniques are beyond our resources if we want to use the original data set we were given
- For example: Cross-Validation, Stepwise Regression, ROC graph/threshold determination, diagnostic plotting
Codes Examples that didn't complete:¶
ROC¶
install.packages("pROC") library(pROC) plot(roc(Test.Orders$reordered, PredM1 , direction=">"), #col="yellow", lwd=3, main="Reordering ROC")
Preprocessing¶
Main Approach to Organizing the Variables¶
1. Feature Engineering¶
We had to think about what variables could be created to help us solve our problem - (which is to predict the probability of a user reordering a specific product/of a product being reordered).
A few new columns we created:
- user_prop_reordered: proportion of products reordered for each user for all products
- total_orders: total number of orders for each user
- reordered.Num: total number of reorders per product
- proportion_reordered: proportion of reorders per product and per user
2. Selection of Variables¶
- Some of the variables we were able to automatically take out, since they were either originally created for referential purposes only (ie eval_set, user_id, order_id, order_number, product_name)
- Others we took out since we had already created information about the users and proportion of reordered items across for each product
- Out of aisle, product, and departmental categories for the products, we decided to keep only one of these variables, since they are all correlated and related to one another
3. Null Values: Non-random Missing Data¶
- The variable days_since_prior_order had a large number of null values. We had originally omitted them from the data set, but after further evaluation, we saw that these null values actually had a meaning.
- We realized that every null value in the days_since_prior_order corresponded to the first order made by each of the users. The reason this column gave null values is before it represents a relative amount of time and there was no "prior" order to measure this time unit.
- Since we were only looking to examine data that involved reordered products, we decided that eliminating all of the first orders from the data set would not pose a huge problem to our analysis
Original Data Sets¶
head(orders)
head(order_products_prior)
Updated Data Sets¶
head(Combined.Orders, n=10)
Splitting the Data¶
set.seed(1)
Train<- sample(1:nrow(Combined.Orders), nrow(Combined.Orders)*.8)
Training.Orders <- Combined.Orders[Train,]
Test.Orders <- Combined.Orders[-Train,]
nrow(Training.Orders)
nrow(Test.Orders)
Model 1: Logistic Regression¶
Logistic.TestModel2 <- glm(reordered ~ user_prop_reordered + proportion_reordered + product_orders + total_orders + add_to_cart_order + order_dow + days_since_prior_order + department_id, family = binomial, data = Training.Orders)
summary(Logistic.TestModel2)
departments
attach(Combined.Orders)
set.seed(1)
Accuracy <- function(table)
{
n11 <- table[1,1]
n22 <- table[2,2]
Total <- table[1,1]+table[2,2]+table[2,1]+table[1,2]
Total
return((n11+n22)/Total)
}
ProbM1 <- predict.glm(Logistic.TestModel1, newdata = Test.Orders, type = "response")
PredM1 <- ifelse(ProbM1 > .5, "1" , "0")
TableM1 <- table(PredM1, Test.Orders$reordered)
TableM1
Accuracy(TableM1)
Deviance Test Against the Null Model¶
Null.TestModel2 <- glm(reordered ~ 1, family = binomial, data = Training.Orders)
summary(Null.TestModel2)
anova(Null.TestModel2, Logistic.TestModel2, test='Chisq')
Model 2: Classification Tree¶
library(rpart)
Tree.TestModel <- rpart(reordered ~ user_prop_reordered + proportion_reordered + product_orders + total_orders + add_to_cart_order + order_dow + days_since_prior_order + department_id,method = "class", data = Training.Orders)
plot(Tree.TestModel)
text(Tree.TestModel)
Pred.Tree <- predict(Tree.TestModel, newdata = Test.Orders, type = "class")
Tree.Table <- table(Pred.Tree, Test.Orders$reordered)
Tree.Table
Accuracy(Tree.Table)
Model 3: Support Vector Machine Model¶
set.seed(1)
Trying <- sample(1:nrow(Combined.Orders), nrow(Combined.Orders)*.001)
DF <- Combined.Orders[Trying,]
Train.Trying <- sample(1:nrow(DF), nrow(DF)*.8)
Trying.DF.Train <- DF[Train.Trying, ]
Trying.DF.Test <- DF[-Train.Trying, ]
SVM.TestModel <- svm(reordered ~ user_prop_reordered + proportion_reordered + product_orders + total_orders + add_to_cart_order + order_dow + days_since_prior_order + department_id.x, data = Trying.DF.Train)
summary(SVM.TestModel)
SVM.Pred <- predict(SVM.TestModel, Trying.DF.Test)
SVM.Table <- table(SVM.Pred, Trying.DF.Test$reordered)
Accuracy(SVM.Table)
Conclusion¶
Model 1: Logistic Regression - 0.7298
Model 2: Classification Tree - 0.7066
Model 3: SVM - 0.7391 on .1% of the data