Importar Datos

test_titanic <-read_csv("C:/Users/franc/Downloads/test_titanic.csv")

train_titanic <-read_csv("C:/Users/franc/Downloads/train_titanic.csv")

Transformación de la Base

train_titanic <- subset(train_titanic, select =-Survived) #eliminar columna

df1 <- merge(test_titanic,train_titanic, all = T) #unir bases de datos
df1 <- df1 %>% clean_names()
df <-df1 %>% select(age,sex)

missmap(df)

Distribución de la edad antes y despues de imputar

# Para la prueba de Lilliefors

# Prueba de normalidad con Lilliefors antes de rellenar
lillie.test(df1$age[!is.na(df1$age)])
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  df1$age[!is.na(df1$age)]
## D = 0.078928, p-value < 2.2e-16
# Rellenar los valores faltantes con la mediana
df$age[is.na(df$age)] <- median(df$age, na.rm = TRUE)

# Prueba de normalidad con Lilliefors después de rellenar
lillie.test(df$age)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  df$age
## D = 0.15675, p-value < 2.2e-16
# Comparación antes vs después con Wilcoxon

df_before <- df1$age[!is.na(df1$age)]  
df_after <- df$age[!is.na(df$age)] 
wilcoxon_test <- wilcox.test(df_before, df_after, paired = F)

print(wilcoxon_test)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  df_before and df_after
## W = 685396, p-value = 0.9616
## alternative hypothesis: true location shift is not equal to 0
par(mfrow = c(1, 2))
# Histograma antes de rellenar
hist(df1$age, main = "Distribución de Edad antes", col = "lightblue", border = "black", xlab = "Edad", ylab = "Frecuencia")

# Histograma después de rellenar
hist(df$age, main = "Distribución de Edad despues", col = "lightgreen", border = "black", xlab = "Edad", ylab = "Frecuencia")

par(mfrow = c(1, 1))

La distribución no cambia con la imputación.

Punto 1

summary_stats <- df %>% summarise(
  media = mean(age, na.rm = TRUE),
  mediana = median(age, na.rm = TRUE),
  desviacion = sd(age, na.rm = TRUE),
  varianza = var(age, na.rm = TRUE)
)
summary_stats
##      media mediana desviacion varianza
## 1 29.50319      28   12.90524 166.5452
# Cuartiles
quartiles <- quantile(df$age)
print(quartiles)
##    0%   25%   50%   75%  100% 
##  0.17 22.00 28.00 35.00 80.00
# Histograma de edad
ggplot(df, aes(x = age)) +
  geom_histogram(binwidth = 5, fill = "steelblue", color = "black", alpha = 0.7) +
  labs(title = "Histograma de Edad", x = "Edad", y = "Frecuencia")

# Diagrama de caja y bigotes
ggplot(df, aes(y = age)) +
  geom_boxplot(fill = "lightblue", color = "black") +
  labs(title = "Diagrama de Caja de Edad", y = "Edad")

Punto 2

# Semilla para reproducibilidad
set.seed(1234)

# Filtrar la base de datos por edades mayores a 30
df_mayores30 <- subset(df, age > 30)

# Definir parámetros del muestreo
n <- 50   # Tamaño de la muestra
M <- 1000  # Número de muestras (réplicas)

# Vectores para almacenar estadísticas muestrales
est_media <- numeric(M)  # Media muestral
est_varianza <- numeric(M)  # Varianza muestral

# Generar muestras aleatorias y calcular estadísticas
for (i in 1:M) {
  agesample <- sample(df_mayores30$age, n, replace = TRUE)  # Muestreo con reemplazo
  est_media[i] <- mean(agesample)  # Media muestral
  est_varianza[i] <- var(agesample)  # Varianza muestral
}

# Histograma de las medias muestrales
hist(est_media, freq = FALSE, col = "lightblue", main = "Distribución de la Media Muestral",
     xlab = "Media de Edad", ylim = c(0, 0.3))

# Superponer distribución normal teórica según el TLC
media_poblacional <- mean(df_mayores30$age)
varianza_poblacional <- var(df_mayores30$age)
desviacion_estandar_muestral <- sqrt(varianza_poblacional / n)

