
Contexto
El Hotel Mirage tiene como necesidad la de conocer la demanda de sus
servicios durante el tiempo para asignar mayor o menor cantidad de
presupuesto para su operatividad. Cabe mencionar que el hotel cuenta con
solamente información de los 12 meses en los que ha estado operativo (es
un hotel nuevo).
Mes y Porcentaje de ocupación:
- Ene: 78
- Feb: 82
- Mar: 75
- Abr: 80
- May: 85
- Jun: 88
- Jul: 92
- Ago: 90
- Sep: 86
- Oct: 84
- Nov: 80
- Dic: 83
Ejecución del código
Llamar Librerías
#install.packages("boot")
library(boot)
calcular intervalos de confianza
#Calcular Intervalo de Confianza del 95%
intervalo_conf <- boot.ci(Rbootstrap, type = "perc")
print(intervalo_conf)
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 1000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = Rbootstrap, type = "perc")
##
## Intervals :
## Level Percentile
## 95% (80.92, 86.42 )
## Calculations and Intervals on Original Scale
hist(Rbootstrap$t, main = "Distribución Bootstrap de la Media",
xlab = "Media Remuestreada", col = "powderblue", border = "black")

- ¿Cuál es el rango en el que podría esperarse que esté la ocupación
hotelera para el siguiente mes?
Intervalo al 95% de confianza según los calculos: (80.92, 86.42 )
Ejecución de Código: Bootstrapping con
100,000 repeticiones
calcular intervalos de confianza
#Calcular Intervalo de Confianza del 95%
intervalo_conf2 <- boot.ci(Rbootstrap2, type = "perc")
print(intervalo_conf2)
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 100000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = Rbootstrap2, type = "perc")
##
## Intervals :
## Level Percentile
## 95% (80.92, 86.25 )
## Calculations and Intervals on Original Scale
hist(Rbootstrap2$t, main = "Distribución Bootstrap de la Media",
xlab = "Media Remuestreada", col = "pink", border = "black")

En este caso el cambio de 1000 a 100,000 iteraciones no tuvo un
cambio significativo.
Comparativa:
- 1000: (80.92, 86.42 )
- 100,000: (80.92, 86.25 )
Pregunta Final
El dueño del hotel se dio cuenta de que la ocupación hotelera para el
mes de diciembre no fue de 83%, si no de 73%,
¿Cómo cambian los resultados (volver a hacer el
ejercicio)?
ocupacion3 <- c(78, 82, 75, 80, 85, 88, 92, 90, 86, 84, 80, 73)
#Función para calcular la media
bootstrap_media3 <- function(data, indices) {
return(mean(data[indices]))
}
#Aplicar Bootstrap con 1000 repeticiones
set.seed(386)
Rbootstrap3 <- boot(data = ocupacion3, statistic = bootstrap_media3, R = 100000)
#Mostrar resumen de resultados
print(Rbootstrap3)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = ocupacion3, statistic = bootstrap_media3, R = 1e+05)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 82.75 -0.003465 1.621605
#Calcular Intervalo de Confianza del 95%
intervalo_conf3 <- boot.ci(Rbootstrap3, type = "perc")
print(intervalo_conf3)
## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 100000 bootstrap replicates
##
## CALL :
## boot.ci(boot.out = Rbootstrap3, type = "perc")
##
## Intervals :
## Level Percentile
## 95% (79.58, 85.92 )
## Calculations and Intervals on Original Scale
hist(Rbootstrap3$t, main = "Distribución Bootstrap de la Media",
xlab = "Media Remuestreada", col = "violetred", border = "black")

