El objetivo de este trabajo es realizar un análisis de inferencia estadística básica a la base de datos ‘BlackFriday’. Cumpliendo con actividades propuestas de manera teórica, práctica e ilustrando cada una con gráficos que ayuden a comprender el trabajo realizado, además de explicar a que se refiere cada resultado.

Actividad 1

a) Muestra

A continuación, la semilla utilizada para la selección de la muestra fue la correspondiente a los últimos dígitos de cada uno de los números de cédula de los miembros del grupo. Además, cargando los datos:

## ! Using an auto-discovered, cached token.

##   To suppress this message, modify your code or options to clearly consent to
##   the use of a cached token.

##   See gargle's "Non-interactive auth" vignette for more details:

##   <https://gargle.r-lib.org/articles/non-interactive-auth.html>

## ℹ The googlesheets4 package is using a cached token for 'mgarnica@unal.edu.co'.

## ✔ Reading from "Blackfriday".

## ✔ Range 'Datos'.

## [1] "otra opción de cargar datos con file.choose, nombrar datos, cargar datos"

b) Realizando un análisis descriptivo para las variables “Gender”, “City_Category” e “Income”

Se puede observar que las variables a analizar “Gender” y “City_Category” son de carácter cualitativo . Mientras que “Income” es de carácter numérico.

Género(Gender)

Esta variable nos indica el genero de quien realizó la compra en el Blackfriday

ggplot(muestra2, aes(x = Gender)) +
  geom_bar(fill = "skyblue", color = "black", alpha = 1.2) +
  labs(title = "Histograma de Genero", x = "Género", y = "Frecuencia")

Se puede observar que en la muestra se encuentran mas hombres que mujeres, siendo el 67,5% del género masculino mientras que del género femenino se encuentra el 32,5% del total de la muestra.

Categoria de la ciudad(City_Category)

En está variable encontramos la descripción de categoría de la ciudad donde el comprador reside. Una ciudad puede ser de categoría A,B o C.

Se construyó una tabla donde se indica la categoría de la ciudad y la proporción de dicha con relación a la muestra.

Ciudad <- prop.table(table(muestra2$City_Category))
Ciudad <- as.data.frame(Ciudad)
colnames(Ciudad) <- c("City_Category", "Proporción")
Ciudad

En el siguiente gráfico podemos observar la proporción de la categoria de ciudad de cada comprador con relación a la muestra que se tiene.

ggplot(Ciudad, aes(x = "", y = Proporción, fill = City_Category )) +
  geom_col(color = "black") +
  geom_text(aes(label = round(Proporción*100,1) ),
            position = position_stack(vjust = 0.5)) +
  coord_polar(theta = "y") +
  scale_fill_brewer()

Con ayuda de este gráfico se puede evidenciar que en la ciudad tipo B es donde hay mayor cantidad de compradores de la muestra, residen en un 43.3% del total. Mientras que en las ciudades tipo A y C residen un 29.2% y 27.5% respectivamente.

Ingreso mensual (Income)

En esta variable se encuentra el ingreso mensual de cada uno de los individuos de la muestra que participaron en el Blackfriday que se realiza en Estados Unidos.

summary(muestra2$Income)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    7238   10931   12462   12765   14593   19288

sd(muestra2$Income)

## [1] 2609.288

var(muestra2$Income)

## [1] 6808382

ggplot(muestra2, aes(x = 0, y = Income,)) + 
  geom_boxplot(fill="palegreen2")

19288-7238

## [1] 12050

Con ayuda de este resumen y del boxplot se puede evidenciar varias características de esta variable de la población:

El ingreso mensual mínimo que se encontró en la muestra es de 7238, mientras que el máximo es de 19288.
El ingreso mensual al que mas se acercan los individuos es 12765.
La desviación estándar de la muestra es de 2609.29, la cual nos brinda la variabilidad existente en los datos.
Se puede observar que el 50% de los ingresos mensuales de los individuos de la muestra se encuentra concentrado aproximadamente entre 10900 y 14600.

c) Variable Purchase

La variable “Purchase” describe el valor de la compra en dolares realizada por el individuo. En este caso nos pide hallar el valor de la media y de la desviación estándar tanto muestral como poblacionalmente. Debido a que tenemos la información tanto de la población como de la muestra obtenida, se puede ver lo siguiente:

