
Grupo 102
Profesor Christopher Rodríguez García
Equipo 6:
A01368516 - Nayeli Peña Martínez
A00833113 - Avril Lobato
A01771127 - Lesly Darian Romero Vazquez
A00831105 - Jazmin del Carmen Cortez Mendoza
A01198184 - Karla Sánchez del Ángel
A01198186 - Luis Angel Elizondo Gallegos
Situación Problema
Una empresa de e-commerce quiere evaluar el impacto de una nueva
campaña de marketing sobre sus ventas diarias. Tienen datos de ventas
antes y después de la campaña y desean determinar si la campaña tuvo un
efecto significativo en el aumento de las ventas. * Dado que los datos
de ventas pueden tener alta variabilidad y dependencia temporal, se
decide usar el doble bootstrap para mejorar la estimación del intervalo
de confianza del efecto de la campaña.
Carga de base de datos
datos <- read.csv("C:/Users/AVRIL/Downloads/dataset_ventas.csv")
Separación de los datos antes y después de la campaña
ventas_antes <- datos$ventas[datos$periodo == "antes"]
ventas_despues <- datos$ventas[datos$periodo == "despues"]
Primer nivel de bootstrapping
Seleccionar 30 días aleatoriamente, repetir 1000 veces
n_boot1 <- 1000
bootstrap_nivel1 <- boot(data = datos, statistic = evaluar_impacto, R = n_boot1)
Intervalos de primer nivel de bootstrapping
conf_intervals <- quantile(bootstrap_nivel1$t, probs = c(0.025, 0.975))
Resultados
cat("Impacto promedio estimado:", mean(bootstrap_nivel1$t), "\n")
## Impacto promedio estimado: 10.0856
cat("Intervalo de confianza al 95%:", conf_intervals[1], "-", conf_intervals[2], "\n")
## Intervalo de confianza al 95%: 5.683841 - 14.50556
Histograma de Primer nivel de bootstrapping
hist(bootstrap_nivel1$t, main="Bootstrap de Diferencia de Medias 1er Nivel",
xlab="Diferencia de Medias", col="skyblue", border="white")

