Predict 413 Final: Wine Sales Predictions

Introduction

The goal of this project is to predict the number of cases of wine sold based on chemical characteristics of close to 13,000 wines. This report will cover the following processes: * Cleaning, standardizing, and exploring the data * Development of each of the following models * Poisson Regression * Zero-Inflated Poisson Regression * Negative Binomial Regression * Zero-Inflated Negative Binomial Regression * Multiple Linear Regression * Comparison of each model * Code to deploy the model on the test data set All code and data for this paper can be found here. # Cleaning and Exploring the Data The exploration and cleaning step involves creating flag variables for missing values and outliers, deleting the outliers, and use regression trees to impute the remaining values.

The STARS field has the most missing data while several chemical measurements are missing 5-10% of values. In case the absence of data is an important factor in sales, a binary flag variable is produced to identify places where data was initially missing from each variable.

package <U+393C><U+3E31>ggplot2<U+393C><U+3E32> was built under R version 3.4.2

Outliers, defined as \(Q1 - (1.5*IQR)\) and \(Q3 + (1.5*IQR)\) are removed from the data set and flag variables are appended in a similar fashion to the missing data flags. Finally, all missing and deleted variables are reimputed using regression trees.

Finally, we can examine the distributions of our variables. Flags with homogenous values are removed from the training set to get a jump start on stepwise dimension reduction used in the model development stage.

  fixedacidity       volatileacidity      citricacid        residualsugar         chlorides          freesulfurdioxide   totalsulfurdioxide 
 Min.   :-2.405343   Min.   :-2.36238   Min.   :-2.406982   Min.   :-2.432242   Min.   :-2.3748801   Min.   :-2.518626   Min.   :-2.744691  
 1st Qu.:-0.325198   1st Qu.:-0.29839   1st Qu.:-0.361933   1st Qu.:-0.241350   1st Qu.:-0.1642604   1st Qu.:-0.283968   1st Qu.:-0.455171  
 Median :-0.038940   Median :-0.09039   Median : 0.003254   Median :-0.104133   Median :-0.0517827   Median :-0.030304   Median : 0.017829  
 Mean   : 0.001865   Mean   :-0.00449   Mean   : 0.001676   Mean   :-0.001509   Mean   : 0.0002116   Mean   : 0.003729   Mean   : 0.003165  
 3rd Qu.: 0.399990   3rd Qu.: 0.43761   3rd Qu.: 0.353834   3rd Qu.: 0.357829   3rd Qu.: 0.2640202   3rd Qu.: 0.295835   3rd Qu.: 0.415349  
 Max.   : 2.499219   Max.   : 2.51761   Max.   : 2.398883   Max.   : 2.475539   Max.   : 2.4010968   Max.   : 2.554652   Max.   : 2.704869  
    density                ph              sulphates            alcohol           labelappeal         acidindex            stars         
 Min.   :-2.510270   Min.   :-2.620407   Min.   :-2.338310   Min.   :-2.993770   Min.   :-2.23427   Min.   :-2.62836   Min.   :-1.15425  
 1st Qu.:-0.260398   1st Qu.:-0.407492   1st Qu.:-0.289601   1st Qu.:-0.455298   1st Qu.:-1.11205   1st Qu.:-0.60274   1st Qu.:-1.15425  
 Median : 0.020346   Median :-0.009859   Median :-0.057414   Median :-0.037196   Median : 0.01017   Median : 0.41008   Median :-0.04626  
 Mean   : 0.002849   Mean   :-0.001639   Mean   : 0.003905   Mean   : 0.002461   Mean   : 0.00000   Mean   : 0.01698   Mean   :-0.02669  
 3rd Qu.: 0.288033   3rd Qu.: 0.422351   3rd Qu.: 0.379644   3rd Qu.: 0.530227   3rd Qu.: 1.13240   3rd Qu.: 0.41008   3rd Qu.: 1.06172  
 Max.   : 2.500037   Max.   : 2.635267   Max.   : 2.401037   Max.   : 3.098564   Max.   : 2.25462   Max.   : 2.43571   Max.   : 2.16970  
 residualsugar_na.flag chlorides_na.flag freesulfurdioxide_na.flag totalsulfurdioxide_na.flag   ph_na.flag      sulphates_na.flag
 Min.   :0.00000       Min.   :0.00000   Min.   :0.00000           Min.   :0.0000             Min.   :0.00000   Min.   :0.00000  
 1st Qu.:0.00000       1st Qu.:0.00000   1st Qu.:0.00000           1st Qu.:0.0000             1st Qu.:0.00000   1st Qu.:0.00000  
 Median :0.00000       Median :0.00000   Median :0.00000           Median :0.0000             Median :0.00000   Median :0.00000  
 Mean   :0.04814       Mean   :0.04986   Mean   :0.05057           Mean   :0.0533             Mean   :0.03087   Mean   :0.09457  
 3rd Qu.:0.00000       3rd Qu.:0.00000   3rd Qu.:0.00000           3rd Qu.:0.0000             3rd Qu.:0.00000   3rd Qu.:0.00000  
 Max.   :1.00000       Max.   :1.00000   Max.   :1.00000           Max.   :1.0000             Max.   :1.00000   Max.   :1.00000  
 alcohol_na.flag   stars_na.flag    fixedacidity_out.flag volatileacidity_out.flag citricacid_out.flag residualsugar_out.flag
 Min.   :0.00000   Min.   :0.0000   Min.   :0.00000       Min.   :0.00000          Min.   :0.00000     Min.   :0.0000        
 1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.:0.00000       1st Qu.:0.00000          1st Qu.:0.00000     1st Qu.:0.0000        
 Median :0.00000   Median :0.0000   Median :0.00000       Median :0.00000          Median :0.00000     Median :0.0000        
 Mean   :0.05104   Mean   :0.2625   Mean   :0.04158       Mean   :0.05487          Mean   :0.05557     Mean   :0.1254        
 3rd Qu.:0.00000   3rd Qu.:1.0000   3rd Qu.:0.00000       3rd Qu.:0.00000          3rd Qu.:0.00000     3rd Qu.:0.0000        
 Max.   :1.00000   Max.   :1.0000   Max.   :1.00000       Max.   :1.00000          Max.   :1.00000     Max.   :1.0000        
 chlorides_out.flag freesulfurdioxide_out.flag totalsulfurdioxide_out.flag density_out.flag  ph_out.flag      sulphates_out.flag
 Min.   :0.00000    Min.   :0.0000             Min.   :0.00000             Min.   :0.0000   Min.   :0.00000   Min.   :0.00000   
 1st Qu.:0.00000    1st Qu.:0.0000             1st Qu.:0.00000             1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:0.00000   
 Median :0.00000    Median :0.0000             Median :0.00000             Median :0.0000   Median :0.00000   Median :0.00000   
 Mean   :0.08761    Mean   :0.1733             Mean   :0.02876             Mean   :0.1699   Mean   :0.03181   Mean   :0.05619   
 3rd Qu.:0.00000    3rd Qu.:0.0000             3rd Qu.:0.00000             3rd Qu.:0.0000   3rd Qu.:0.00000   3rd Qu.:0.00000   
 Max.   :1.00000    Max.   :1.0000             Max.   :1.00000             Max.   :1.0000   Max.   :1.00000   Max.   :1.00000   
 alcohol_out.flag  acidindex_out.flag     index           target     
 Min.   :0.00000   Min.   :0.00000    Min.   :    1   Min.   :0.000  
 1st Qu.:0.00000   1st Qu.:0.00000    1st Qu.: 4038   1st Qu.:2.000  
 Median :0.00000   Median :0.00000    Median : 8110   Median :3.000  
 Mean   :0.01844   Mean   :0.04103    Mean   : 8070   Mean   :3.029  
 3rd Qu.:0.00000   3rd Qu.:0.00000    3rd Qu.:12106   3rd Qu.:4.000  
 Max.   :1.00000   Max.   :1.00000    Max.   :16129   Max.   :8.000  