round(mean(datosB$Purchase),2)

## [1] 9508.26

round(sd(datosB$Purchase),2)

## [1] 5001.66

round(mean(muestra2$Purchase),2)

## [1] 9250.68

round(sd(muestra2$Purchase),2)

## [1] 4635.55

# Probabilidad de que la media muestral sea mayor o igual que la poblacional
probabilidad_1_d <- pnorm(9250.68, mean = 9508.26, sd = 4635.55, lower.tail = FALSE)
probabilidad_1_d

## [1] 0.5221563

La media poblacional de la variable Purchase es: 9508.26, siendo este el valor hacia donde tienden los datos de los datos poblacionales.
La media muestral de la variable Purchase es: 9250.68, siendo este el valor hacia donde tienden los datos de los datos muestrales.
La desviación estándar de la población es: 5001.66, que indica la variabilidad de los datos.
La desviación estándar de la muestra es: 4635.55, variabilidad de los datos.
La probabilidad de que la media muestral sea mayor o igual que la poblacional es de: 52.2%

d) Histograma variable Purchase

Con ayuda del histograma se puede ver comportamiento de la variable, además con ayuda del sesgo y la curtosis podemos concluir otras características de la misma relacionadas a si la variable tiene distribución normal o no.

summary(muestra2$Purchase)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   -2444    5747    9685    9251   12402   23130

hist(muestra2$Purchase, col = "red", border = "black", main = "Histograma de Purchase", xlab = "Purchase", ylab = "Frecuencia")

par(mfrow=c(1, 2))

## [1] -0.05609564

## [1] -0.05699989

Gráficamente parece que los datos tienden a tener un leve sesgo negativo. Luego, mediante el sesgo y la curtosis se confirma que tiene un leve sesgo negativo (o a la izquierda), debido a que este valor es negativo. Sin embargo, al ser tan leve haremos una prueba más exhaustiva.

#QQplot
require(car)
qqPlot(muestra2$Purchase, pch=19,
       main='QQplot para Purchase',
       xlab='Cuantiles teóricos',
       ylab='Cuantiles muestrales')

## [1] 116  48

Mediante un QQplot podemos observar que en realidad se sigue una distribución normal por la manera en la que los datos se recogen en el mismo.

Actividad 2

En base de la muestra tomada para actividad 1 tenemos que

a) Intervalo de confianza al 90% para el promedio de la variable Purchase

Sabiendo que la variable Purchase se comporta con una distribución normal, entonces se tiene que

# Intervalo de confianza al 90% para la media de PURCHASE
intervalo_confianza_2_a <- t.test(muestra2$Purchase, conf.level = 0.90)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 90% para la media de PURCHASE: [", intervalo_confianza_2_a[1], ",", intervalo_confianza_2_a[2], "]\n")

## Intervalo de confianza del 90% para la media de PURCHASE: [ 8549.177 , 9952.19 ]

Luego, se concluye que la media poblacional (9508.26) está dentro del intervalo con un nivel de confianza del 90%. Esto significa que, en promedio, los compradores gastaron entre 8549 y 9952 dólares en el Blackfriday. Es decir, la media poblacional es correcta.

b) Intervalo de confianza al 95% para la proporción de ventas

Teniendo en cuenta que la muestra es de 120 individuos que compraron en el Blackfriday, se sigue que

# Crear una variable indicadora para ventas superiores a US$5,000
muestra2$Venta_Superior_5000 <- ifelse(muestra2$Purchase > 5000, 1, 0)
sum(muestra2$Venta_Superior_5000)

## [1] 99

99/120

## [1] 0.825

Hay 99 individuos que hicieron compras superiores a 5000. Luego, hallando su proporción, tenemos que esta es de 82.5%

# Intervalo de confianza al 95% para la proporción de ventas superiores a US$5,000
proporcion_intervalo_confianza <- prop.test(99, 120, conf.level =0.95)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 95% para la proporción de ventas superiores a US$5,000: [", proporcion_intervalo_confianza[1], ",", proporcion_intervalo_confianza[2], "]\n")

## Intervalo de confianza del 95% para la proporción de ventas superiores a US$5,000: [ 0.7426105 , 0.886024 ]

Concluyendo así que la proporción esta dentro del intervalo del 95% de confianza. En donde, se puede decir que las compras hechas en el Blackfriday que superan los 5000 dólares están entre un 74% a un 88% aproximadamente.