Segundo nivel de bootstrapping
Repetir el proceso con múltiples muestras
set.seed(123)
doble_bootstrap <- function(data, n_outer, n_inner) {
outer_results <- replicate(n_outer, {
outer_sample <- data[sample(nrow(data), 10, replace = TRUE), ]
inner_boot <- boot(data = outer_sample, statistic = evaluar_impacto, R = n_inner)
return(mean(inner_boot$t)) # Promedio de diferencias en el nivel interno
})
return(outer_results)
}
Aplicamos el doble bootstrapping
n_outer <- 500 # Muestras bootstrap externas
n_inner <- 200 # Muestras bootstrap internas
doble_resultados <- doble_bootstrap(datos, n_outer, n_inner)
Calcular intervalos de confianza al 95%
conf_intervals <- quantile(doble_resultados, probs = c(0.025, 0.975))
Resultados
cat("Impacto promedio estimado:", mean(doble_resultados), "\n")
## Impacto promedio estimado: 10.0131
cat("Intervalo de confianza al 95%:", conf_intervals[1], "-", conf_intervals[2], "\n")
## Intervalo de confianza al 95%: 9.708404 - 10.31402
Conclusión
Con base en los resultados obtenidos, se identifica que el segundo
bootstrap es mejor que el bootstrap de primer nivel puesto que, el
intervalo del primero es menor que el del segundo. Acorde a este modelo,
se determina que la campaña tuvo un impacto significativo porque el
intervalo de confianza es completamente positivo (10.01), lo que
significa que las ventas aumentaron significativamente después de la
campaña.
LS0tDQp0aXRsZTogIkVqZXJjaWNpbyAyOiBEb2JsZSBCb290c3RyYXAiDQpzdWJ0aXRsZTogIkdlbmVyYWNpw7NuIGRlIEVzY2VuYXJpb3MgRnV0dXJvcyBjb24gQW5hbMOtdGljYSINCmF1dGhvcjogIkVxdWlwbyA2Ig0KZGF0ZTogIjIwMjQtMDMtMjEiDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiB5ZXMNCiAgICB0b2NfZmxvYXQ6IHllcw0KICAgIGNvZGVfZG93bmxvYWQ6IHllcw0KICAgIHRoZW1lOiB1bml0ZWQNCiAgICBoaWdobGlnaHQ6IHB5Z21lbnRzDQotLS0NCg0KIVtdKGh0dHBzOi8vY2l0cmlzLXVjLm9yZy93cC1jb250ZW50L3VwbG9hZHMvMjAxOS8xMC9UZWMtZGUtTW9udGVycmV5LWxvZ28taG9yaXpvbnRhbC1ibHVlLnBuZykNCg0KDQo8ZGl2IHN0eWxlPSJ0ZXh0LWFsaWduOiBjZW50ZXIiPg0KICA8cD48c3Ryb25nPkdydXBvIDEwMjwvc3Ryb25nPjwvcD4NCiAgPHA+PHN0cm9uZz5Qcm9mZXNvciBDaHJpc3RvcGhlciBSb2Ryw61ndWV6IEdhcmPDrWE8L3N0cm9uZz48L3A+DQo8L2Rpdj4NCg0KPGRpdiBzdHlsZT0idGV4dC1hbGlnbjogY2VudGVyIj4NCiAgPHA+PHN0cm9uZz5FcXVpcG8gNjo8L3N0cm9uZz48L3A+DQoNCiAgQTAxMzY4NTE2IC0gTmF5ZWxpIFBlw7FhIE1hcnTDrW5leg0KDQogIEEwMDgzMzExMyAtIEF2cmlsIExvYmF0bw0KDQogIEEwMTc3MTEyNyAtIExlc2x5IERhcmlhbiBSb21lcm8gVmF6cXVleg0KDQogIEEwMDgzMTEwNSAtIEphem1pbiBkZWwgQ2FybWVuIENvcnRleiBNZW5kb3phDQoNCiAgQTAxMTk4MTg0IC0gS2FybGEgU8OhbmNoZXogZGVsIMOBbmdlbA0KDQogIEEwMTE5ODE4NiAtIEx1aXMgQW5nZWwgRWxpem9uZG8gR2FsbGVnb3MNCiANCjwvZGl2Pg0KDQoNCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQ0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KA0KCWVjaG8gPSBUUlVFLA0KCW1lc3NhZ2UgPSBGQUxTRSwNCgl3YXJuaW5nID0gRkFMU0UNCikNCmBgYA0KDQojICoqU2l0dWFjacOzbiBQcm9ibGVtYSoqDQpVbmEgZW1wcmVzYSBkZSBlLWNvbW1lcmNlIHF1aWVyZSBldmFsdWFyIGVsIGltcGFjdG8gZGUgdW5hIG51ZXZhIGNhbXBhw7FhIGRlIG1hcmtldGluZyBzb2JyZSBzdXMgdmVudGFzIGRpYXJpYXMuIFRpZW5lbiBkYXRvcyBkZSB2ZW50YXMgYW50ZXMgeSBkZXNwdcOpcyBkZSBsYSBjYW1wYcOxYSB5IGRlc2VhbiBkZXRlcm1pbmFyIHNpIGxhDQpjYW1wYcOxYSB0dXZvIHVuIGVmZWN0byBzaWduaWZpY2F0aXZvIGVuIGVsIGF1bWVudG8gZGUgbGFzIHZlbnRhcy4NCiogRGFkbyBxdWUgbG9zIGRhdG9zIGRlIHZlbnRhcyBwdWVkZW4gdGVuZXIgYWx0YSB2YXJpYWJpbGlkYWQgeSBkZXBlbmRlbmNpYSB0ZW1wb3JhbCwgc2UgZGVjaWRlIHVzYXIgZWwgZG9ibGUgYm9vdHN0cmFwIHBhcmEgbWVqb3JhciBsYSBlc3RpbWFjacOzbiBkZWwgaW50ZXJ2YWxvIGRlIGNvbmZpYW56YSBkZWwgZWZlY3RvIGRlIGxhIGNhbXBhw7FhLg0KDQoNCiMgTGlicmVyw61hcw0KYGBge3J9DQpsaWJyYXJ5KGJvb3QpDQpgYGANCg0KIyBDYXJnYSBkZSBiYXNlIGRlIGRhdG9zDQpgYGB7cn0NCmRhdG9zIDwtIHJlYWQuY3N2KCJDOi9Vc2Vycy9BVlJJTC9Eb3dubG9hZHMvZGF0YXNldF92ZW50YXMuY3N2IikNCmBgYA0KDQojIFNlcGFyYWNpw7NuIGRlIGxvcyBkYXRvcyBhbnRlcyB5IGRlc3B1w6lzIGRlIGxhIGNhbXBhw7FhDQpgYGB7cn0NCnZlbnRhc19hbnRlcyA8LSBkYXRvcyR2ZW50YXNbZGF0b3MkcGVyaW9kbyA9PSAiYW50ZXMiXQ0KdmVudGFzX2Rlc3B1ZXMgPC0gZGF0b3MkdmVudGFzW2RhdG9zJHBlcmlvZG8gPT0gImRlc3B1ZXMiXQ0KYGBgDQoNCiMgRnVuY2nDs24gcGFyYSBjYWxjdWxhciBsYSBkaWZlcmVuY2lhIG1lZGlhIGRlIHZlbnRhcw0KYGBge3J9DQpldmFsdWFyX2ltcGFjdG8gPC0gZnVuY3Rpb24oZGF0YSwgaW5kaWNlcykgew0KICBtdWVzdHJhX2FudGVzIDwtIHNhbXBsZSh2ZW50YXNfYW50ZXMsIGxlbmd0aCh2ZW50YXNfYW50ZXMpLCByZXBsYWNlID0gVFJVRSkNCiAgbXVlc3RyYV9kZXNwdWVzIDwtIHNhbXBsZSh2ZW50YXNfZGVzcHVlcywgbGVuZ3RoKHZlbnRhc19kZXNwdWVzKSwgcmVwbGFjZSA9IFRSVUUpDQogIG1lYW4obXVlc3RyYV9kZXNwdWVzKSAtIG1lYW4obXVlc3RyYV9hbnRlcykNCn0NCmBgYA0KDQojIFByaW1lciBuaXZlbCBkZSBib290c3RyYXBwaW5nDQojIyAgU2VsZWNjaW9uYXIgMzAgZMOtYXMgYWxlYXRvcmlhbWVudGUsIHJlcGV0aXIgMTAwMCB2ZWNlcw0KYGBge3J9DQpuX2Jvb3QxIDwtIDEwMDANCmJvb3RzdHJhcF9uaXZlbDEgPC0gYm9vdChkYXRhID0gZGF0b3MsIHN0YXRpc3RpYyA9IGV2YWx1YXJfaW1wYWN0bywgUiA9IG5fYm9vdDEpDQpgYGANCg0KIyMgSW50ZXJ2YWxvcyBkZSBwcmltZXIgbml2ZWwgZGUgYm9vdHN0cmFwcGluZw0KYGBge3J9DQpjb25mX2ludGVydmFscyA8LSBxdWFudGlsZShib290c3RyYXBfbml2ZWwxJHQsIHByb2JzID0gYygwLjAyNSwgMC45NzUpKQ0KYGBgDQoNCiMjIFJlc3VsdGFkb3MNCmBgYHtyfQ0KY2F0KCJJbXBhY3RvIHByb21lZGlvIGVzdGltYWRvOiIsIG1lYW4oYm9vdHN0cmFwX25pdmVsMSR0KSwgIlxuIikNCmNhdCgiSW50ZXJ2YWxvIGRlIGNvbmZpYW56YSBhbCA5NSU6IiwgY29uZl9pbnRlcnZhbHNbMV0sICItIiwgY29uZl9pbnRlcnZhbHNbMl0sICJcbiIpDQpgYGANCiMjIEhpc3RvZ3JhbWEgZGUgUHJpbWVyIG5pdmVsIGRlIGJvb3RzdHJhcHBpbmcNCmBgYHtyfQ0KaGlzdChib290c3RyYXBfbml2ZWwxJHQsIG1haW49IkJvb3RzdHJhcCBkZSBEaWZlcmVuY2lhIGRlIE1lZGlhcyAxZXIgTml2ZWwiLCANCiAgICAgeGxhYj0iRGlmZXJlbmNpYSBkZSBNZWRpYXMiLCBjb2w9InNreWJsdWUiLCBib3JkZXI9IndoaXRlIikNCmBgYA0KDQoNCiMgU2VndW5kbyAgbml2ZWwgZGUgYm9vdHN0cmFwcGluZw0KIyMgUmVwZXRpciBlbCBwcm9jZXNvIGNvbiBtw7psdGlwbGVzIG11ZXN0cmFzDQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCmRvYmxlX2Jvb3RzdHJhcCA8LSBmdW5jdGlvbihkYXRhLCBuX291dGVyLCBuX2lubmVyKSB7DQogIG91dGVyX3Jlc3VsdHMgPC0gcmVwbGljYXRlKG5fb3V0ZXIsIHsNCiAgICBvdXRlcl9zYW1wbGUgPC0gZGF0YVtzYW1wbGUobnJvdyhkYXRhKSwgMTAsIHJlcGxhY2UgPSBUUlVFKSwgXQ0KICAgIGlubmVyX2Jvb3QgPC0gYm9vdChkYXRhID0gb3V0ZXJfc2FtcGxlLCBzdGF0aXN0aWMgPSBldmFsdWFyX2ltcGFjdG8sIFIgPSBuX2lubmVyKQ0KICAgIHJldHVybihtZWFuKGlubmVyX2Jvb3QkdCkpICAjIFByb21lZGlvIGRlIGRpZmVyZW5jaWFzIGVuIGVsIG5pdmVsIGludGVybm8NCiAgfSkNCiAgcmV0dXJuKG91dGVyX3Jlc3VsdHMpDQp9DQpgYGANCg0KIyMgQXBsaWNhbW9zIGVsIGRvYmxlIGJvb3RzdHJhcHBpbmcNCmBgYHtyfQ0Kbl9vdXRlciA8LSA1MDAgICAjIE11ZXN0cmFzIGJvb3RzdHJhcCBleHRlcm5hcw0Kbl9pbm5lciA8LSAyMDAgICAjIE11ZXN0cmFzIGJvb3RzdHJhcCBpbnRlcm5hcw0KZG9ibGVfcmVzdWx0YWRvcyA8LSBkb2JsZV9ib290c3RyYXAoZGF0b3MsIG5fb3V0ZXIsIG5faW5uZXIpDQpgYGANCg0KIyMgQ2FsY3VsYXIgaW50ZXJ2YWxvcyBkZSBjb25maWFuemEgYWwgOTUlDQpgYGB7cn0NCmNvbmZfaW50ZXJ2YWxzIDwtIHF1YW50aWxlKGRvYmxlX3Jlc3VsdGFkb3MsIHByb2JzID0gYygwLjAyNSwgMC45NzUpKQ0KYGBgDQoNCiMjIFJlc3VsdGFkb3MNCmBgYHtyfQ0KY2F0KCJJbXBhY3RvIHByb21lZGlvIGVzdGltYWRvOiIsIG1lYW4oZG9ibGVfcmVzdWx0YWRvcyksICJcbiIpDQpjYXQoIkludGVydmFsbyBkZSBjb25maWFuemEgYWwgOTUlOiIsIGNvbmZfaW50ZXJ2YWxzWzFdLCAiLSIsIGNvbmZfaW50ZXJ2YWxzWzJdLCAiXG4iKQ0KYGBgDQojIyBIaXN0b2dyYW1hIGRlIGxhcyBkaWZlcmVuY2lhcyBkZSBtZWRpYXMgZGUgU2VndW5kbyBOaXZlbA0KYGBge3J9DQpoaXN0KGRvYmxlX3Jlc3VsdGFkb3MsIG1haW49IkJvb3RzdHJhcCBkZSBEaWZlcmVuY2lhIGRlIE1lZGlhcyIsIA0KICAgICB4bGFiPSJEaWZlcmVuY2lhIGRlIE1lZGlhcyIsIGNvbD0ic2t5Ymx1ZSIsIGJvcmRlcj0id2hpdGUiKQ0KYGBgDQoNCiMgKipDb25jbHVzacOzbioqDQpDb24gYmFzZSBlbiBsb3MgcmVzdWx0YWRvcyBvYnRlbmlkb3MsIHNlIGlkZW50aWZpY2EgcXVlIGVsIHNlZ3VuZG8gYm9vdHN0cmFwIGVzIG1lam9yIHF1ZSBlbCBib290c3RyYXAgZGUgcHJpbWVyIG5pdmVsIHB1ZXN0byBxdWUsIGVsIGludGVydmFsbyBkZWwgcHJpbWVybyBlcyBtZW5vciBxdWUgZWwgZGVsIHNlZ3VuZG8uIEFjb3JkZSBhIGVzdGUgbW9kZWxvLCBzZSBkZXRlcm1pbmEgcXVlIGxhIGNhbXBhw7FhIHR1dm8gdW4gaW1wYWN0byBzaWduaWZpY2F0aXZvIHBvcnF1ZSBlbCBpbnRlcnZhbG8gZGUgY29uZmlhbnphIGVzIGNvbXBsZXRhbWVudGUgcG9zaXRpdm8gKDEwLjAxKSwgbG8gcXVlIHNpZ25pZmljYSBxdWUgbGFzIHZlbnRhcyBhdW1lbnRhcm9uIHNpZ25pZmljYXRpdmFtZW50ZSBkZXNwdcOpcyBkZSBsYSBjYW1wYcOxYS4gDQo=