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.

Librerías

library(boot)

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"]

Función para calcular la diferencia media de ventas

evaluar_impacto <- function(data, indices) {
  muestra_antes <- sample(ventas_antes, length(ventas_antes), replace = TRUE)
  muestra_despues <- sample(ventas_despues, length(ventas_despues), replace = TRUE)
  mean(muestra_despues) - mean(muestra_antes)
}

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

Histograma de las diferencias de medias de Segundo Nivel

hist(doble_resultados, main="Bootstrap de Diferencia de Medias", 
     xlab="Diferencia de Medias", col="skyblue", border="white")

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=