Model Development

Five models are developed for this paper. First is a Poisson regression model followed by a negative binomial regression model. Then zero-inflated versions of each model are developed as well as a multivariate linear regression model. Root mean squared error (RMSE), and mean absolute error (MAE) are calculated for each model for purposes of out of sample model evaluation.

Poisson and Negative Binomial Regression

Poisson regression models use the log link function to approximate regression processes for a count variable distributed such that the variance is equal to the mean ¹. The backward stepwise feature selection algoritm returned a poisson model with twelve predictors². Noteably, missing values for stars and outlier acidindex values significantly harm sales while labelappeal and present higher values for stars led to higher sales. Negative binomial models use a different probability density function than Poisson regression to account for over-dispersion of the target variable (as we have in this case)³. The coefficients for this model are identical to that of a Poisson model.

Zero-Inflated Regression

Poisson and negative binomial models can be skewed by an overabundance of zero values. Zero-inflated models assumethe distribution has two types of values - rightful zero measurements and a separate set of values that follows a more typical distribution. These models first sort values into their proper category, then predict their outcomes using separate sets of coefficients for each⁴. In this case, over 2,500 wines sold zero cases so zero-inflated models may improve predictive power. The same variables are used in the zero inflated models as the initial models⁵. In this case, some of the coefficients are flipped. Missing ratings and outlier acidity values are strong positive influences on sales. Label appeal is similarly positive as in previous models, but actual star ratings are negative. Again, the coefficients for poisson and negative binomial models are identical.

Multiple Regression

The final model attempted is multiple linear regression. A new stepwise selection algorithm is used to select model variables. The same variables with relatively large coefficients in the poisson and negative binomial models stand out in the linear regression model, although additional variables with smaller coefficients are included as well.

Model Evaluation