curve(dnorm(x, mean = media_poblacional, sd = desviacion_estandar_muestral), 
      col = "red", lwd = 2, add = TRUE)

# Cálculo de nγ
gamma <- varianza_poblacional / media_poblacional
valor_n_gamma <- n * gamma
print(paste("El valor de nγ es:", round(valor_n_gamma, 3)))
## [1] "El valor de nγ es: 115.318"
# Prueba de normalidad sobre las medias muestrales
lillie.test(est_media)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  est_media
## D = 0.03592, p-value = 0.004016
# Q-Q Plot para evaluar normalidad
qqnorm(est_media)
qqline(est_media, col = "red")

#variando el N y observando que entre mas grande la distribución se vuelve normal

#cambiar el tamaño de la muestra
edad_filtrada <- df$age[df$age > 30] 
n_valores <- c(10, 30, 100, 1000)

par(mfrow = c(1, length(n_valores)))  

for (n in n_valores) {
  medias_temp <- numeric(M) 
  
  for (i in 1:M) {
    muestra <- sample(edad_filtrada, size = n, replace = TRUE)
    medias_temp[i] <- mean(muestra)
  }
  
  hist(medias_temp, probability = TRUE, main = paste("n =", n),
       xlab = "Media Muestral", border = "black")
  
  curve(dnorm(x, mean = mean(medias_temp), sd = sd(medias_temp)),
        col = "red", lwd = 2, add = TRUE)
}

par(mfrow = c(1,1))

Punto 4

# Definir tamaños de muestra y número de simulaciones
n_mujeres <- 50
n_hombres <- 60
M <- 1000

# Filtrar la base de datos por género
df_mujeres <- df[df$sex == "female", ]
df_hombres <- df[df$sex == "male", ]

# Verificar que los datos sean numéricos y sin NA
df_mujeres <- as.numeric(na.omit(df_mujeres$age))
df_hombres <- as.numeric(na.omit(df_hombres$age))

# Inicializar vector para almacenar diferencias de proporciones
dif_prop_muestras <- rep(NA, M)

set.seed(123)

# Simulación de muestreo aleatorio
for (i in 1:M) {
  muestra_mujeres <- sample(df_mujeres, n_mujeres, replace = TRUE)
  muestra_hombres <- sample(df_hombres, n_hombres, replace = TRUE)
  
  # Calcular proporción de mujeres y hombres con edad mayor a 30
  prop_mujeres_muestra <- mean(muestra_mujeres > 30)
  prop_hombres_muestra <- mean(muestra_hombres > 30)
  
  # Almacenar diferencia de proporciones
  dif_prop_muestras[i] <- prop_mujeres_muestra - prop_hombres_muestra
}


# Verificar si hay suficientes valores distintos para graficar
hist(dif_prop_muestras, freq = FALSE, breaks = 30,
       main = "Histograma de la Diferencia de Proporciones",
       xlab = "Diferencia de proporciones (mujeres - hombres)", col = "blue")

# Gráfico Q-Q para verificar normalidad
qqnorm(dif_prop_muestras, main = "Gráfico Q-Q: Diferencia de Proporciones")
  qqline(dif_prop_muestras, col = "red")

# Cálculo de probabilidad empírica de que la diferencia sea mayor a 0
prob_empirica <- mean(dif_prop_muestras > 0)

# Cálculo de probabilidad teórica asumiendo normalidad
media_dif <- mean(dif_prop_muestras)
desv_dif <- sd(dif_prop_muestras)
prob_teorica <- 1 - pnorm(0, mean = media_dif, sd = desv_dif)

# Mostrar resultados
print(paste("Probabilidad empírica de que la diferencia sea mayor a 0:", prob_empirica))
## [1] "Probabilidad empírica de que la diferencia sea mayor a 0: 0.458"
print(paste("Probabilidad teórica de que la diferencia sea mayor a 0:", prob_teorica))
## [1] "Probabilidad teórica de que la diferencia sea mayor a 0: 0.457993986166751"