Introducción

En principio, se usará una base de datos en la cual aparece una muestra de 47.734 compras hechas en uno de los Black fridays que se realizan en Estados Unidos. Se carga entonces la base de datos como se muestra acontinuación:

library(readxl)
ExcelBF <- "Blackfriday.xlsx"
BlackFriday <- read_excel(ExcelBF)

Actividad 1

Se quiere estudiar cómo fueron las compras en esa jornada, por lo que se analizará la variable PURCHASE. Se crea una semilla aleatoriamente con los últimos dígitos de los documentos de identidad de los integrantes del grupo y se extre una muestra aleatoria de tamaño 120:

library(writexl)
set.seed(04605)
muestra_aleat <- BlackFriday[sample(nrow(BlackFriday), 120), ]

Se hace un análisis descriptivo de variables “Género”, “Categoría de ciudad” e “Ingreso”

Género

# Frecuencia de género
frec_genero <- as.data.frame(table(muestra_aleat$Gender))
# Se construye la tabla de frecuencia para la variable:
library(kableExtra)
datos_genero <- cbind(frec_genero)
titulos1 <- c("Género", "Frecuencia") 
tablafrec_gen <- kable(datos_genero, caption = "Tabla de Frecuencia: Género", format = "markdown", col.names = titulos1, align = 'cccccc', digits = 3) %>% kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>% 
row_spec(0, bold = TRUE) 
tablafrec_gen

Tabla de Frecuencia: Género
Género	Frecuencia
F	19
M	101

Con lo anterior, se realizó un histograma para comparar visualmente la frecuencia o proporción de las dos categorías en la variable:

# Gráfico de barras para género
barplot(table(muestra_aleat$Gender), main="Distribución de Género", xlab="Género", ylab="Frecuencia", col = "pink")

En la muestra seleccionada se puede observar que los hombres son quienes hicieron la mayor cantidad compras en el Black Friday registradas en Estados Unidos.

Categoría de ciudad

#Frecuencia absoluta
fabs_Ciudad <- table(muestra_aleat$City_Category)
#Frecuencia absoluta acumulada
fabs_acumCiudad <- cumsum(fabs_Ciudad)
#Frecuencia relativa
frel_Ciudad <- fabs_Ciudad/length(muestra_aleat$City_Category)
#Frecuencia relativa (%)
frel_CiudadP <- (fabs_Ciudad/length(muestra_aleat$City_Category))*100
#Frecuencia relativa acumulada
frel_acumCiudad <- cumsum(frel_Ciudad)
#Frecuencia relativa acumulada (%)
frel_acum_CiudadP <- cumsum(frel_CiudadP)

#Se crea una variable que combine en una columna a los datos calculados previamente
datos_ciudad <- cbind(fabs_Ciudad,fabs_acumCiudad,frel_Ciudad,frel_CiudadP,frel_acumCiudad,frel_acum_CiudadP)

#Se construye la tabla de frecuencia para la variable:
titulos2 <- c("Frecuencia Absoluta","Frequencia Absoluta Acumulada","Frecuencia Relativa","(%)","Frecuencia Relativa Acumulada","(%)")
tabla_freqciudad <- kable(datos_ciudad, caption = "Tabla de Frecuencia: Categoría de ciudad", format = "markdown", col.names = titulos2, align = 'cccccc', digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) 
tabla_freqciudad

Tabla de Frecuencia: Categoría de ciudad
	Frecuencia Absoluta	Frequencia Absoluta Acumulada	Frecuencia Relativa	(%)	Frecuencia Relativa Acumulada	(%)
A	30	30	0.25	25.00	0.25	25.00
B	50	80	0.42	41.67	0.67	66.67
C	40	120	0.33	33.33	1.00	100.00

Con la anterior tabla de frecuencias se pueden identificar patrones y resumir datos de la categoría de la ciudad de la muestra evaluada. Esto se puede ver mejor en el siguiente diagrama de torta:

etiquetaEst <- paste(round(frel_CiudadP, 2),"%", sep="   ")
colores_rosados <- c("#FF1493", "#FFC0CB", "#e2889b")
pie(frel_CiudadP,labels = etiquetaEst, clockwise = TRUE, col = colores_rosados, main = "Categoría de ciudad", cex = 0.8, border = "white", radius = 0.8, font.main = 1, init.angle = 90) 
legend("topright",c("A", "B", "C"),cex=0.9,fill=colores_rosados, border = "white")

De acuerdo con esto, se puede afirmar que las personas que se encuentran en la categoría B de ciudad son quienes realizaron más compras, en la muestra estudiada esto representó el 41,67 %. En segundo lugar se encontró a las personas de categoría C con el 33,33 % y, por último, a las personas de categoría A con el 25,00 % en proporción.

Ingreso

# Calcular media, mediana y moda
library(descriptr)
mediaIngr <- mean(muestra_aleat$Income)
medianaIngr <- median(muestra_aleat$Income)
modaIngr <- ds_mode(muestra_aleat$Income)

# Se construye la tabla de medidas de tendencia central para la variable:
t_centIngr <- data.frame(Media = mediaIngr, Mediana = medianaIngr, Moda = modaIngr)

tabla3_tcentIngr <- kable(t_centIngr, caption = "Medidas de tendencia central: Ingresos", format = "markdown", align = 'cccccc', digits = 3) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE)
tabla3_tcentIngr

Medidas de tendencia central: Ingresos
Media	Mediana	Moda
13052.9	13530	6577