To assess the accuracy of the various models, each model is repeatedly trained on random samples of the data and tested out of sample. Iterative resampling is used to measure the error rates of each model and attempt to account for uncertainty in error measurements by producing distributions of possible error measures rather than single point estimates. The distributions of MAE and RMSE for each model are presented below. Similar to the above coefficients, the error rates for the poisson and negative binomial models are identical with the two zero-inflated models strongly outperforming the non-adjusted models. Multiple regression also made a strong showing, but did not improve predictive accuracy compared to the two zero-inflated models. Of the two winning models, zero-inflated negative binomial is preferred due to the slight overdispersion of the target variable.

Implementation

The following function applies the zero-inflated negative binomial regression model to out of sample data and generates a CSV file in the proper submission format.

apply_model <- function(csv){
  train.raw <- read_csv(csv)
  colnames(train_raw) <- tolower(colnames(train_raw))
  
  train.flagged <- train_raw%>%
    mutate_all(funs(na.flag = ifelse(is.na(.),1,0)))
  int_df <- train.flagged%>%
    dplyr::select(-index, -target, -index_na.flag, -target_na.flag)%>%
    dplyr::select_if(is.numeric)
  
  cleaned_cols <- list()
  for(c in colnames(train_raw%>%
                    dplyr::select(-index, -target)%>%
                    dplyr::select_if(is.numeric))){
    column <- train.flagged%>%select_(col = c)
    iqr <- quantile(column$col, na.rm = T)[4] - quantile(column$col, na.rm = T)[2]
    low <- quantile(column$col, na.rm = T)[2] - iqr
    high <- quantile(column$col, na.rm = T)[4] + iqr
    
    vals <- c()
    for(i in seq(1:nrow(int_df))){
      ifelse(between(column$col[i], low - (1.5*iqr), high + (1.5*iqr)),
             vals[i] <- column$col[i], 
             ifelse(is.na(column$col[i]), vals[i] <- NA, vals[i] <- NA))
    }
    
    ifelse(length(vals) == nrow(int_df),
           cleaned_cols[[c]] <- vals, 
           cleaned_cols[[c]] <- c(vals,NA))
  }
  
  df2 <- bind_cols(
    bind_cols(cleaned_cols)%>%
      scale(center = TRUE)%>%
      data.frame(),
    train.flagged%>%
      dplyr::select(ends_with('na.flag'))%>%
      dplyr::select(-index_na.flag, -target_na.flag)
  )
  
  df3 <- df2%>%
    mutate(
      fixedacidity_out.flag = ifelse(is.na(fixedacidity) & fixedacidity_na.flag ==0,1,0),
      volatileacidity_out.flag = ifelse(is.na(volatileacidity) & volatileacidity_na.flag ==0,1,0),
      citricacid_out.flag = ifelse(is.na(citricacid) & citricacid_na.flag ==0,1,0),
      residualsugar_out.flag = ifelse(is.na(residualsugar) & residualsugar_na.flag ==0,1,0),
      chlorides_out.flag = ifelse(is.na(chlorides) & chlorides_na.flag ==0,1,0),
      freesulfurdioxide_out.flag = ifelse(is.na(freesulfurdioxide) & freesulfurdioxide_na.flag ==0,1,0),
      totalsulfurdioxide_out.flag = ifelse(is.na(totalsulfurdioxide) & totalsulfurdioxide_na.flag ==0,1,0),
      density_out.flag = ifelse(is.na(density) & density_na.flag ==0,1,0),
      ph_out.flag = ifelse(is.na(ph) & ph_na.flag ==0,1,0),
      sulphates_out.flag = ifelse(is.na(sulphates) & sulphates_na.flag ==0,1,0),
      alcohol_out.flag = ifelse(is.na(alcohol) & alcohol_na.flag ==0,1,0),
      labelappeal_out.flag = ifelse(is.na(labelappeal) & labelappeal_na.flag ==0,1,0),
      acidindex_out.flag = ifelse(is.na(acidindex) & acidindex_na.flag ==0,1,0),
      stars_out.flag = ifelse(is.na(stars) & stars_na.flag ==0,1,0)
  )
  
  library(mice)
  temp_df <- mice(df3, method = 'cart', maxit = 1)
  train <- complete(temp_df)%>%
    bind_cols(train_raw%>%dplyr::select(index))%>%
    dplyr::select(-stars_out.flag, -labelappeal_out.flag, -density_na.flag,
                  -labelappeal_na.flag, -acidindex_na.flag, -fixedacidity_na.flag,
                  -volatileacidity_na.flag, -citricacid_na.flag)
  return(data.frame(
    index = train$index,
    target_p = predict(zinng.mod, newdata = train)
    )
  )
}

test <- apply_model('Wine_Random_Test.csv')
write.csv(test, 'yazman.csv', row.names = FALSE)

Citations

---

1. Hoffmann, John P. Generalized Linear Models: an Applied Approach. Pearson/Allyn & Bacon, 2004.↩

2. https://stats.idre.ucla.edu/r/dae/poisson-regression/↩

3. https://stats.idre.ucla.edu/r/dae/negative-binomial-regression/↩

4. https://statisticalhorizons.com/zero-inflated-models↩

5. https://stats.idre.ucla.edu/r/dae/zip/↩