Barber Shop Case Study - GLM

---

Predictive Model

Based on results of the survey – we used a GLM to see what factors determined a client’s price point. Our initial analysis suggests using 3 factors:

1. Importance of price
2. Importance of atmosphere
3. Method of finding your salon.

# read in the csv
data <- read.csv("Survey.csv")
data <- subset(data,gender == "Male")

#price.importance
data2 <- data
boxplot(most ~ price.importance, data=data)

#Make 3 groups:  1-3: "Low" ; 4: "Medium" ; 5: "High"
data2$price.importance2 <- ifelse(data2$price.importance < 4, "Low",
                                  ifelse(data2$price.importance==4,"Medium","High"))

boxplot(most ~ price.importance2, data=data2)

#Make 2 groups: 1-4: "Low" ; 5: "High"
data2$atmosphere.importance2 <- ifelse(data2$atmosphere.importance < 5, "Low",
                                       ifelse(data2$atmosphere.importance==5,"High","Error"))

data2$find3 <- ifelse(data2$find2 == "Google", "other",
                      ifelse(data2$find2 == "Referral", "other",
                             ifelse(data2$find2 == "other","other",
                                    ifelse(data2$find2 == "Walk in", "Walk in",
                                           ifelse(data2$find2 == "Yelp","Yelp","Fucked Up")))))

summary(model)

Call:
glm(formula = most ~ price.importance2 + atmosphere.importance2 + 
    find3, family = poisson(link = "log"), data = data2)

Deviance Residuals: 
   Min      1Q  Median      3Q     Max  
-6.091  -2.247  -0.041   1.824   8.374  

Coefficients:
                          Estimate Std. Error z value Pr(>|z|)    
(Intercept)                3.69787    0.06002  61.610  < 2e-16 ***
price.importance2Low       1.00662    0.05746  17.520  < 2e-16 ***
price.importance2Medium    0.51592    0.05746   8.979  < 2e-16 ***
atmosphere.importance2Low -0.77750    0.05447 -14.274  < 2e-16 ***
find3Walk in              -0.27006    0.04883  -5.530 3.20e-08 ***
find3Yelp                 -0.20597    0.04984  -4.132 3.59e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 1054.81  on 79  degrees of freedom
Residual deviance:  568.42  on 74  degrees of freedom
AIC: 989.37

Number of Fisher Scoring iterations: 5

# Summary shows everything is statistically significant (***)

library(ggplot2)
library(GGally)

data3 <- data2
data3$predicted <- predict(model, type = "response", scientific = FALSE)

# Lets do an xy scatterplot comparing actual and predicted.  A good model should show most of the points on the x=y (actual = predicted) line
g <- ggplot(data3, aes(x=most, y=predicted))

Predictive Model Goodness of Fit

• XY scatterplot: X = Actual; Y = Predicted
• A good model will show points on the x=y line
• Starting to see this shape – but not super tight
• Limitations of smaller dataset
• Importance of this model isn’t necessarily getting a perfect prediction – it is the insights from the factors (see below).

---