c) Intervalo de confianza al 90% para la diferencias de medias para compras hechas por hombres y mujeres

Analizando si la variable género, en especifico las categorías masculino y femenino siguen una distribución normal, tenemos que

# Separar la muestra en hombres y mujeres
muestra_hombres <- muestra2[muestra2$Gender == "M", ]
muestra_mujeres <- muestra2[muestra2$Gender == "F", ]
hist(muestra_hombres$Purchase)

hist(muestra_mujeres$Purchase)

#QQplot
require(car)
qqPlot(muestra_hombres$Purchase, pch=19,
       main='QQplot para hombres',
       xlab='Cuantiles teóricos',
       ylab='Cuantiles muestrales')

## [1] 79 33

require(car)
qqPlot(muestra_mujeres$Purchase, pch=19,
       main='QQplot para mujeres',
       xlab='Cuantiles teóricos',
       ylab='Cuantiles muestrales')

## [1] 22 28

Las compras hechas por hombres y mujeres siguen una distribución normal. Así, hallando intervalos de confianza

rest <- mean(muestra_hombres$Purchase)-mean(muestra_mujeres$Purchase)
rest

## [1] 358.4292

# Intervalo de confianza al 90% para la diferencia de medias
intervalo_diferencia_medias <- t.test(muestra_hombres$Purchase, muestra_mujeres$Purchase, paired=FALSE, var.equal=TRUE, conf.level = 0.90)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 90% para la diferencia de medias entre hombres y mujeres: [", intervalo_diferencia_medias[1], ",", intervalo_diferencia_medias[2], "]\n")

## Intervalo de confianza del 90% para la diferencia de medias entre hombres y mujeres: [ -1144.755 , 1861.614 ]

Es decir, con un nivel de confianza del 90%, la media de las compras hechas por hombres es entre -1145 dólares menor y 1862 dólares mayor que la media de las compras hechas por mujeres aproximadamente.

d) Intervalo de confianza para la varianza de las compras de las mujeres

Sabiendo que sigue una distribución normal se tienen intervalos del 90%,95%,99% de confianza

# Intervalo de confianza al 90% para la varianza de las compras de mujeres
var(muestra_mujeres$Purchase)

## [1] 13502754

varianza_intervalo_confianza <- var.test(muestra_mujeres$Purchase, conf.level = 0.90)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 90% para la varianza de las compras de mujeres: [", varianza_intervalo_confianza[1], ",", varianza_intervalo_confianza[2], "]\n")

## Intervalo de confianza del 90% para la varianza de las compras de mujeres: [ 9611664 , 20619942 ]

Este intervalo indica que, con un nivel de confianza del 90%, la varianza de las compras de las mujeres está entre 9611664 y 20619942.

# Intervalo de confianza al 90% para la varianza de las compras de mujeres
var(muestra_mujeres$Purchase)

## [1] 13502754

varianza_intervalo_confianza <- var.test(muestra_mujeres$Purchase, conf.level = 0.95)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 95% para la varianza de las compras de mujeres: [", varianza_intervalo_confianza[1], ",", varianza_intervalo_confianza[2], "]\n")

## Intervalo de confianza del 95% para la varianza de las compras de mujeres: [ 9018367 , 22427391 ]

Este intervalo indica que, con un nivel de confianza del 95%, la varianza de las compras de las mujeres está entre 9018367 y 22427391.

# Intervalo de confianza al 90% para la varianza de las compras de mujeres
var(muestra_mujeres$Purchase)

## [1] 13502754

varianza_intervalo_confianza <- var.test(muestra_mujeres$Purchase, conf.level = 0.99)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 99% para la varianza de las compras de mujeres: [", varianza_intervalo_confianza[1], ",", varianza_intervalo_confianza[2], "]\n")

## Intervalo de confianza del 99% para la varianza de las compras de mujeres: [ 7994599 , 26601017 ]

Este intervalo indica que, con un nivel de confianza del 99%, la varianza de las compras de las mujeres está entre 7994599 y 26601017.

Actividad 3

Tomando nuevamente la muestra de la actividad 1 se tiene:

a) Construya una prueba de hipótesis con un nivel de significancia de 0,05 para las ventas promedio, usando como hipótesis alternativa: “mu es mayor a el valor real encontrado en la población”. Justifique cada parte del proceso, al final de su conclusión en el contexto del problema.