La media de la cantidad de ingresos de los compradores es de 13053. De esta manera, en promedio, el monto de los ingresos de las personas que compran en el Black Friday tienden a estar alrededor de este valor. La moda es de 6577 Ingr; esto indica que en la muestra analizada, las personas con esta cantidad de ingresos son los que más compraron en el Black Friday.

A continuación, se realiza un análisis más detallado de los ingresos, explorando su distribución a través de gráficos y otras medidas:

library(ggplot2)
sumstatz <- data.frame(
  t_centIngr = c("Media", "Mediana", "Moda"),
  value = c(mediaIngr, medianaIngr, modaIngr)
)
ggIngr <- ggplot(muestra_aleat, aes(x = Income)) +
  geom_histogram(color = "black", fill = "white", binwidth = 500) +
  labs(
    title = "Medidas de tendencia central: Ingresos",
    x = "Ingresos",
    y = "Frecuencia"
  ) +
  theme_minimal() + theme(
    panel.grid.major = element_blank(), 
    panel.grid.minor = element_blank(),
    plot.title = element_text(hjust = 0.5), 
    axis.line = element_line(size = 0.5, color = "black")) +
  geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_centIngr, color = t_centIngr), size = 1) +
  scale_linetype_manual(values = c("Media" = "solid", "Mediana" = "dashed", "Moda" = "dotted")) +
  scale_color_manual(values = c("Media" = "#FF1493", "Mediana" = "#FFC0CB", "Moda" = "#B03060")) + theme(legend.title = element_blank())
ggIngr + scale_x_continuous(limits = NULL) + scale_y_continuous(limits = NULL)

Ahora, se realizan medidas de dispersión:

# Medidas de dispersión
rangoIngr <- range(muestra_aleat$Income)
  rangoIngr1 <- paste("[", rangoIngr[1], " - ", rangoIngr[2], "]", sep = "")
varIngr <- var(muestra_aleat$Income)
desvestIngr <- sd(muestra_aleat$Income)
coefvarIngr <- desvestIngr/mean(muestra_aleat$Income)

# Se construye una tabla para mostrar las medidas de dispersión:
t_dispIngr <- data.frame('Rango' = rangoIngr1, 'Varianza' = varIngr, 'Desviación estándar' = desvestIngr, 'Coeficiente de variación' = coefvarIngr)

titulos4 <- c("Rango", "Varianza", "Desviación estándar", "Coeficiente de variación")

tabla_tdispIngr <- kable(t_dispIngr, caption = "Medidas de dispersión: Ingresos", format = "markdown", col.names = titulos4, align = 'cccccc', digits = 2) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE) %>%
  column_spec(1, width = "10cm")
tabla_tdispIngr

Medidas de dispersión: Ingresos
Rango	Varianza	Desviación estándar	Coeficiente de variación
[6577 - 18748]	5724968	2392.69	0.18

[6577 - 18748] 5724968 2392.69 0.18

Como se calculó, los Ingreso oscilan entre 6577 y 18748 dólares, este rango amplio sugiere una variabilidad significativa en los ingresos de los compradores, lo que significa que algunos tienen ingresos bajos mientras que otros tienen ingresos bastante altos. En este caso, la varianza sugiere que los datos están relativamente dispersos, lo que concuerda con la observación anterior del rango amplio. Por su parte, la variabilidad en los ingresos es del 18 % con respecto a la media. Esto sugiere que, en relación con la media, los ingresos varían moderadamente. En el siguiente gráfico se puede observar mucho mejor la dispersión de esta variable en la muestra:

ggplot(muestra_aleat, aes(x = as.numeric(rownames(muestra_aleat)), y = Income)) +
  geom_point(col = "#FF1493") +
  theme_minimal() + theme(
    panel.grid.major = element_blank(), 
    panel.grid.minor = element_blank(), 
    axis.line = element_line(size = 0.5, color = "black")) +
  labs(title = "Gráfico de dispersión", subtitle = "Ingresos", y = "Ingresos ($)", x= "Comprador")

Luego, se calcularon medidas de posición:

# Cálculo de cuartiles
Q1Ingr <- quantile(muestra_aleat$Income,0.25,type = 6)
Q2Ingr <- quantile(muestra_aleat$Income,0.50,type = 6)
Q3Ingr <- quantile(muestra_aleat$Income,0.75,type = 6)

# Construcción de la tabla
t_cuantilIngr <- data.frame(Cuartil = c("Q1", "Q2", "Q3"),
  Valor = c(Q1Ingr, Q2Ingr, Q3Ingr)
)
print(t_cuantilIngr)

##     Cuartil    Valor
## 25%      Q1 11219.75
## 50%      Q2 13530.00
## 75%      Q3 14611.50

Lo anterior se puede observar mucho mejor en el siguiente diagrama:

# Construcción gráfica
sumstatz <- data.frame(
  t_cuantilIngr = c("Q1", "Q2", "Q3"),
  value = c(Q1Ingr, Q2Ingr, Q3Ingr)
)
ggIngrQ <- ggplot(muestra_aleat, aes(x = Income)) +
  geom_histogram(color = "black", fill = "white", binwidth = 500) +
  labs(
    title = "Cuartiles: Ingresos",
    x = "Cantidad del Ingreso",
    y = "Frecuencia"
  ) +
  theme_minimal() + theme(
    panel.grid.major = element_blank(), 
    panel.grid.minor = element_blank(),
    plot.title = element_text(hjust = 0.5), 
    axis.line = element_line(size = 0.5, color = "black")) +
  geom_vline(data = sumstatz, aes(xintercept = value, linetype = t_cuantilIngr, color = t_cuantilIngr), size = 1) +
  scale_linetype_manual(values = c("Q1" = "solid", "Q2" = "dashed", "Q3" = "dotted")) +
  scale_color_manual(values = c("Q1" = "#FF1493", "Q2" = "#FFC0CB", "Q3" = "#B03060")) + theme(legend.title = element_blank())
