setwd("C:/Users/Makka/Desktop/term 5/dam")
pricePromo = read.csv("PricePromoData.csv",sep = ",")
attach(pricePromo)
library(psych)
View(pricePromo)
describe(pricePromo)
## 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
Own Elasticity
Measure the own price elasticity of X
model1<- log(oz_X) ~ log(pX)
fit1 <- lm(model1,data = pricePromo)
summary(fit1)
##
## Call:
## lm(formula = model1, data = pricePromo)
##
## 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(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
The elasticity is -6.95, so a 1 percent increase in the price of product Y is associated with a 6.95 percent decrease in its quantity demanded (sales), on average.
Measure the own price elasticity of Y
model2<- log(oz_Y) ~ log(pY)
fit2 <- lm(model2,data = pricePromo)
summary(fit2)
##
## Call:
## lm(formula = model2, data = pricePromo)
##
## 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(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
The elasticity is -6.69, so a 1 percent increase in the price of product Y is associated with a 6.69 percent decrease in its quantity demanded (sales), on average.
Qualitatively compare the elasticities. What do you infer?
The own price elasticity of product X is greater than product Y. This means that product Y is less sensitive to price change than product X.
CROSS PRICE ELASTICITY
Measure the cross-price elasticity of X w.r.t Y
model3<- log(oz_X) ~ log(pY)
fit3 <- lm(model3,data = pricePromo)
summary(fit3)
##
## Call:
## lm(formula = model3, data = pricePromo)
##
## 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(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.1883
The cross price elasticity of .33 shows that for every 1% increase in the price of Y, the sales of X will increase by 0.33 percent.
Measure the cross-price elasticity of Y w.r.t X
model4<- log(oz_Y) ~ log(pX)
fit4 <- lm(model4,data = pricePromo)
summary(fit4)
##
## Call:
## lm(formula = model4, data = pricePromo)
##
## 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(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.0409
The cross price elasticity of .81 shows that for every 1% increase in the price of X, the sales of Y will increase by 0.81 percent.
Are they the same? Or different? What do you infer?
The cross price elasticities of both products are different. This shows that, buyers are product X less brand loyal than product Y as a result, when price of product Y changes, less users shift to product X than when the reverse scenario occurs.
COMPARE OWN PRICE ELASTICITY WHEN A DEAL IS OFFERED
Measure the price elasticity of X when a deal is (not) offered?
model5<- log(oz_X) ~ deal_X + log(pX) + deal_X*log(pX)
fit5 <- lm(model5,data = pricePromo)
summary(fit5)
##
## Call:
## lm(formula = model5, data = pricePromo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.47804 -0.11484 -0.01953 0.06748 1.28798
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.4229 0.5048 -4.800 1.93e-06 ***
## deal_XYes -3.9397 1.3448 -2.930 0.0035 **
## log(pX) -2.9133 0.1435 -20.302 < 2e-16 ***
## deal_XYes:log(pX) -1.4255 0.3588 -3.973 7.80e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.2288 on 724 degrees of freedom
## Multiple R-squared: 0.9426, Adjusted R-squared: 0.9424
## F-statistic: 3966 on 3 and 724 DF, p-value: < 2.2e-16
The new elasticity is -2.91.
Is the price elasticity of X when a deal is offered different than the price elasticity when a deal is not offered?
As Beta3 is not zero and p-value is good, the null hypothesis that self price elasticity is the same can be rejected and there is statistical difference between the demand during promotions were offered and when they weren’t. The new elasticity is -2.91. This means that when promotions were offered and price of product X was increased by 1%, quantity demanded dropped just by 2.91.
Measure the price elasticity of Y when a deal is (not) offered?
model6<- log(oz_Y) ~ deal_Y + log(pY) + deal_Y*log(pY)
fit6 <- lm(model6,data = pricePromo)
summary(fit6)
##
## Call:
## lm(formula = model6, data = pricePromo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.83238 -0.61046 0.02982 0.60163 3.06752
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.5422 1.7345 -2.042 0.0415 *
## deal_YYes -7.0003 6.7669 -1.034 0.3013
## log(pY) -3.2352 0.4947 -6.539 1.17e-10 ***
## deal_YYes:log(pY) -2.2084 1.7845 -1.238 0.2163
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.927 on 724 degrees of freedom
## Multiple R-squared: 0.5355, Adjusted R-squared: 0.5335
## F-statistic: 278.2 on 3 and 724 DF, p-value: < 2.2e-16
The new elasticity is -3.24.
As p-value of beta3 is greater than 0.05, the null hypothesis that self price elasticity is the same cannot be rejected and we cannot say with enough confidence if the promotions on product Y actually affect its quantity demanded.
The new elasticity is -3.24. This means that when promotions were offered and price of product Y was increased by 1%, quantity demanded dropped just by 3.24 percent.
This means that offering deals on product X is better than offering deals on product Y.
********************************************************************************