Resultados (Tercer Bootstrap):
Al cambiar el mes de diciembre el resultado de la media cambia a
82.75, una diferencia de 1 unidad. En cuanto a intervalos, este caso
resultó un intervalo de (79.59, 86.08 )
Con el cambio anterior y 100,000 iteraciones el resultado de la media
se mantiene en 82.75 y los intervalos en (79.58, 85.92 )
LS0tDQp0aXRsZTogIkJvb3RzdHJhcHBpbmdfT2N1cGFjaW9uX0hvdGVsZXJhIg0KYXV0aG9yOiAiU2FtYW50aGEgLSBBMDE0MjI3NDkiDQpkYXRlOiAiMjAyNS0wOC0xOSINCm91dHB1dDoNCiAgaHRtbF9kb2N1bWVudDoNCiAgICAgdG9jOiBUUlVFDQogICAgIHRvY19mbG9hdDogVFJVRQ0KICAgICBjb2RlX2Rvd25sb2FkOiBUUlVFDQogICAgIHRoZW1lOiB5ZXRpDQotLS0NCiFbXShodHRwczovL2kuaW1ndXIuY29tL3ZLWDJUN1AuZ2lmKQ0KDQojIDxzcGFuIHN0eWxlPSJjb2xvcjogbGlnaHRncmVlbiA7Ij4gQ29udGV4dG8gPC9zcGFuPg0KDQpFbCBIb3RlbCBNaXJhZ2UgdGllbmUgY29tbyBuZWNlc2lkYWQgbGEgZGUgY29ub2NlciBsYSBkZW1hbmRhIGRlIHN1cyBzZXJ2aWNpb3MgZHVyYW50ZSBlbCB0aWVtcG8gcGFyYSBhc2lnbmFyIG1heW9yIG8gbWVub3IgY2FudGlkYWQgZGUgcHJlc3VwdWVzdG8gcGFyYSBzdSBvcGVyYXRpdmlkYWQuIENhYmUgbWVuY2lvbmFyIHF1ZSBlbCBob3RlbCBjdWVudGEgY29uIHNvbGFtZW50ZSBpbmZvcm1hY2nDs24gZGUgbG9zIDEyIG1lc2VzIGVuIGxvcyBxdWUgaGEgZXN0YWRvIG9wZXJhdGl2byAoZXMgdW4gaG90ZWwgbnVldm8pLg0KDQpNZXMgeSBQb3JjZW50YWplIGRlIG9jdXBhY2nDs246DQoNCiogRW5lOiA3OA0KKiBGZWI6IDgyDQoqIE1hcjogNzUgDQoqIEFicjogODANCiogTWF5OiA4NQ0KKiBKdW46IDg4DQoqIEp1bDogOTINCiogQWdvOiA5MA0KKiBTZXA6IDg2DQoqIE9jdDogODQNCiogTm92OiA4MA0KKiBEaWM6IDgzDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBncmVlbiA7Ij4gRWplY3VjacOzbiBkZWwgY8OzZGlnbyA8L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogcmVkIDsiPiBMbGFtYXIgTGlicmVyw61hcyA8L3NwYW4+DQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJib290IikNCmxpYnJhcnkoYm9vdCkNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6IGJsYWNrIDsiPiBDYWxjdWxhciBtZWRpYSB5IGFwbGljYXIgYm9vdHN0cmFwcGluZyAgPC9zcGFuPg0KDQoxLiBSZWFsaWNlIHVuIGJvb3RzdHJhcHAgY29uICoqMTAwMCoqIHJlcGV0aWNpb25lcyBjb24gcmVlbXBsYXpvDQoNCmBgYHtyfQ0Kb2N1cGFjaW9uIDwtIGMoNzgsIDgyLCA3NSwgODAsIDg1LCA4OCwgOTIsIDkwLCA4NiwgODQsIDgwLCA4MykNCg0KI0Z1bmNpw7NuIHBhcmEgY2FsY3VsYXIgbGEgbWVkaWENCmJvb3RzdHJhcF9tZWRpYSA8LSBmdW5jdGlvbihkYXRhLCBpbmRpY2VzKSB7DQogIHJldHVybihtZWFuKGRhdGFbaW5kaWNlc10pKSAgDQp9DQoNCiNBcGxpY2FyIEJvb3RzdHJhcCBjb24gMTAwMCByZXBldGljaW9uZXMNCnNldC5zZWVkKDM4NikgDQpSYm9vdHN0cmFwIDwtIGJvb3QoZGF0YSA9IG9jdXBhY2lvbiwgc3RhdGlzdGljID0gYm9vdHN0cmFwX21lZGlhLCBSID0gMTAwMCkNCg0KI01vc3RyYXIgcmVzdW1lbiBkZSByZXN1bHRhZG9zDQpwcmludChSYm9vdHN0cmFwKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2sgOyI+IGNhbGN1bGFyIGludGVydmFsb3MgZGUgY29uZmlhbnphICA8L3NwYW4+DQpgYGB7cn0NCiNDYWxjdWxhciBJbnRlcnZhbG8gZGUgQ29uZmlhbnphIGRlbCA5NSUNCmludGVydmFsb19jb25mIDwtIGJvb3QuY2koUmJvb3RzdHJhcCwgdHlwZSA9ICJwZXJjIikNCnByaW50KGludGVydmFsb19jb25mKQ0KDQoNCmhpc3QoUmJvb3RzdHJhcCR0LCBtYWluID0gIkRpc3RyaWJ1Y2nDs24gQm9vdHN0cmFwIGRlIGxhIE1lZGlhIiwNCiAgICAgeGxhYiA9ICJNZWRpYSBSZW11ZXN0cmVhZGEiLCBjb2wgPSAicG93ZGVyYmx1ZSIsIGJvcmRlciA9ICJibGFjayIpDQpgYGANCg0KMi4gwr9DdcOhbCBlcyBlbCByYW5nbyBlbiBlbCBxdWUgcG9kcsOtYSBlc3BlcmFyc2UgcXVlIGVzdMOpIGxhIG9jdXBhY2nDs24gaG90ZWxlcmEgcGFyYSBlbCBzaWd1aWVudGUgbWVzPyANCg0KSW50ZXJ2YWxvIGFsIDk1JSBkZSBjb25maWFuemEgc2Vnw7puIGxvcyBjYWxjdWxvczogKDgwLjkyLCA4Ni40MiApDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBibGFjayA7Ij5FamVjdWNpw7NuIGRlIEPDs2RpZ286IEJvb3RzdHJhcHBpbmcgY29uIDEwMCwwMDAgcmVwZXRpY2lvbmVzICA8L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2sgOyI+IENhbGN1bGFyIG1lZGlhIHkgYXBsaWNhciBib290c3RyYXBwaW5nICgxMDAwMDApICA8L3NwYW4+DQpgYGB7cn0NCg0KI0FwbGljYXIgQm9vdHN0cmFwIGNvbiAxMDAwIHJlcGV0aWNpb25lcw0Kc2V0LnNlZWQoMzg2KSANClJib290c3RyYXAyIDwtIGJvb3QoZGF0YSA9IG9jdXBhY2lvbiwgc3RhdGlzdGljID0gYm9vdHN0cmFwX21lZGlhLCBSID0gMTAwMDAwKQ0KDQojTW9zdHJhciByZXN1bWVuIGRlIHJlc3VsdGFkb3MNCnByaW50KFJib290c3RyYXAyKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjogYmxhY2sgOyI+IGNhbGN1bGFyIGludGVydmFsb3MgZGUgY29uZmlhbnphICA8L3NwYW4+DQpgYGB7cn0NCiNDYWxjdWxhciBJbnRlcnZhbG8gZGUgQ29uZmlhbnphIGRlbCA5NSUNCmludGVydmFsb19jb25mMiA8LSBib290LmNpKFJib290c3RyYXAyLCB0eXBlID0gInBlcmMiKQ0KcHJpbnQoaW50ZXJ2YWxvX2NvbmYyKQ0KDQoNCmhpc3QoUmJvb3RzdHJhcDIkdCwgbWFpbiA9ICJEaXN0cmlidWNpw7NuIEJvb3RzdHJhcCBkZSBsYSBNZWRpYSIsDQogICAgIHhsYWIgPSAiTWVkaWEgUmVtdWVzdHJlYWRhIiwgY29sID0gInBpbmsiLCBib3JkZXIgPSAiYmxhY2siKQ0KYGBgDQoNCkVuIGVzdGUgY2FzbyBlbCBjYW1iaW8gZGUgMTAwMCBhIDEwMCwwMDAgaXRlcmFjaW9uZXMgbm8gdHV2byB1biBjYW1iaW8gc2lnbmlmaWNhdGl2by4NCiANCkNvbXBhcmF0aXZhOiANCiANCiogMTAwMDogKDgwLjkyLCA4Ni40MiApIA0KKiAxMDAsMDAwOiAoODAuOTIsIDg2LjI1ICkgIA0KDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOiBwaW5rIDsiPiBQcmVndW50YSBGaW5hbCA8L3NwYW4+DQoNCkVsIGR1ZcOxbyBkZWwgaG90ZWwgc2UgZGlvIGN1ZW50YSBkZSBxdWUgbGEgb2N1cGFjacOzbiBob3RlbGVyYSBwYXJhIGVsIG1lcyBkZSBkaWNpZW1icmUgbm8gZnVlIGRlICo4MyUqLCBzaSBubyBkZSAqNzMlKiwgKirCv0PDs21vIGNhbWJpYW4gbG9zIHJlc3VsdGFkb3MgKHZvbHZlciBhIGhhY2VyIGVsIGVqZXJjaWNpbyk/KioNCg0KYGBge3J9DQpvY3VwYWNpb24zIDwtIGMoNzgsIDgyLCA3NSwgODAsIDg1LCA4OCwgOTIsIDkwLCA4NiwgODQsIDgwLCA3MykNCg0KI0Z1bmNpw7NuIHBhcmEgY2FsY3VsYXIgbGEgbWVkaWENCmJvb3RzdHJhcF9tZWRpYTMgPC0gZnVuY3Rpb24oZGF0YSwgaW5kaWNlcykgew0KICByZXR1cm4obWVhbihkYXRhW2luZGljZXNdKSkgIA0KfQ0KDQojQXBsaWNhciBCb290c3RyYXAgY29uIDEwMDAgcmVwZXRpY2lvbmVzDQpzZXQuc2VlZCgzODYpIA0KUmJvb3RzdHJhcDMgPC0gYm9vdChkYXRhID0gb2N1cGFjaW9uMywgc3RhdGlzdGljID0gYm9vdHN0cmFwX21lZGlhMywgUiA9IDEwMDAwMCkNCg0KI01vc3RyYXIgcmVzdW1lbiBkZSByZXN1bHRhZG9zDQpwcmludChSYm9vdHN0cmFwMykNCg0KI0NhbGN1bGFyIEludGVydmFsbyBkZSBDb25maWFuemEgZGVsIDk1JQ0KaW50ZXJ2YWxvX2NvbmYzIDwtIGJvb3QuY2koUmJvb3RzdHJhcDMsIHR5cGUgPSAicGVyYyIpDQpwcmludChpbnRlcnZhbG9fY29uZjMpDQoNCg0KaGlzdChSYm9vdHN0cmFwMyR0LCBtYWluID0gIkRpc3RyaWJ1Y2nDs24gQm9vdHN0cmFwIGRlIGxhIE1lZGlhIiwNCiAgICAgeGxhYiA9ICJNZWRpYSBSZW11ZXN0cmVhZGEiLCBjb2wgPSAidmlvbGV0cmVkIiwgYm9yZGVyID0gImJsYWNrIikNCmBgYA0KIA0KUmVzdWx0YWRvcyAoVGVyY2VyIEJvb3RzdHJhcCk6IA0KDQoqIDEwMDAgaXRlcmFjaW9uZXM6DQoNCkFsIGNhbWJpYXIgZWwgbWVzIGRlIGRpY2llbWJyZSBlbCByZXN1bHRhZG8gZGUgbGEgbWVkaWEgY2FtYmlhIGEgODIuNzUsIHVuYSBkaWZlcmVuY2lhIGRlIDEgdW5pZGFkLiBFbiBjdWFudG8gYSBpbnRlcnZhbG9zLCBlc3RlIGNhc28gcmVzdWx0w7MgdW4gaW50ZXJ2YWxvIGRlICg3OS41OSwgODYuMDggKSAgDQoNCiogMTAwLDAwMCBpdGVyYWNpb25lczoNCg0KQ29uIGVsIGNhbWJpbyBhbnRlcmlvciB5IDEwMCwwMDAgaXRlcmFjaW9uZXMgZWwgcmVzdWx0YWRvIGRlIGxhIG1lZGlhIHNlIG1hbnRpZW5lIGVuIDgyLjc1IHkgbG9zIGludGVydmFsb3MgZW4gKDc5LjU4LCA4NS45MiApDQoNCg0K