ggIngrQ + scale_x_continuous(limits = NULL) + scale_y_continuous(limits = NULL)

En el siguiente boxplot no se observan datos atípicos. Sin embargo, los datos tienen tendencia hacia valores altos; aunque la mediana sea cercana a la media, esta se encuentra por encima de ella.

box_ingr <- boxplot(muestra_aleat$Income, col = "white", ylab = "Ingresos",
  main = "Boxplot: Ingresos")
stripchart(muestra_aleat$Income,              
           method = "jitter", 
           pch = 19,          
           col = '#B03060',           
           vertical = TRUE, 
           add = TRUE
)

Purchase: Valor de la compra

Se calcula la media y la desviación estándar a la muestra y a la población, dónde se obtiene:

#Para la población:
media_pob <- mean(BlackFriday$Purchase)
desv_pob<- sd(BlackFriday$Purchase)

#Para la muestra:
media_muest <- mean(muestra_aleat$Purchase)
desv_muest <- sd(muestra_aleat$Purchase)

#Se crea una variable que combine en una columna a los datos calculados previamente:
datos_purch <- cbind(media_pob, media_muest, desv_pob, desv_muest)

#Se construye la tabla:
titulos_purch <- c("Media Poblacional", "Desv. Estándar Poblacional", "Media Muestral", "Desv. Estándar Muestral")
tabla_purch <- kable(datos_purch, caption = "Variable 'Compra' ($)", format = "markdown", col.names = titulos_purch, align = 'cccccc', digits = 0) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
row_spec(0, bold = TRUE) 
tabla_purch

Variable ‘Compra’ ($)
Media Poblacional	Desv. Estándar Poblacional	Media Muestral	Desv. Estándar Muestral
9508	8759	5002	5522

Según lo anterior, el estimador de la media poblacional es la media muestral, porque no tiende a sobreestimar ni subestimar la verdadera media poblacional. Por otro lado, el estimador de la desviación estándar poblacional es la desviación estándar muestral, pues es un estimador consistente ya que con el aumento del tamaño de la muestra, la desviación estándar muestral converge hacia la desviación estándar poblacional.

Luego, se calcula la probabilidad de que la variable media muestral sea mayor o igual que el valor de la poblacional:

# Probabilidad de que la media muestral sea mayor o igual que la poblacional:
grados_libertad <- length(muestra_aleat$Purchase) - 1
prob_purch <- 1 - pt((media_muest - media_pob) / (desv_muest / sqrt(length(muestra_aleat$Purchase))), df = grados_libertad)

cat("Probabilidad de que la media muestral sea mayor o igual que la media poblacional:", prob_purch, "\n")

## Probabilidad de que la media muestral sea mayor o igual que la media poblacional: 0.9300881

Se calcula el sesgo y la curtosis de esta variable:

library(moments)
curt_purch <- kurtosis(muestra_aleat$Purchase)
print(paste("La curtosis de los datos del valor de la compra es:", round(curt_purch, 2)))

## [1] "La curtosis de los datos del valor de la compra es: 2.76"

Este valor obtenido indica que los datos del valor de la compra tienen curtosis positiva, es decir que la distribución es leptocúrtica; los valores tienden a estar más concentrados alrededor de la media.

asim_purch <- skewness(muestra_aleat$Purchase)
print(paste("La asimetría de los datos del valor de la compra es:", round(asim_purch, 2)))

## [1] "La asimetría de los datos del valor de la compra es: -0.03"

Por otro lado, un valor de asimetría de 0.68 implica que hay una asimetría positiva moderada en la distribución, con una cola derecha más pronunciada.

Evaluación de distribución normal

Para trabajar con las hipótesis, se utilizan herramientas que aprovechan las características intrínsecas de una distribución normal para evaluar la probabilidad de las mismas, por lo que en principio se debe hacer un test para saber la probabilidad de que la distribución de nuestra muestra es normal, en caso de que el resultado no sea concluyente, podríamos aumentar el tamaño de la muestra antes de descartar una distribución normal

Método ad.test

library(nortest)
ad.test(muestra_aleat$Purchase)

## 
##  Anderson-Darling normality test
## 
## data:  muestra_aleat$Purchase
## A = 0.14058, p-value = 0.9728

El test de Anderson-Darling evalúa si una muestra dada proviene de una distribución normal. para este caso, al realizar el test con el conjunto de datos muestra_aleat$Purchase, el valor p es de 0.9728.

En términos generales, cuando se realiza una prueba de normalidad, el valor p proporciona una medida de la evidencia en contra de la hipótesis nula. En este caso, con un valor p de 0.9728, que es mayor que el nivel de significancia que asumiremos de 0.05, no tenemos suficiente evidencia para rechazar la hipótesis nula. Por lo tanto, no hay suficiente evidencia para concluir que los datos NO provienen de una distribución normal.

Sin embargo, las pruebas de normalidad no son definitivas y deben usarse junto con métodos gráficos y consideraciones adicionales para evaluar la normalidad de los datos. Es posible que aunque el test no rechace la hipótesis nula, aún puedan existir desviaciones de la normalidad en los datos. Por ello se complementaron estas pruebas con análisis gráficos para tomar decisiones más sólidas sobre la normalidad de la distribución.

