Reading the data
Pricedata = read.csv(paste("PricePromoData.csv", sep=""))
library(psych)
describe(Pricedata)## vars n mean sd median trimmed mad
## STORE 1 728 6.50000e+01 2.00 6.500e+01 6.50000e+01 2.97
## Hval_150 2 728 2.10000e-01 0.09 2.100e-01 2.10000e-01 0.12
## WEEK 3 728 1.26500e+02 15.02 1.265e+02 1.26500e+02 19.27
## OUNCES 4 728 7.20000e+01 0.00 7.200e+01 7.20000e+01 0.00
## UPC_X 5 728 4.90000e+09 289.70 4.900e+09 4.90000e+09 429.21
## deal_X* 6 728 1.20000e+00 0.40 1.000e+00 1.12000e+00 0.00
## feat_X* 7 728 1.29000e+00 0.46 1.000e+00 1.24000e+00 0.00
## oz_X 8 728 7.07895e+03 9496.81 2.664e+03 4.86986e+03 747.23
## pack_X 9 728 9.83200e+01 131.90 3.700e+01 6.76400e+01 10.38
## UPC_Y 10 728 1.20000e+09 118.58 1.200e+09 1.20000e+09 175.69
## deal_Y* 11 728 1.20000e+00 0.40 1.000e+00 1.12000e+00 0.00
## feat_Y* 12 728 1.26000e+00 0.44 1.000e+00 1.20000e+00 0.00
## oz_Y 13 728 9.50479e+03 14769.39 3.492e+03 6.14811e+03 3789.53
## pack_Y 14 728 1.32010e+02 205.13 4.850e+01 8.53900e+01 52.63
## pX 15 728 3.00000e-02 0.00 3.000e-02 3.00000e-02 0.00
## pY 16 728 3.00000e-02 0.00 3.000e-02 3.00000e-02 0.00
## cx 17 728 2.00000e-02 0.00 2.000e-02 2.00000e-02 0.00
## cY 18 728 2.00000e-02 0.00 2.000e-02 2.00000e-02 0.00
## class* 19 728 1.50000e+00 0.50 1.500e+00 1.50000e+00 0.74
## min max range skew kurtosis se
## STORE 6.20e+01 6.800000e+01 6.00 0.00 -1.25 0.07
## Hval_150 9.00e-02 3.500000e-01 0.26 0.18 -1.35 0.00
## WEEK 1.01e+02 1.520000e+02 51.00 0.00 -1.21 0.56
## OUNCES 7.20e+01 7.200000e+01 0.00 NaN NaN 0.00
## UPC_X 4.90e+09 4.900001e+09 579.00 0.00 -2.00 10.74
## deal_X* 1.00e+00 2.000000e+00 1.00 1.50 0.26 0.01
## feat_X* 1.00e+00 2.000000e+00 1.00 0.90 -1.19 0.02
## oz_X 9.36e+02 5.076000e+04 49824.00 1.88 2.27 351.98
## pack_X 1.30e+01 7.050000e+02 692.00 1.88 2.27 4.89
## UPC_Y 1.20e+09 1.200000e+09 237.00 0.00 -2.00 4.39
## deal_Y* 1.00e+00 2.000000e+00 1.00 1.54 0.36 0.01
## feat_Y* 1.00e+00 2.000000e+00 1.00 1.08 -0.84 0.02
## oz_Y 1.44e+02 1.609920e+05 160848.00 3.48 20.18 547.39
## pack_Y 2.00e+00 2.236000e+03 2234.00 3.48 20.18 7.60
## pX 2.00e-02 4.000000e-02 0.02 0.04 1.84 0.00
## pY 2.00e-02 4.000000e-02 0.02 0.14 1.29 0.00
## cx 2.00e-02 3.000000e-02 0.02 -0.15 1.37 0.00
## cY 2.00e-02 3.000000e-02 0.01 -0.08 0.43 0.00
## class* 1.00e+00 2.000000e+00 1.00 0.00 -2.00 0.02# Linear Regression model
SimOLSModel <- oz_X ~ pX
# fitting simple linear OLS Model
fitSimOLSModel <- lm(SimOLSModel, data = Pricedata)
summary(fitSimOLSModel)##
## Call:
## lm(formula = SimOLSModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5727.7 -4017.7 -1076.5 -356.5 27169.0
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 70917 1609 44.07 <2e-16 ***
## pX -2253616 56385 -39.97 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5312 on 726 degrees of freedom
## Multiple R-squared: 0.6875, Adjusted R-squared: 0.6871
## F-statistic: 1597 on 1 and 726 DF, p-value: < 2.2e-16#Own price elasticity of product X
loglogModel <- log(Pricedata$oz_X)~log(Pricedata$pX)
fitX <- lm(loglogModel,data=Pricedata)
summary(fitX)##
## Call:
## lm(formula = loglogModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.6564 -0.2395 -0.0788 0.1190 1.2732
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -16.5304 0.3840 -43.05 <2e-16 ***
## log(Pricedata$pX) -6.9446 0.1074 -64.63 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3671 on 726 degrees of freedom
## Multiple R-squared: 0.8519, Adjusted R-squared: 0.8517
## F-statistic: 4177 on 1 and 726 DF, p-value: < 2.2e-16-6.9446
#Own price elasticity of product Y
loglogModel <- log(Pricedata$oz_Y)~log(Pricedata$pY)
fitY <- lm(loglogModel,data=Pricedata)
summary(fitY)##
## Call:
## lm(formula = loglogModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.9059 -0.6063 0.0550 0.6057 3.4900
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -15.5981 0.8990 -17.35 <2e-16 ***
## log(Pricedata$pY) -6.6942 0.2519 -26.57 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9671 on 726 degrees of freedom
## Multiple R-squared: 0.4931, Adjusted R-squared: 0.4924
## F-statistic: 706.1 on 1 and 726 DF, p-value: < 2.2e-16-6.6942
3.Qualitatively compare the elasticities. What do you infer? We can see that product X is showing higher price elasticity than product Y which means that the same percentage change in price of the product will change the demand by a greater amount in case of X.
#Cross price elasticity of product X w.r.t. Y
crosslogModel <- log(Pricedata$oz_X)~log(Pricedata$pY)
fitX <- lm(crosslogModel,data=Pricedata)
summary(fitX)##
## Call:
## lm(formula = crosslogModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.3777 -0.5510 -0.4059 -0.1456 2.5414
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 9.4395 0.8857 10.658 <2e-16 ***
## log(Pricedata$pY) 0.3268 0.2482 1.317 0.188
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9528 on 726 degrees of freedom
## Multiple R-squared: 0.002383, Adjusted R-squared: 0.001008
## F-statistic: 1.734 on 1 and 726 DF, p-value: 0.18830.3268
5.Measure the cross-price elasticity of Y w.r.t. X
#Cross price elasticity of product Y w.r.t. X
crosslogModel <- log(Pricedata$oz_Y)~log(Pricedata$pX)
fitY <- lm(crosslogModel,data=Pricedata)
summary(fitY)##
## Call:
## lm(formula = crosslogModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3541 -0.9954 -0.0906 0.9914 3.6652
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 11.1712 1.4169 7.884 1.16e-14 ***
## log(Pricedata$pX) 0.8120 0.3965 2.048 0.0409 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.354 on 726 degrees of freedom
## Multiple R-squared: 0.005745, Adjusted R-squared: 0.004376
## F-statistic: 4.195 on 1 and 726 DF, p-value: 0.04090.8120
Are they the same? Or different? What do you infer? They are different and value of Cross price elasticity of product Y w.r.t. X is higher. It shows that with slight % increase in price of Y will Affect the demand for product X by a larger extent than the vice-versa.
Measure the price elasticity of X when a deal is (not) offered?
#Own price elasticity of product X under promotion
withPromoModel <- log(Pricedata$oz_X)~log(Pricedata$pX):Pricedata$deal_X
fitXpromo <-lm(withPromoModel,data=Pricedata)
summary(fitXpromo)##
## Call:
## lm(formula = withPromoModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.50837 -0.11509 -0.01762 0.06939 1.28990
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.9781 0.4703 -6.332 4.25e-10
## log(Pricedata$pX):Pricedata$deal_XNo -3.0711 0.1337 -22.970 < 2e-16
## log(Pricedata$pX):Pricedata$deal_XYes -3.4460 0.1242 -27.753 < 2e-16
##
## (Intercept) ***
## log(Pricedata$pX):Pricedata$deal_XNo ***
## log(Pricedata$pX):Pricedata$deal_XYes ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.23 on 725 degrees of freedom
## Multiple R-squared: 0.942, Adjusted R-squared: 0.9418
## F-statistic: 5883 on 2 and 725 DF, p-value: < 2.2e-16Is the price elasticity of X when a deal is offered different than the price elasticity when a deal is not offered? Yes they are different.
Measure the price elasticity of Y when a deal is (not) offered?
#Own price elasticity of product Y under promotion
withPromoModel <- log(Pricedata$oz_Y)~log(Pricedata$pY):Pricedata$deal_Y
fitYpromo <-lm(withPromoModel,data=Pricedata)
summary(fitYpromo)##
## Call:
## lm(formula = withPromoModel, data = Pricedata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.83232 -0.62545 0.02988 0.60166 3.06757
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.0021 1.6767 -2.387 0.0172
## log(Pricedata$pY):Pricedata$deal_YNo -3.3663 0.4782 -7.039 4.49e-12
## log(Pricedata$pY):Pricedata$deal_YYes -3.7292 0.4400 -8.476 < 2e-16
##
## (Intercept) *
## log(Pricedata$pY):Pricedata$deal_YNo ***
## log(Pricedata$pY):Pricedata$deal_YYes ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9271 on 725 degrees of freedom
## Multiple R-squared: 0.5348, Adjusted R-squared: 0.5335
## F-statistic: 416.7 on 2 and 725 DF, p-value: < 2.2e-16