# Hipótesis nula: mu es igual al valor real encontrado en la población (Actividad 1 ítem c.)

# Hipótesis alternativa: mu es mayor al valor real encontrado en la población
hipotesis_nula <- mean(datosB$Purchase)  # Valor real encontrado en la población (Actividad 1 ítem c.)

resultado_prueba <- t.test(muestra2$Purchase, mu = hipotesis_nula, alternative = "greater")


# Imprimir el resultado de la prueba
cat("Estadístico de prueba:", resultado_prueba$statistic, "\n")

## Estadístico de prueba: -0.6086883

cat("Valor p:", resultado_prueba$p.value, "\n")

## Valor p: 0.7280544

# Conclusión
if (resultado_prueba$p.value < 0.05) {
  cat("Rechazamos la hipótesis nula. Hay evidencia suficiente para afirmar que las ventas 
promedio son mayores que el valor real encontrado en la población.\n")
} else {
  cat("No hay suficiente evidencia para rechazar la hipótesis nula. No podemos afirmar que las ventas 
promedio sean mayores que el valor real encontrado en la población.\n")
}

## No hay suficiente evidencia para rechazar la hipótesis nula. No podemos afirmar que las ventas 
## promedio sean mayores que el valor real encontrado en la población.

####################
ejex <- seq(-3,3,0.01)
ejey <- dnorm(ejex)
plot(ejex,ejey,type='l', lwd=3)
lizq <- qnorm(0.025)
aux.x <- ejex[ejex<=lizq]
aux.y <- dnorm(aux.x)
polygon(c(3,-3,aux.x,lizq),c(0,0,aux.y,0),col='yellow')
polygon(c(-lizq,-rev(aux.x),3),c(0,rev(aux.y),0),col='yellow')
text(-2,0.3,'Región rechazo-amarilla')
text(2,0.3,'Región rechazo-amarilla')
text(0,0.1,'Región de aceptación')
###############################
z0 <- -0.6086883 
abline(v=z0, col =2,lwd=5)

b) Prueba de hipótesis con nivel de significancia del 0.05 para diferencia entre las compras promedio entre hombres y mujeres

# Hipótesis nula: No hay diferencia entre las compras promedio de hombres y mujeres
# Hipótesis alternativa: Hay diferencia entre las compras promedio de hombres y mujeres
resultado_prueba <- t.test(muestra_hombres$Purchase, muestra_mujeres$Purchase)

# Imprimir el resultado de la prueba
cat("Estadístico de prueba:", resultado_prueba$statistic, "\n")

## Estadístico de prueba: 0.440817

cat("Valor p:", resultado_prueba$p.value, "\n")

## Valor p: 0.660302

# Conclusión
if (resultado_prueba$p.value < 0.05) {
  cat("Rechazamos la hipótesis nula. Hay evidencia suficiente para afirmar que hay 
diferencia entre las compras promedio de hombres y mujeres.\n")
} else {
  cat("No hay suficiente evidencia para rechazar la hipótesis nula. No podemos afirmar 
que haya diferencia entre las compras promedio de hombres y mujeres.\n")
}

## No hay suficiente evidencia para rechazar la hipótesis nula. No podemos afirmar 
## que haya diferencia entre las compras promedio de hombres y mujeres.

####################
ejex <- seq(-3,3,0.01)
ejey <- dnorm(ejex)
plot(ejex,ejey,type='l', lwd=3)
lizq <- qnorm(0.025)
aux.x <- ejex[ejex<=lizq]
aux.y <- dnorm(aux.x)
polygon(c(3,-3,aux.x,lizq),c(0,0,aux.y,0),col='yellow')
polygon(c(-lizq,-rev(aux.x),3),c(0,rev(aux.y),0),col='yellow')
text(-2,0.3,'Región rechazo-amarilla')
text(2,0.3,'Región rechazo-amarilla')
text(0,0.1,'Región de aceptación')
###############################
z0 <- 0.440817
abline(v=z0, col =2,lwd=5)

c) Intervalo de confianza para el cociente de varianzas de las compras de hombres y mujeres

Analizando en intervalos del 90%, 95% y 99%, se tiene que

x <- var(muestra_hombres$Purchase)/var(muestra_mujeres$Purchase)
x

## [1] 1.889078

# Intervalo de confianza para el cociente de varianzas
intervalo_confianza_varianzas <- var.test(muestra_hombres$Purchase, muestra_mujeres$Purchase, conf.level = 0.90)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 90% para el cociente de varianzas:", intervalo_confianza_varianzas, "\n")

## Intervalo de confianza del 90% para el cociente de varianzas: 1.163082 2.936021

La varianza de las compras de los hombres es entre un 1.16 y un 2.93 mayor que la varianza de las compras de las mujeres con un intervalo del 90% de confianza.

# Intervalo de confianza para el cociente de varianzas
intervalo_confianza_varianzas <- var.test(muestra_hombres$Purchase, muestra_mujeres$Purchase, conf.level = 0.95)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 95% para el cociente de varianzas:", intervalo_confianza_varianzas, "\n")

## Intervalo de confianza del 95% para el cociente de varianzas: 1.057522 3.194479

La varianza de las compras de los hombres es entre un 1.05 y un 3.19 mayor que la varianza de las compras de las mujeres con un intervalo del 95% de confianza.

# Intervalo de confianza para el cociente de varianzas
intervalo_confianza_varianzas <- var.test(muestra_hombres$Purchase, muestra_mujeres$Purchase, conf.level = 0.99)$conf.int

# Imprimir el intervalo de confianza
cat("Intervalo de confianza del 99% para el cociente de varianzas:", intervalo_confianza_varianzas, "\n")

## Intervalo de confianza del 99% para el cociente de varianzas: 0.8741209 3.762926

La varianza de las compras de los hombres es entre un 0.87 y un 3.76 mayor que la varianza de las compras de las mujeres con un intervalo del 99% de confianza.

d) Prueba de hipótesis con alfa = 5% para la igualdad de las varianzas entre las compras de hombres y mujeres.

# Hipótesis nula: Varianzas son iguales
# Hipótesis alternativa: Varianzas son diferentes
resultado_prueba_varianzas <- var.test(muestra_hombres$Purchase, muestra_mujeres$Purchase)

# Imprimir el resultado de la prueba
cat("Estadístico de prueba:", resultado_prueba_varianzas$statistic, "\n")

## Estadístico de prueba: 1.889078

cat("Valor p:", resultado_prueba_varianzas$p.value, "\n")

## Valor p: 0.03212172

# Conclusión
if (resultado_prueba_varianzas$p.value < 0.05) {
  cat("Rechazamos la hipótesis nula. Hay evidencia suficiente para afirmar que las varianzas 
son diferentes.\n")
} else {
  cat("No hay suficiente evidencia para rechazar la hipótesis nula. No podemos afirmar 
que las varianzas sean diferentes.\n")
}

## Rechazamos la hipótesis nula. Hay evidencia suficiente para afirmar que las varianzas 
## son diferentes.

# Obtener el valor crítico para la región de rechazo
valor_critico <- qf(0.95, df1 = length(muestra_hombres$Purchase) - 1, df2 = length(muestra_mujeres$Purchase) - 1)

# Gráfico
ejex <- seq(0, 10, 0.01)
ejey <- df(ejex, df1 = length(muestra_hombres$Purchase) - 1, df2 = length(muestra_mujeres$Purchase) - 1)
plot(ejex, ejey, type = 'l', lwd = 3, col = 'blue', xlab = 'Estadístico de prueba F', ylab = 'Densidad')
abline(v = valor_critico, col = 'red', lty = 2, lwd = 2)
text(valor_critico, 0.1, 'Región de rechazo', col = 'red')
polygon(c(ejex[ejex >= valor_critico], valor_critico), c(ejey[ejex >= valor_critico], 0), col = 'yellow')
text(8, 0.1, 'Región de aceptación', col = 'black')
title(main = 'Región de rechazo y aceptación para la prueba de varianza', col.main = 'black', font.main = 4)
legend('topright', legend = 'Región de Rechazo', col = 'red', lty = 2, cex = 0.8)

Parcial Final - PyEF

Oscar Leonardo Cruz Naranjo (ocruzn@unal.edu.co)

Mateo Garnica Amaya (mgarnica@unal.edu.co)

José Alejandro Lancheros López (jlancherosl@unal.edu.co)

`02 de diciembre de 2023`