Probabilidades

Simulaciones

Simulación moneda

• En este caso estamos interesados en conocer la verdadera probabilidad de obtener cara al lanzar una moneda al aire.
• ¿Realmente la probabilida de obtener “cara” es 0.5?

# Opciones de la moneda
moneda <- c("cara", "sello")

# Un lanzamiento al aire de la moneda
set.seed(1) # semilla que garantiza la replicabilidad
sample(x = moneda, size = 1)

## [1] "cara"

• Vamos a lanzar la moneda 10 veces al aire y observamos (contamos) cuántas “caras” obtenemos

set.seed(1)
lanzamientos_10 <- replicate(n = 10, expr = sample(x = moneda, size = 1))
lanzamientos_10

##  [1] "cara"  "sello" "cara"  "cara"  "sello" "cara"  "cara"  "cara"  "sello"
## [10] "sello"

• Ahora calculamos la proporción de “caras” en los 10 lanzamientos:

prop.table(table(lanzamientos_10))[1]

## cara 
##  0.6

100 lanzamientos

• Vamos a replicar el experimento anterior desde 1 hasta 100 lanzamientos

resultados <- c()

set.seed(1)
for (i in 1:100) {
  muestra <- replicate(n = i, expr = sample(x = moneda, size = 1))
  resultados[i] = prop.table(table(muestra))[1]
}

resultados

##   [1] 1.0000000 0.5000000 0.6666667 0.5000000 1.0000000 0.3333333 0.8571429
##   [8] 0.5000000 0.2222222 0.4000000 0.2727273 0.4166667 0.5384615 0.5000000
##  [15] 0.5333333 0.5625000 0.4705882 0.5555556 0.5789474 0.4500000 0.5238095
##  [22] 0.4545455 0.6086957 0.2083333 0.7200000 0.3461538 0.5185185 0.6428571
##  [29] 0.6551724 0.4000000 0.5806452 0.6562500 0.4545455 0.4705882 0.5428571
##  [36] 0.3611111 0.4324324 0.5000000 0.5641026 0.6000000 0.3414634 0.5238095
##  [43] 0.4186047 0.4545455 0.5555556 0.4347826 0.4893617 0.4791667 0.4693878
##  [50] 0.5200000 0.4509804 0.4423077 0.5471698 0.4814815 0.5272727 0.6428571
##  [57] 0.5789474 0.5344828 0.5423729 0.4833333 0.4098361 0.4516129 0.5873016
##  [64] 0.4062500 0.4923077 0.4545455 0.4776119 0.4264706 0.5217391 0.5428571
##  [71] 0.5211268 0.4722222 0.5068493 0.5540541 0.5600000 0.4210526 0.5194805
##  [78] 0.4487179 0.5063291 0.4500000 0.4567901 0.5121951 0.4939759 0.5000000
##  [85] 0.5058824 0.5930233 0.5402299 0.4772727 0.3820225 0.4888889 0.5494505
##  [92] 0.4239130 0.5053763 0.4468085 0.4947368 0.4687500 0.3711340 0.4591837
##  [99] 0.4040404 0.5400000

• Gráficamos el resultado anterior:

plot(resultados, type = "l")
abline(h = 0.5, col = "red")

• También podemos graficar con ggplot2:

library(tidyverse)
resultados %>% 
  enframe(name = "lanzamiento", value = "proporcion") %>% 
  ggplot(aes(x = lanzamiento, y = proporcion)) +
  geom_line() +
  geom_hline(yintercept = 0.5, color = "red")

2000 lanzamientos

resultados2 <- c()

set.seed(1)
for (i in 1:2000) {
  muestra2 <- replicate(n = i, expr = sample(x = moneda, size = 1))
  resultados2[i] = prop.table(table(muestra2))[1]
}

resultados2 %>% 
  enframe(name = "lanzamiento", value = "proporcion") %>% 
  ggplot(aes(x = lanzamiento, y = proporcion)) +
  geom_line() +
  geom_hline(yintercept = 0.5, color = "red")

• Graficamos la distribución:

resultados2 %>% 
  enframe(name = "lanzamiento", value = "proporcion") %>% 
  ggplot(aes(x = proporcion)) +
  geom_density() +
  geom_vline(xintercept = 0.5, color = "red")

Ejemplo dado

2000 lanzamientos

• Primero generamos el espacio muestral del dado:

dado <- c(1, 2, 3, 4, 5, 6)

• Ahora lanzamos 2000 veces el dado y calculamos la probabilidad de una de las opciones:

resultados_dado <- c()

