Update: Definin Markets- Determine Distance Limit and No. of the nearestest neighbors sdfsss
Jung Hwan Koh
9/21/2019
Load data
Use hou14 for the following analysis
load(file="df_hou4.Rdata")
hou14 <- df_hou4
save(hou14, file="hou14.Rdata")
load(file="hou14.Rdata")sdfdsd
Create data frame for low and high quality hotels
hou14$s_rating <- hou14$s_rating/10
# sort data by market id variables (qtr)
hou14 <- hou14[order(hou14$qtr),]
# If s_rating >= 3.5, hotels are considered as high quality
# If s_rating < 3.5, hotels are considered as low quality
hou14.h <- hou14[hou14$s_rating>3, ]
hou14.l <- hou14[hou14$s_rating<3.5, ]1. Analysis with all hotels in Houston, TX
- Define reasonable markets for each hotels: 1) Distance band approach and 2) the kth nearest neighbor approach.
Source R functions
source(file="price_competition_functions.R")
source(file="MMC_functions1.R")
source(file="avmmc.new.R")Determine the distance limit and the number of the nearest neighbors
# All hotels in Houston, TX
dist.mat.list.all <- list()
for(i in 1:4){
temp.data <- hou14[hou14$qtr==i, c("lat", "lon")]
temp.dist <- GeoDistMat(temp.data)
dist.mat.list.all[[i]] <- temp.dist
}## Loading required package: Imapwp.temp <- get.wp(mkt.id.fld ="qtr", id.brand.fld ="id.brand", id.chain.fld="id.chain",
price.fld ="adr", q.fl="room.sold", rating.fld="s_rating",
dist.limit = 20, dat=hou14, dis.mat = dist.mat.list.all , n.rival=5)## market id 1 completed
## market id 2 completed
## market id 3 completed
## market id 4 completedwp.temp2 <- lapply(wp.temp, as.data.frame)
wp.all <- do.call(rbind.fill, wp.temp2)
hou14.wp <- cbind(hou14, wp.all)
# OLS regression with weighted matrix function (hotel within 20 miles from the focal hotel)
ols.hou.all <- lm(adr ~ wp.d + s_rating + hi.sales + room + cbd + air + factor(chain),
data= hou14.wp)
summary(ols.hou.all)##
## Call:
## lm(formula = adr ~ wp.d + s_rating + hi.sales + room + cbd +
## air + factor(chain), data = hou14.wp)
##
## Residuals:
## Min 1Q Median 3Q Max
## -71.730 -16.069 -1.153 13.458 161.832
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -22.612746 3.617521 -6.251 5.32e-10 ***
## wp.d 0.061512 0.011371 5.410 7.35e-08 ***
## s_rating 40.334736 1.348540 29.910 < 2e-16 ***
## hi.sales -60.045650 13.018845 -4.612 4.33e-06 ***
## room -0.001327 0.007773 -0.171 0.864516
## cbd 18.785077 3.734819 5.030 5.51e-07 ***
## air -17.266029 3.530002 -4.891 1.11e-06 ***
## factor(chain)1 39.506478 2.523429 15.656 < 2e-16 ***
## factor(chain)2 43.807732 3.321344 13.190 < 2e-16 ***
## factor(chain)3 25.799594 2.759086 9.351 < 2e-16 ***
## factor(chain)4 -3.804409 3.137594 -1.213 0.225504
## factor(chain)5 9.226447 2.839177 3.250 0.001181 **
## factor(chain)7 16.775244 6.429069 2.609 0.009164 **
## factor(chain)11 -4.289352 4.803931 -0.893 0.372064
## factor(chain)12 20.314653 4.892639 4.152 3.48e-05 ***
## factor(chain)13 -10.228061 9.601733 -1.065 0.286944
## factor(chain)14 -24.809914 9.623609 -2.578 0.010032 *
## factor(chain)15 2.225962 8.000029 0.278 0.780863
## factor(chain)16 37.778298 4.678231 8.075 1.38e-15 ***
## factor(chain)17 -9.578927 3.885334 -2.465 0.013798 *
## factor(chain)18 159.058680 13.655595 11.648 < 2e-16 ***
## factor(chain)19 204.099757 27.186823 7.507 1.03e-13 ***
## factor(chain)22 -25.356534 4.961507 -5.111 3.63e-07 ***
## factor(chain)23 20.260527 3.801172 5.330 1.13e-07 ***
## factor(chain)24 -7.708359 4.741516 -1.626 0.104222
## factor(chain)26 15.985344 9.995926 1.599 0.109991
## factor(chain)27 -6.963797 6.168733 -1.129 0.259128
## factor(chain)28 -0.731744 13.798716 -0.053 0.957715
## factor(chain)29 -6.461710 9.591100 -0.674 0.500594
## factor(chain)30 -29.260780 7.872338 -3.717 0.000209 ***
## factor(chain)40 25.203952 3.251210 7.752 1.66e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 26.78 on 1490 degrees of freedom
## Multiple R-squared: 0.7509, Adjusted R-squared: 0.7458
## F-statistic: 149.7 on 30 and 1490 DF, p-value: < 2.2e-16gamma.a <- ols.hou.all$coefficients["wp.d"]
gamma.a.lw <- confint(ols.hou.all, "wp.d")[1]
gamma.a.up <- confint(ols.hou.all, "wp.d")[2]
distance <- as.matrix(seq(0, 20, by=0.1))
price.effect.a <- data.frame()
price.effect.a <- as.data.frame(cbind(distance, gamma.a/distance, gamma.a.lw/distance, gamma.a.up/distance))
price.effect.a <- price.effect.a[-1,]
names(price.effect.a) <- c("distance", "mean", "lower", "upper")
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,3) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,10) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)
# High Quality Hotels
dim(hou14.h)## [1] 253 155## Create Distance Matrix
dist.mat.high.list <- list()
for(i in 1:4){
temp.data <- hou14.h[hou14.h$qtr==i, ]
temp.dist <- GeoDistMat(temp.data)
dist.mat.high.list[[i]] <- temp.dist
}
wp.temp.h <- get.wp(mkt.id.fld ="qtr", id.brand.fld ="id.brand", id.chain.fld="id.chain",
price.fld ="adr", q.fl="room.sold", rating.fld="s_rating",
dist.limit = 20, dat=hou14.h, dis.mat = dist.mat.high.list , n.rival=5)## market id 1 completed
## market id 2 completed
## market id 3 completed
## market id 4 completedwp.temp2 <- lapply(wp.temp.h, as.data.frame)
wp.high <- do.call(rbind.fill, wp.temp2)
hou14.h.wp <- cbind(hou14.h, wp.high)
# OLS regression with weighted matrix function (hotel within 20 miles from the focal hotel)
ols.hou.high <- lm(adr ~ wp.d + s_rating + room + hi.sales + cbd + air + factor(chain),
data= hou14.h.wp)
summary(ols.hou.high)##
## Call:
## lm(formula = adr ~ wp.d + s_rating + room + hi.sales + cbd +
## air + factor(chain), data = hou14.h.wp)
##
## Residuals:
## Min 1Q Median 3Q Max
## -89.315 -19.192 1.704 21.292 74.028
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.407e+02 3.164e+01 -4.446 1.35e-05 ***
## wp.d -9.257e-03 3.182e-02 -0.291 0.771347
## s_rating 8.294e+01 7.477e+00 11.092 < 2e-16 ***
## room -2.838e-02 1.339e-02 -2.120 0.035029 *
## hi.sales 5.693e+01 6.039e+01 0.943 0.346830
## cbd 1.148e+01 7.614e+00 1.507 0.133037
## air -4.310e+01 1.773e+01 -2.431 0.015832 *
## factor(chain)1 -1.784e+01 8.173e+00 -2.183 0.030039 *
## factor(chain)2 1.485e+00 7.903e+00 0.188 0.851149
## factor(chain)3 -3.264e+01 9.368e+00 -3.484 0.000591 ***
## factor(chain)4 -4.928e+01 1.348e+01 -3.657 0.000315 ***
## factor(chain)7 -3.479e+01 1.412e+01 -2.464 0.014481 *
## factor(chain)14 -9.373e+01 1.824e+01 -5.139 5.85e-07 ***
## factor(chain)16 -1.059e+01 9.798e+00 -1.081 0.280943
## factor(chain)17 -1.274e+02 1.795e+01 -7.099 1.51e-11 ***
## factor(chain)18 1.283e+02 1.841e+01 6.972 3.20e-11 ***
## factor(chain)19 1.170e+02 3.526e+01 3.319 0.001049 **
## factor(chain)26 -3.826e+01 1.371e+01 -2.791 0.005686 **
## factor(chain)28 -4.047e+01 1.824e+01 -2.219 0.027479 *
## factor(chain)40 4.158e+00 9.626e+00 0.432 0.666156
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 33.79 on 233 degrees of freedom
## Multiple R-squared: 0.6609, Adjusted R-squared: 0.6333
## F-statistic: 23.9 on 19 and 233 DF, p-value: < 2.2e-16gamma.a <- ols.hou.high$coefficients["wp.d"]
gamma.a.lw <- confint(ols.hou.high, "wp.d")[1]
gamma.a.up <- confint(ols.hou.high, "wp.d")[2]
distance <- as.matrix(seq(0, 20, by=0.1))
price.effect.a <- data.frame()
price.effect.a <- as.data.frame(cbind(distance, gamma.a/distance, gamma.a.lw/distance, gamma.a.up/distance))
price.effect.a <- price.effect.a[-1,]
names(price.effect.a) <- c("distance", "mean", "lower", "upper")
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,3) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)## Warning: Removed 170 rows containing missing values (geom_path).
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,10) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)## Warning: Removed 100 rows containing missing values (geom_path).
# Find distance limit for low-quality hotels
# Low Quality Hotel for sdfd
dim(hou14.l)## [1] 1268 155## Create Distance Matrix
dist.mat.low.list <- list()
for(i in 1:4){
temp.data <- hou14.l[hou14.l$qtr==i, c("lat", "lon") ]
temp.dist <- GeoDistMat(temp.data)
dist.mat.low.list[[i]] <- temp.dist
}
wp.temp.l <- get.wp(mkt.id.fld ="qtr", id.brand.fld ="id.brand", id.chain.fld="id.chain",
price.fld ="adr", q.fl="room.sold", rating.fld="s_rating",
dist.limit = 20, dat=hou14.l, dis.mat = dist.mat.low.list , n.rival=5)## market id 1 completed
## market id 2 completed
## market id 3 completed
## market id 4 completedwp.temp2 <- lapply(wp.temp.l, as.data.frame)
wp.low <- do.call(rbind.fill, wp.temp2)
hou14.l.wp <- cbind(hou14.l, wp.low)
# OLS regression with weighted matrix function (hotel within 20 miles from the focal hotel)
ols.hou.low <- lm(adr ~ wp.d + s_rating + room + hi.sales + cbd + air + factor(chain),
data= hou14.l.wp)
summary(ols.hou.low)##
## Call:
## lm(formula = adr ~ wp.d + s_rating + room + hi.sales + cbd +
## air + factor(chain), data = hou14.l.wp)
##
## Residuals:
## Min 1Q Median 3Q Max
## -42.261 -10.824 -1.127 9.359 63.161
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 32.648201 3.024099 10.796 < 2e-16 ***
## wp.d 0.021554 0.005775 3.732 0.000198 ***
## s_rating 9.656766 1.305493 7.397 2.56e-13 ***
## room -0.070768 0.012839 -5.512 4.32e-08 ***
## hi.sales -28.756608 8.638386 -3.329 0.000897 ***
## cbd 36.267682 3.756057 9.656 < 2e-16 ***
## air -11.514882 2.299656 -5.007 6.32e-07 ***
## factor(chain)1 80.020627 2.120504 37.737 < 2e-16 ***
## factor(chain)2 95.432251 3.103585 30.749 < 2e-16 ***
## factor(chain)3 65.119268 2.217987 29.360 < 2e-16 ***
## factor(chain)4 13.756830 2.110204 6.519 1.03e-10 ***
## factor(chain)5 30.546504 1.892087 16.144 < 2e-16 ***
## factor(chain)7 59.003923 5.281202 11.172 < 2e-16 ***
## factor(chain)11 5.123167 3.033882 1.689 0.091538 .
## factor(chain)12 46.229191 3.173130 14.569 < 2e-16 ***
## factor(chain)13 2.198423 6.138281 0.358 0.720292
## factor(chain)14 34.458273 8.505356 4.051 5.41e-05 ***
## factor(chain)15 45.444903 5.254176 8.649 < 2e-16 ***
## factor(chain)16 82.804755 4.642674 17.836 < 2e-16 ***
## factor(chain)17 22.563913 2.729696 8.266 3.52e-16 ***
## factor(chain)22 -0.767523 3.325875 -0.231 0.817529
## factor(chain)23 48.172860 2.583622 18.645 < 2e-16 ***
## factor(chain)24 4.990006 3.149757 1.584 0.113391
## factor(chain)27 11.619069 3.983740 2.917 0.003602 **
## factor(chain)29 5.752112 6.103177 0.942 0.346131
## factor(chain)30 -1.563541 5.066021 -0.309 0.757653
## factor(chain)40 9.771918 2.348895 4.160 3.40e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 16.81 on 1241 degrees of freedom
## Multiple R-squared: 0.8208, Adjusted R-squared: 0.817
## F-statistic: 218.6 on 26 and 1241 DF, p-value: < 2.2e-16gamma.a <- ols.hou.low$coefficients["wp.d"]
gamma.a.lw <- confint(ols.hou.low, "wp.d")[1]
gamma.a.up <- confint(ols.hou.low, "wp.d")[2]
distance <- as.matrix(seq(0, 20, by=0.1))
price.effect.a <- data.frame()
price.effect.a <- as.data.frame(cbind(distance, gamma.a/distance, gamma.a.lw/distance, gamma.a.up/distance))
price.effect.a <- price.effect.a[-1,]
names(price.effect.a) <- c("distance", "mean", "lower", "upper")
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,3) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)## Warning: Removed 170 rows containing missing values (geom_path).
ggplot(price.effect.a, aes(x=distance, y=mean)) + geom_line(aes(color="Price Effect"), size=1) +
geom_ribbon(aes(ymin=lower, ymax=upper, x=distance, fill="CI Interval"), alpha=0.3 ) +
scale_colour_manual("",values="blue")+
scale_fill_manual("",values="grey12") +
xlim(0,10) +
labs(x="Distance (Miles)", y="Price Effect = b") +
theme_grey(base_size = 18)## Warning: Removed 100 rows containing missing values (geom_path).
# loop for check the change in ramma withs the increase of number of rivals
ols.r.all <- list()
ols.r.big <- list()
ols.r.small <- list()
gamma.mat <- matrix(NA, 20, 3)
for (i in 1:20){
wp.fld <- names(hou14.wp)[i+159]
ols.eq <- paste("adr ~ ", wp.fld, " + s_rating + room + hi.sales + cbd + air + factor(chain)" )
est.all <- lm(ols.eq, data=hou14.wp, na.action = na.exclude)
est.big <- lm(ols.eq, data=hou14.h.wp, na.action = na.exclude)
est.small <- lm(ols.eq, data=hou14.l.wp, na.action = na.exclude)
ols.r.all[[i]] <- est.all
ols.r.big[[i]] <- est.big
ols.r.small[[i]] <- est.small
gamma.mat[i,1] <- est.all$coefficients[wp.fld]
gamma.mat[i,2] <- est.big$coefficients[wp.fld]
gamma.mat[i,3] <- est.small$coefficients[wp.fld]
}
gamma.mat <- as.data.frame(gamma.mat)
colnames(gamma.mat) <- c("all", "high", "low")
n.rival <- c(1:20)
gamma.mat <- cbind(n.rival, gamma.mat)
gamma.mat <- as.data.frame(gamma.mat)
ggplot(gamma.mat) + geom_line(aes(x=n.rival, y=all, color="All"), size=1) +
geom_line(aes(x=n.rival, y=high, color="High"), size=1) +
geom_line(aes(x=n.rival, y=low, color="Low"), size=1) +
scale_colour_manual("",values= c("black", "red", "blue" ))+
xlab("No. of Rivals") + ylab("Gamma")