Análisis gráfico

Gráfico de cuartiles normales

# Q-Q plot para evaluar la normalidad de los datos
qqnorm(muestra_aleat$Purchase)
qqline(muestra_aleat$Purchase)

Para evaluar la normalidad de la muestra de datos proporcionada muestra_aleat$Purchase, se utilizó un gráfico Q-Q. Este gráfico compara los cuantiles de la muestra con los cuantiles teóricos de una distribución normal, facilitando la visualización de la adecuación de los datos a una distribución normal.

El gráfico Q-Q generado reveló una relación lineal bastante definida entre los cuantiles teóricos de una distribución normal y los cuantiles de la muestra de datos. Los puntos en el gráfico se alinearon notablemente cerca de la línea diagonal trazada a través de los cuantiles teóricos, indicando una correspondencia significativa entre la distribución de los datos y una distribución normal. Esta alineación sugiere que los datos podrían seguir una distribución normal.

Histograma

# Calcular la media de los datos
media <- mean(muestra_aleat$Purchase)

# Calcular el número de intervalos según la regla de Sturges
n <- length(muestra_aleat$Purchase)
k_sturges <- 1 + log2(n)

# Crear el histograma con el número de intervalos calculado por la regla de Sturges
hist(muestra_aleat$Purchase, breaks = k_sturges, col = "skyblue", border = "black",
     xlab = "Valores", ylab = "Frecuencia", main = "Histograma de gastos")

# Agregar una línea vertical en la media de los datos
abline(v = media, col = "red", lwd = 2)

Se realizó una evaluación visual de la normalidad de los datos utilizando un histograma. La muestra de datos presentaba una tendencia marcada en forma de campana en el histograma, lo que sugiere una distribución que se asemeja a una distribución normal. Además, el número de intervalos utilizado en el histograma se calculó mediante la regla de Sturges.

La forma de campana observada en el histograma indica una distribución simétrica alrededor de la media, lo cual es una característica común en distribuciones normales. Esta simetría sugiere que los datos podrían seguir una distribución normal, ya que la forma del histograma se asemeja a la típica distribución de campana de una distribución gaussiana.

Actividad 2

Problema A

Una vez chequeado el supuesto de normalidad, se puede usar la función t.test sobre la variable de interés para construir el intervalo de confianza:

result_ttest <- t.test(x=muestra_aleat$Purchase, conf.level = 0.90)
result_ttest$conf.int

## [1] 7923.209 9594.657
## attr(,"conf.level")
## [1] 0.9

A partir del resultado obtenido se puede concluir, con un nivel de confianza del 90 %, que el valor promedio de compra en el Black Friday en Estados Unidos en la muestra estudiada se encuentra entre 7923.209 y 9594.657 dólares.

Ahora, se verifica si la media poblacional cae dentro del intervalo de confianza:

if (media_pob >= result_ttest$conf.int[1] & media_pob <= result_ttest$conf.int[2]) {
  cat("La media poblacional cae dentro del intervalo de confianza.\n")
} else {
  cat("La media poblacional NO cae dentro del intervalo de confianza.\n")
}

## La media poblacional cae dentro del intervalo de confianza.

Como la media poblacional está dentro del intervalo de confianza, no tenemos evidencia suficiente para afirmar que la verdadera media poblacional es diferente de la media muestral observada. No se rechaza entonces la hipótesis nula.

Problema B

Construya un intervalo de confianza al noventa y cinco por ciento para la proporción de ventas superiores a US$5.000. Escriba la interpretación en el contexto del caso. Compruebe si la proporción poblacional está en este intervalo.

Análisis teórico

El cálculo del intervalo de confianza para la proporción muestral se basa en la distribución muestral de la proporción muestral, que se aproxima a una distribución normal cuando el tamaño de la muestra es suficientemente grande, según el teorema del límite central. La fórmula utilizada comúnmente para calcular el intervalo de confianza para la proporción muestral es la fórmula de intervalo de confianza de Wald o intervalo de confianza de Wilson.

La fórmula del intervalo de confianza de Wald es: \[\begin{align*} \hat{p} \pm z_{\alpha/2} \times \sqrt{\frac{\hat{p}(1 - \hat{p})}{n}} \end{align*}\] donde: - [$\hat{p}$] es la proporción muestral. - [$z_{\alpha/2}$] es el valor crítico de la distribución normal estándar para el nivel de confianza [$\alpha$]. - [$n$] es el tamaño de la muestra.

Esta fórmula se deriva utilizando el teorema del límite central para aproximar la distribución binomial de la proporción muestral a una distribución normal cuando el tamaño de la muestra es grande.

Sin embargo, la fórmula de Wilson es una mejora de la fórmula de Wald y proporciona intervalos de confianza más precisos, especialmente para tamaños de muestra más pequeños. Esta fórmula de intervalo de confianza de Wilson ajusta la fórmula de Wald mediante la adición de un término de corrección:

\[\begin{align*} \hat{p} \pm z_{\alpha/2} \times \sqrt{\frac{\hat{p}(1 - \hat{p})}{n} + \frac{z_{\alpha/2}^2}{4n}} \end{align*}\]

Esta corrección mejora la precisión del intervalo de confianza, especialmente cuando la proporción muestral se acerca a 0 o 1, o cuando el tamaño de la muestra es pequeño.

Método binom.test

# Supongamos que 'muestra_aleat$Purchase' contiene los datos de ventas

# Contar la cantidad de ventas superiores a US$5,000
x <- sum(muestra_aleat$Purchase > 5000)