set.seed(1)
for (i in 1:2000) {
  muestra_dado <- replicate(n = i, expr = sample(x = dado, size = 1))
  resultados_dado[i] = prop.table(table(muestra_dado))[1]
}

resultados_dado %>% 
  enframe(name = "lanzamiento", value = "proporcion") %>% 
  ggplot(aes(x = lanzamiento, y = proporcion)) +
  geom_line() +
  geom_hline(yintercept = 1/6, color = "red")

• Graficamos la distribución:

resultados_dado %>% 
  enframe(name = "lanzamiento", value = "proporcion") %>% 
  ggplot(aes(x = proporcion)) +
  geom_density() +
  geom_vline(xintercept = 1/6, color = "red")

Encuesta

Promedio académico

library(tidyverse)
library(readxl)
encuesta <- read_excel("encuesta_depurada_excel.xlsx")
encuesta

• Veamos la distribución del promedio académico:

encuesta %>% 
  ggplot(aes(x = promedio_academico)) +
  geom_density()

• ¿Cuál es el promedio y la desviación estándar?

encuesta %>% 
  summarise(promedio = mean(promedio_academico),
            desv = sd(promedio_academico))

• ¿Existe la normalidad? ¿Realmente la variable se distribuye de forma gaussiana? Rta: Gráfico cuantil-cuantil o Q-Q Norm

encuesta %>% 
  ggplot(aes(sample = promedio_academico)) +
  geom_qq() +
  geom_qq_line()

• Podemos mejorar la interpretación del gráfico anterior con el paquete ggpubr:

library(ggpubr)
ggqqplot(encuesta$promedio_academico)

• Promedio - 1DE:

3.906207 - 0.2472479

## [1] 3.658959

• Promedio + 1DE:

3.906207 + 0.2472479

## [1] 4.153455

• Promedio - 2DE:

3.906207 - (0.2472479 * 2)

## [1] 3.411711

• Promedio + 2DE:

3.906207 + (0.2472479 * 2)

## [1] 4.400703

• Promedio - 3DE:

3.906207 - (0.2472479 * 3)

## [1] 3.164463

• Promedio + 3DE:

3.906207 + (0.2472479 * 3)

## [1] 4.647951

• ¿Puedo simular 100 estudiantes de la Universidad de Antioquia con las dos métricas anteriores?

set.seed(1)
estud_sim <- rnorm(n = 1000000, mean = 3.906207, sd = 0.2472479)

estud_sim %>% head()

## [1] 3.751318 3.951612 3.699600 4.300637 3.987677 3.703348

• ¿Puedo usar estos valores simulados para hacer inferencias estadísticas? ¿Puedo calcular probabilidades?

pnorm(q = 4.1, mean = 3.906207, sd = 0.2472479, lower.tail = TRUE)

## [1] 0.7834214

• ¿Puedo obtener un valor similar con los datos simulados anteriormente? Parece que no 😨😨😨.

prop.table(table(estud_sim <= 4.1))

## 
##    FALSE     TRUE 
## 0.216743 0.783257

• ¿Qué pasa si incrementamos el número de estudiantes simulados? 🤔🤔🤔

• ¿Cuál es la probabilidad de encontrar un estudiante con promedio académico entre 3.14 y 3.47?

prop.table(table(estud_sim >= 3.14 & estud_sim  <= 3.47))

## 
##    FALSE     TRUE 
## 0.961721 0.038279

Anexo: depuración de encuesta

mis_nombres <- c(
  "promedio_academico",
  "tiempo_casa_u",
  "distancia_casa_u",
  "abandonar_universidad",
  "medio_transporte",
  "electivas",
  "numero_azar",
  "trabajo",
  "matematicas",
  "pregunta_tiempo",
  "sistema_educativo"
)

encuesta <- read_excel("Encuesta-Respuestas.xlsx") %>% 
  set_names(mis_nombres) %>% 
  mutate(
    promedio_academico = as.numeric(promedio_academico),
    tiempo_casa_u = str_extract_all(
      string = tiempo_casa_u,
      pattern = "[0-9]+",
      simplify = TRUE
    ),
    tiempo_casa_u = as.numeric(tiempo_casa_u),
    distancia_casa_u = str_replace_all(distancia_casa_u,
                                       pattern = "km",
                                       replacement = ""),
    distancia_casa_u = str_replace_all(distancia_casa_u,
                                       pattern = ",",
                                       replacement = "."),
    distancia_casa_u = as.numeric(distancia_casa_u),
    matematicas = as.numeric(matematicas),
    velocidad = distancia_casa_u / tiempo_casa_u
  ) 

writexl::write_xlsx(x = encuesta, path = "encuesta_depurada.xlsx")