# Obtener el tamaño total de la muestra
n <- length(muestra_aleat$Purchase)

# Calcular el intervalo de confianza del 95% para la proporción de ventas superiores a US$5,000
intervalo_confianza_binom <- binom.test(x = x, n = n, conf.level = 0.95, alternative = "greater")

# Mostrar el intervalo de confianza
intervalo_confianza_binom

## 
##  Exact binomial test
## 
## data:  x and n
## number of successes = 93, number of trials = 120, p-value = 5.565e-10
## alternative hypothesis: true probability of success is greater than 0.5
## 95 percent confidence interval:
##  0.7033225 1.0000000
## sample estimates:
## probability of success 
##                  0.775

Cálculo manual

# Datos dados
proporcion_muestral <- x / n
nivel_confianza <- 0.95

# Valor crítico z para un nivel de confianza del 95%
z <- qnorm(1 - (1 - nivel_confianza) / 2)

# Cálculo del margen de error
margen_error_manual <- z * sqrt((proporcion_muestral * (1 - proporcion_muestral) / n))

# Cálculo del intervalo de confianza manualmente
limite_inferior_manual <- proporcion_muestral - margen_error_manual
limite_superior_manual <- proporcion_muestral + margen_error_manual

# Mostrar el intervalo de confianza manual
c(limite_inferior_manual, limite_superior_manual)

## [1] 0.7002864 0.8497136

En el código proporcionado anteriormente, se utilizó la fórmula del intervalo de confianza de Wald para calcular manualmente el intervalo de confianza para la proporción muestral de ventas superiores a US$5,000, utilizando el nivel de confianza del 95% y el valor crítico de la distribución normal estándar [$z_{\alpha/2}$].

En el contexto de R, el cálculo manual de estos intervalos se puede realizar de la siguiente manera:

\[\begin{align*} \text{# Datos dados} & = {n} \\ \text{proporcion_muestral} & = \frac{x}{n} \\ \text{nivel_confianza} & = 0.95 \\ z & = \text{qnorm}\left(1 - \frac{1 - \text{nivel_confianza}}{2}\right) \\ \text{margen_error_manual} & = z \times \sqrt{\frac{\text{proporcion_muestral} \times (1 - \text{proporcion_muestral})}{n}} \\ \text{limite_inferior_manual} & = \text{proporcion_muestral} - \text{margen_error_manual} \\ \text{limite_superior_manual} & = \text{proporcion_muestral} + \text{margen_error_manual} \\ \text{Mostrar el intervalo de confianza manual} & : \left[\text{limite_inferior_manual}, \text{limite_superior_manual}\right] \end{align*}\]

Intervalos

install.packages("kableExtra")
library(kableExtra)

datos_tabla <- data.frame(
  Método = c("Test Binomial", "Cálculo Manual", ""),
  Límite_Inferior = c(0.7033225, 0.7002864, ""),
  Límite_Superior = c(1.0000000, 0.8497136, "")
)

tabla <- datos_tabla %>%
  kbl(col.names = c("Método", "Límite Inferior", "Límite Superior"), align = "c") %>%
  kable_styling(full_width = F)

tabla

Método	Límite Inferior	Límite Superior
Test Binomial	0.7033225	1
Cálculo Manual	0.7002864	0.8497136

Conclusión

El intervalo de confianza del 95% para la proporción de ventas superiores a US$5,000 en el test binomial es de 0.7033225 a 1.0000000. No obstante, es importante destacar que el límite superior del intervalo es una estimación teórica del máximo límite superior, pero posiblemente no una representación realista de la proporción de ventas.

El método utilizado para el cálculo manual proporciona un límite superior más lógico, ofreciendo una estimación práctica que se sitúa en 0.8497136. Esta discrepancia en los límites superiores puede atribuirse a las diferencias en los enfoques y fórmulas utilizadas por cada método. Mientras que el test binomial puede proporcionar un límite superior teórico basado en la distribución de probabilidad, el cálculo manual ofrece un límite superior más realista.

Proporcion muestral

# Calcular la proporción muestral
ventas_superiores_5000 <- sum(muestra_aleat$Purchase > 5000)
proporcion_muestral <- ventas_superiores_5000 / length(muestra_aleat$Purchase)

# Mostrar la proporción muestral
cat("La proporción muestral es de ",proporcion_muestral)

## La proporción muestral es de  0.775

# Verificación si la proporción muestral está dentro del intervalo de confianza
esta_dentro_intervalo <- proporcion_muestral >= limite_inferior_manual &
  proporcion_muestral <= limite_superior_manual

# Mostrar el resultado
if(esta_dentro_intervalo == TRUE){
  cat("\nPor lo tanto, esta si se encuentra dentro de los intervalos de confianza calculados con ambos métodos")
}

## 
## Por lo tanto, esta si se encuentra dentro de los intervalos de confianza calculados con ambos métodos

La proporción muestral calculada a partir de los datos proporcionados se encuentra dentro del intervalo de confianza del 95%. Esta coincidencia sugiere que la estimación de la proporción de ventas superiores a US$5,000, basada en la muestra analizada, es coherente con el rango estimado por el intervalo de confianza. En otras palabras, la proporción de ventas calculada a partir de la muestra se alinea con las expectativas establecidas por el intervalo de confianza, lo que respalda la validez y precisión de la estimación realizada sobre la proporción poblacional de ventas superiores a US$5,000.

Problema C

En este subindice de la actividad 2, se examina las diferencias en las compras realizadas por hombres y mujeres durante el Black Friday a partir de nuestra base de datos.

El objetivo de construir este intervalo de confianza es proporcionar un rango estimado en el cual podría encontrarse la verdadera diferencia de medias entre las compras de hombres y mujeres en la población

Lo primero que hacemos es filtrar las compras hechas por hombres y mujeres. Posteriormente se calcula la diferencia de medias de entre ambos grupos. Asi como el error estandar de las diferencias de medias.

compras_hombres <- BlackFriday$Purchase[BlackFriday$Gender == "M"]
compras_mujeres <- BlackFriday$Purchase[BlackFriday$Gender == "F"]

diferencia_medias <- mean(compras_hombres) - mean(compras_mujeres)

error_estandar <- sqrt(var(compras_hombres)/length(compras_hombres) + var(compras_mujeres)/length(compras_mujeres))

Calculamos el valor crítico t para un intervalo de confianza del 90%, y por ultimo calculamos el intervalo de confianza

valor_critico_t <- qt(0.95, df = length(compras_hombres) + length(compras_mujeres) - 2)
intervalo_confianza <- c(diferencia_medias - valor_critico_t * error_estandar,
                         diferencia_medias + valor_critico_t * error_estandar)
cat("Intervalo de confianza al 90% para la diferencia de medias:", intervalo_confianza, "\n")

## Intervalo de confianza al 90% para la diferencia de medias: -85.31859 89.62922

El intervalo de confianza del 90% para la diferencia de medias de las compras entre hombres y mujeres es amplio, abarcando valores negativos y positivos, lo que sugiere una variabilidad considerable en la estimación de la diferencia.

library(ggplot2)

Creamos un dataframe con los resultados para poder observar graficamente los datos obtenidos.

resultados <- data.frame(
  Grupo = c("Diferencia de Medias"),
  Valor = c(diferencia_medias),
  Inferior = c(intervalo_confianza[1]),
  Superior = c(intervalo_confianza[2])
)
ggplot(resultados, aes(x = Grupo, y = Valor)) +
  geom_bar(stat = "identity", fill = "skyblue", alpha = 0.7) +
  geom_errorbar(aes(ymin = Inferior, ymax = Superior), width = 0.3, color = "red", size = 1.5) +
  labs(title = "Diferencia de Medias con Intervalo de Confianza del 90%",
       y = "Diferencia de Medias",
       caption = "Intervalo de Confianza del 90%",
       x = "") +
  theme_minimal()

La altura de la barra representa la diferencia de medias y las líneas de error representan el intervalo de confianza del 90%. En este caso la linea de error se mantiene sobre cero lo que nos indica que que el intervalo de confianza abarca valores tanto positivos como negativos de la diferencia de medias.

Problema D

Para esta actividad construimos el intervalo de confianza para la varianza en las compras de las mujeres. Lo primero que hacemos es filtrar las compras realizadas por mujeres y se calcula la varianza muestral de estas compras. Luego, se determina el intervalo de confianza para la varianza.

compras_mujeres <- BlackFriday$Purchase[BlackFriday$Gender == "F"]
n_mujeres <- length(compras_mujeres)
grados_libertad <- n_mujeres - 1

varianza_muestral <- var(compras_mujeres)


intervalo_confianza_varianza <- c((n_mujeres - 1) * varianza_muestral / qchisq(0.95, df = grados_libertad),
                                  (n_mujeres - 1) * varianza_muestral / qchisq(0.05, df = grados_libertad))

cat("Intervalo de confianza para la varianza de las compras de mujeres:", intervalo_confianza_varianza, "\n")

## Intervalo de confianza para la varianza de las compras de mujeres: 24621307 25699257

El intervalo de confianza para la varianza de las compras de mujeres es de 24621,307 a 25699,257. Esto significa que se estima que la verdadera varianza de las compras de mujeres se encuentra dentro de este rango.

Observaremos graficamente el resultado graficamente

resultados_varianza <- data.frame(
  Varianza = varianza_muestral,
  Inferior = intervalo_confianza_varianza[1],
  Superior = intervalo_confianza_varianza[2]
)

ggplot(resultados_varianza, aes(x = 1, y = Varianza)) +
  geom_bar(stat = "identity", fill = "skyblue", alpha = 0.7) +
  geom_errorbar(ymin = resultados_varianza$Inferior, ymax = resultados_varianza$Superior,
                width = 0.2, color = "red", size = 1.5) +
  labs(title = "Varianza de Compras de Mujeres",
       y = "Varianza Muestral",
       caption = "Intervalo de Confianza del 99%",
       x = "") +
  theme_minimal()

La representación gráfica de la varianza muestral y las líneas de error sugiere cierta incertidumbre en la precisión de la estimación puntual. La varianza muestral calculada se encuentra dentro del intervalo de confianza, pero la extensión de las líneas de error indica que hay variabilidad y posiblemente limitaciones en la cantidad de datos disponibles.

Actividad 3

Problema A

library(nortest)
library(car)

## Warning: package 'car' was built under R version 4.3.2

## Loading required package: carData

## Warning: package 'carData' was built under R version 4.3.2

library(kableExtra)

El objetivo en este caso es comprobar si la media de la muestra es comprobar si la media de la muestra escogida para los valores de “Purchase” o ventas es mayor que el valor de la media de la población o para todos los datos.

Para hacer una prueba de hipotesis para la media $\mu$ de la muestra tomada de purchase es necesario analizar la normalidad de la distribución de los datos, en este caso se aplicará una prueba de normalidad de Anderson-Darling y una prueba Shapiro-Wilk, en ambos casos con un nivel de significancia del 3%, si la prueba resulta mayor al nivel de significancia entonces se rechaza la posibilidad de que la muestra provenga de una pobalción normal.

A continuación se presenta en una tabla los valores p de cada una de las pruebas:

AD_test <- ad.test(muestra_aleat$Purchase)$p
SW_test <- shapiro.test(muestra_aleat$Purchase)$p

t_testPurchase <- data.frame(AdersonDarling = AD_test, shapiroWilK = SW_test)

tabla_normPurchase <- kable(t_testPurchase, caption = "Valor P, Normalidad de Ventas", format = "markdown", align = 'cccccc', digits = 3) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE)

## Warning in kable_styling(., bootstrap_options = "striped", full_width = FALSE,
## : Please specify format in kable. kableExtra can customize either HTML or LaTeX
## outputs. See https://haozhu233.github.io/kableExtra/ for details.

## Warning in row_spec(., 0, bold = TRUE): Please specify format in kable.
## kableExtra can customize either HTML or LaTeX outputs. See
## https://haozhu233.github.io/kableExtra/ for details.

tabla_normPurchase

Valor P, Normalidad de Ventas
AdersonDarling	shapiroWilK
0.973	0.956

Como se aprecia en la tasbla, ambos valores son mayores al 3%, por lo que se rechaza la posibilidad de que la muestra no provenga de una normal.

Ahora, realizaremos un grafico qqplot con bandas de confianza del paquete (Car)

qqPlot(x = muestra_aleat$Purchase, pch=20, ylab = "Ventas($)", main= "qqplot para purchase")

## [1] 37 67

Una vez comprobada la normalidad de la muestra, planteamos las hipótesis correpondientes a la prueba: \[H_0: \mu=9508.269 \$ \] $$H_A: > 9508.269 $ $$

Para realizar la prueba de hipotesis, tendremos en cuenta los siguientes valores: Un intervalo de confianza del 95%, Un valor $\alpha$ del 5%, Un valor de Poblacional de 9344.566$

Se realiza una prueba t de student(t.test) la cual se basa en el estadistico t, el cual se calculo con la siguiente expresión\[t=\frac{\bar{x}-\mu_0}{s/\sqrt{n}}\]

cat(t.test(muestra_aleat$Purchase, alternative="greater", conf.level=0.95, mu=media_pob)$p.value)

## 0.9300881

En este caso el valor P es mayor al valor $\alpha$ o nivel de significancia, por lo que no se rechaza la hipótesis nula, es decir, las evidencias no son suficientes para afirmar que la media poblacional es mayor que el valor real encontrado en la población.

Problema B

El objetivo de este problema es el de observar si existe alguna diferencia entre las compras realizados por los hombres y las mujeres.

En este caso no es necesario analizar la normalidad de las muestras, ya que provienen de la misma analizada en el problema anterior.

Para separar los datos entre las compras de los hombres y mujeres utilizaremos la libreria dplyr

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following object is masked from 'package:car':
## 
##     recode

## The following object is masked from 'package:kableExtra':
## 
##     group_rows

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

muestraF <- muestra_aleat %>% filter(Gender != "F")
muestraM <- muestra_aleat %>% filter(Gender != "M")

media_M <- mean(x=muestraM$Purchase, na.rm = FALSE)
media_F <- mean(x=muestraF$Purchase, na.rm = FALSE)

Sin embargo, para realizar la prueba de hipotesis para la diferenica de medias es necesario tener en cuentas las varianzas de cada una de las muestras, por lo que veremos la cercania de estas

varianza_muestraM <- var(muestraM$Purchase, na.rm = TRUE)
varianza_muestraF <- var(muestraF$Purchase, na.rm = TRUE)
dif_var <- abs(varianza_muestraM-varianza_muestraF)
dif_varrel <- dif_var/((varianza_muestraM+varianza_muestraF)/2)*100

t_var3B <- data.frame(VarianzaHombres = varianza_muestraM, VarianzaMujeres = varianza_muestraF, Diferencia = dif_var, "Diferencia Relativa Porcentual" = dif_varrel)

tabla_var3B <- kable(t_var3B, caption = "Valores de varianza y diferencia de varianzas", format = "markdown", align = 'cccccc', digits = 3) %>%
  kable_styling(bootstrap_options = "striped", full_width = FALSE, position = "center") %>%
  row_spec(0, bold = TRUE)

## Warning in kable_styling(., bootstrap_options = "striped", full_width = FALSE,
## : Please specify format in kable. kableExtra can customize either HTML or LaTeX
## outputs. See https://haozhu233.github.io/kableExtra/ for details.

## Warning in row_spec(., 0, bold = TRUE): Please specify format in kable.
## kableExtra can customize either HTML or LaTeX outputs. See
## https://haozhu233.github.io/kableExtra/ for details.

tabla_var3B

Valores de varianza y diferencia de varianzas
VarianzaHombres	VarianzaMujeres	Diferencia	Diferencia.Relativa.Porcentual
36813042	29487187	7325855	22.099

Como se puede ver tenemos una diferencia de alrededor de 22%. Por lo que podremos realizar una prueba en la que se tenga varianzas diferentes

Ahora se realizara un grafica de bosplot para observar se cercania entra las medias.

Punto3_b <- data.frame(valor=c(muestraM$Purchase, muestraF$Purchase), 
                       genero= rep(c("M", "F"), times = c(101, 19)))

boxplot(valor ~ genero, data=Punto3_b, las=1,
        xlab='Genero', ylab='Valor de la compra')

Se observa que las cajas de los boxplot se traslapan, esto es un indicio de que las medias poblacionales, son cercanas, se observa también que el boxplot para del valor de la compra de las mujeres esta por encima del de los hombres además de ser más amplio.

Finalmente realizaremos la prueba para la diferencia de 2 medias. Primero teniendo en cuenta que la varianzas son diferentes y luego suponiendo que las varianzas son iguales.

En este caso tenemos las siguientes hipotesis \[H_0:\mu_H - \mu_M = 0 \] \[H_A:\mu_H - \mu_M \neq 0 \]

t.test(x=muestraM$Purchase, y=muestraF$Purchase, alternative="two.sided", mu=0, 
       paired=FALSE, var.equal=TRUE, conf.level=0.95)$p.value

## [1] 0.4465832

t.test(x=muestraM$Purchase, y=muestraF$Purchase, alternative="two.sided", mu=0, 
       paired=FALSE, var.equal=FALSE, conf.level=0.95)$p.value

## [1] 0.4861159

Para ambos casos se tuvo un valor de significancia del 5% y intervalo de confianza del 95% Como el valor p en ambos casos es mayor al 5% se rechaza la hipotesis alternativa.

Se concluye finalmente que entre las medias muestrales de las compras realizadas por hombres y mujeres no existe una diferencia significativa.

Problema C

En este se requiere realizar un intervalo de confianza para el conciente de varianzas de las compras de los hombres y las mujeres.

Para este caso es necesario revisar la normalidad de las muestras, sin embargo como la muestra proviene de otra muestra normal, se supone normal este muestra también.

Utilizamos las funciones del paquete stats

library(devtools)

## Warning: package 'devtools' was built under R version 4.3.2

## Loading required package: usethis

## Warning: package 'usethis' was built under R version 4.3.2

int1 <- stats::var.test(x=muestraM$Purchase, y=muestraF$Purchase, conf.level=0.95)

Como se puede observar el intervalo encontrado se encuetra al rededor de 1, por lo que podemos concluir que las varianzas de los hombres y las mujeres son iguales, o que \[\sigma_{hombres}^2 = \sigma_{mujeres}^2\]

Problema D

Finalmete veremos más a fondo si las variazas entre las compras de los hombres y las mujeres se puede considerar como igual o no. Teniendo esto en cuenta, entonces el cociente entre las varianzas debe ser igual a 1, por lo que definimos las siguientes hipotesis. \[H_0: \frac{\sigma_{hombres}^2}{\sigma_{mujeres}^2}= 0\] \[H_A: \frac{\sigma_{hombres}^2}{\sigma_{mujeres}^2} \neq 0\] ahora revisamos si las muestras provienen de una distribución normal por lo que se realizan lso siguientes qqplots que se muestran a continuación:

qM <- qqnorm(muestraM$Purchase, plot.it=FALSE)
qF <- qqnorm(muestraF$Purchase, plot.it=FALSE)
plot(range(qM$x, qF$x), range(qM$y, qF$y), type="n", las=1,
     xlab='Cuantiles teóricos', ylab='
     Cuantiles de la muestra')
points(qM, pch=19)
points(qF, col="red", pch=19)
qqline(muestraM$Purchase, col = "black" ,lty='dashed')
qqline(muestraF$Purchase, col="red", lty="dashed")
legend('topleft', legend=c('M', 'H'), bty='n',
       col=c('black', 'red'), pch=19)

Se observa que los puntos se agrupan principalmente sobre la linea. Se realiza ahora un test de normalidad de Kolmogorov-Smirnov y un test de Shapiro-Wilk

lillie.test(muestraM$Purchase)$p.value

## [1] 0.8208662

lillie.test(muestraF$Purchase)$p.value

## [1] 0.8667051

shapiro.test(muestraM$Purchase)$p.value

## [1] 0.9334835

shapiro.test(muestraF$Purchase)$p.value

## [1] 0.9759608

Para cada una de las pruebas encontramos valores superiores al nivel de significancia, confirmando que las muestras provienen de una muestra normal como se suponia desde el comienzo.

Finalmente se realiza la prueba de cociente de varianzas, teniedno como base un nivel de significancia$\alpha$ de 5%

stats::var.test(x=muestraM$Purchase, y=muestraF$Purchase, null.value=1, 
                alternative="two.sided",
                conf.level=0.95)$p.value

## [1] 0.4782927

Se encuentra que el valor p de la prueba es mucho mayor que el nivel de significancia, por lo que se no se rechaza la hipótesis nula.

Se concluye fianlmente que las varianzas son iguales, dandonos a enterder que las dsitribuciones de los gastos en hombres y mujeres se reparten igualmente en precios.

Parcial 4

Probabilidad y Estadística

Valentina Camacho Anacona (vcamachoa@unal.edu.co) Jose Miguel Sánchez Vargas (jossanchezva@unal.edu.co) Joan Salvador Esteban Barrios(jestebanb@unal.edu.co) Nicolas David Ortiz Gomez (niortizg@unal.edu.co) Daniel Esteban Contrerar Rodríguez (dacontrerasr@unal.edu.co)

2023-11-27

Introducción

Actividad 1

Género

Categoría de ciudad

Ingreso

Purchase: Valor de la compra

Evaluación de distribución normal

Método ad.test

Análisis gráfico

Gráfico de cuartiles normales

Histograma

Actividad 2

Problema A

Problema B

Análisis teórico

Método binom.test

Cálculo manual

Intervalos

Conclusión

Proporcion muestral

Problema C

Problema D

Actividad 3

Problema A

Problema B

Problema C

Problema D