1 Paquetes a instalar

[@tidyverse; @kableExtra; @dplyr]

Ver código

#install.packages("gt")
#library(knitr)
#library(kableExtra)
#library(magrittr)
#library(tidyverse)
#library(ggplot2)
#library(dplyr)

2 Modelos Discretos de Probabilidad

Los modelos discretos de probabilidad son herramientas matemáticas utilizadas en estadística y probabilidad para representar situaciones aleatorias en las que los resultados posibles pueden contarse de manera exacta.

Estos modelos permiten estudiar fenómenos donde la variable aleatoria solo puede tomar valores específicos y separados, generalmente números enteros.

Se utilizan en áreas como:

estadística,

economía,

ingeniería,

medicina,

administración,

inteligencia artificial.

Ejemplo sencillo

Si lanzas una moneda:

puede salir cara o sello,

no sabes exactamente qué ocurrirá,

pero sí puedes calcular la probabilidad.

Ese comportamiento se estudia con un modelo probabilístico.

Elementos principales

Un modelo probabilístico tiene:

Experimento aleatorio: acción que produce resultados inciertos.

Espacio muestral: conjunto de posibles resultados.

Variable aleatoria: valor numérico asociado al resultado.

Probabilidad: posibilidad de ocurrencia de cada resultado.

Distribución Bernoulli

La distribución Bernoulli es el modelo discreto más simple.

Describe experimentos aleatorios donde solo existen dos posibles resultados:

éxito, fracaso.

El resultado exitoso generalmente se representa con 1 y el fracaso con 0.

-Solo hay un ensayo. -Existen dos resultados posibles. -La probabilidad de éxito permanece constante.

Distribución Binomial

La distribución binomial se utiliza cuando se realizan varios ensayos Bernoulli independientes y se desea calcular el número total de éxitos.

Características

Número fijo de ensayos. Los ensayos son independientes. Solo existen éxito o fracaso. La probabilidad de éxito es constante.

Distribución de Poisson

La distribución de Poisson modela el número de veces que ocurre un evento dentro de un intervalo de tiempo, espacio o área.

Características Los eventos ocurren aleatoriamente. Las ocurrencias son independientes. Se analiza un intervalo fijo. Se trabaja con promedios de ocurrencia.

Distribución Hipergeométrica

La distribución hipergeométrica se utiliza cuando las extracciones se realizan sin reemplazo dentro de una población finita.

Características La población es limitada. No hay reemplazo. La probabilidad cambia en cada extracción.

Ejercicio 1.

Se sabe que el 60% de los alumnos de una universidad asisten a clases el viernes. En una encuesta a 8 alumnos de la universidad. ¿Cuál es la probabilidad de que a) por lo menos siete asistan a clase el viernes? b) por lo menos dos no asistan a clase.

Este ejercicio se resuelve con una Distribución Binomial:

-Inciso a) P(X >= 7)

Ver código

n <- 8
p <- 0.60
p_x7 <- dbinom(7, size = n, prob = p)
p_x8 <- dbinom(8, size = n, prob = p)
p_a  <- p_x7 + p_x8

cat("P(X = 7) =", round(p_x7, 4), "\n")

P(X = 7) = 0.0896

Ver código

cat("P(X = 8) =", round(p_x8, 4), "\n")

P(X = 8) = 0.0168

Ver código

cat("P(X >= 7) =", round(p_a, 4), "\n")

P(X >= 7) = 0.1064

Ver código

p_a2 <- pbinom(6, size = n, prob = p, lower.tail = FALSE)
cat("Verificacion pbinom:", round(p_a2, 4), "\n")

Verificacion pbinom: 0.1064

Ver código

library(kableExtra)
# Crear tabla
tabla <- data.frame(
  Evento = c("P(X = 7)",
             "P(X = 8)",
             "P(X >= 7)",
             "Verificacion con pbinom()"),
  
  Resultado = c(round(p_x7, 4),
                round(p_x8, 4),
                round(p_a, 4),
                round(p_a2, 4))
)

# Generar tabla con colores
kable(tabla,
      caption = "Resultados de la distribución binomial",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue")

Resultados de la distribución binomial
Evento	Resultado
P(X = 7)	0.0896
P(X = 8)	0.0168
P(X >= 7)	0.1064
Verificacion con pbinom()	0.1064

-Inciso b) P(Y >= 2)

Ver código

q <- 1 - p
p_y0 <- dbinom(0, size = n, prob = q)
p_y1 <- dbinom(1, size = n, prob = q)
p_b  <- 1 - (p_y0 + p_y1)

cat("P(Y = 0) =", round(p_y0, 4), "\n")

P(Y = 0) = 0.0168

Ver código

cat("P(Y = 1) =", round(p_y1, 4), "\n")

P(Y = 1) = 0.0896

Ver código

cat("P(Y >= 2) =", round(p_b, 4), "\n")

P(Y >= 2) = 0.8936

Ver código

p_b2 <- pbinom(1, size = n, prob = q, lower.tail = FALSE)
cat("Verificacion pbinom:", round(p_b2, 4), "\n")

Verificacion pbinom: 0.8936

Ver código

# Crear tabla
tabla3 <- data.frame(
  Evento = c("P(Y = 0)",
             "P(Y = 1)",
             "P(Y >= 2)",
             "Verificacion con pbinom()"),
  
  Resultado = c(round(p_y0, 4),
                round(p_y1, 4),
                round(p_b, 4),
                round(p_b2, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla3,
      caption = "Resultados de probabilidades para P(Y >= 2)",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue") %>%
  
  row_spec(1:nrow(tabla3),
           background = c("#E8F8F5", "#D1F2EB"))

Resultados de probabilidades para P(Y >= 2)
Evento	Resultado
P(Y = 0)	0.0168
P(Y = 1)	0.0896
P(Y >= 2)	0.8936
Verificacion con pbinom()	0.8936

-Grafica

Ver código

x <- 0:n
prob_x <- dbinom(x, size = n, prob = p)

Ver código

library(ggplot2)
media <- 4.8
desv <- 1.385641

# Datos para la curva normal
x <- seq(0, 10, length = 500)

y <- dnorm(x, mean = media, sd = desv)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x >= 6.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#0B3C5D",
    linewidth = 1.8
  ) +

  # Línea de la media
  geom_vline(
    xintercept = media,
    linetype = "dashed",
    color = "#C0392B",
    linewidth = 1.2
  ) +

  # Etiquetas
  labs(
    title = "Distribución Binomial Aproximada por la Campana de Gauss",

    subtitle = "Probabilidad de asistencia de estudiantes",

    x = "Número de estudiantes que asisten",

    y = "Densidad de probabilidad"
  ) +

  # Tema profesional
  theme_minimal(base_size = 15) +

  theme(
    plot.title = element_text(
      face = "bold",
      size = 18,
      hjust = 0.5
    ),

    plot.subtitle = element_text(
      hjust = 0.5,
      size = 13
    ),

    axis.title = element_text(
      face = "bold"
    ),

    panel.grid.minor = element_blank()
  )

Esto indica que existe aproximadamente un 10.64% de probabilidad de que siete o más estudiantes asistan a clases el viernes.

Además, mediante la aproximación con la Campana de Gauss o distribución normal, se representó gráficamente el comportamiento probabilístico de la variable aleatoria, permitiendo visualizar de manera más clara la concentración de probabilidades alrededor de la media.

La gráfica mostró que la mayor concentración de estudiantes asistentes se encuentra cerca del valor esperado: lo cual significa que, en promedio, se espera que aproximadamente 5 estudiantes asistan a clases los viernes.

Ejercicio 2.

Según los registros universitarios fracasa el 5% de los alumnos de cierto curso. ¿cuál es la probabilidad de que, de 6 estudiantes seleccionados al azar, menos de 3 hayan fracasado?

Identificación de variables

n = 6 (estudiantes seleccionados)
p = 0,05 (probabilidad de fracaso)
X = número de alumnos que fracasan
Se busca: P(X < 3) = P(X = 0) + P(X = 1) + P(X = 2)

n <- 6 p <- 0.05

-Probabilidades individuales

Ver código

p_x0 <- dbinom(0, size = n, prob = p)
p_x1 <- dbinom(1, size = n, prob = p)
p_x2 <- dbinom(2, size = n, prob = p)
p_menor3 <- p_x0 + p_x1 + p_x2

cat("P(X = 0) =", round(p_x0, 4), "\n")

P(X = 0) = 7e-04

Ver código

cat("P(X = 1) =", round(p_x1, 4), "\n")

P(X = 1) = 0.0079

Ver código

cat("P(X = 2) =", round(p_x2, 4), "\n")

P(X = 2) = 0.0413

Ver código

cat("P(X < 3) =", round(p_menor3, 4), "\n")

P(X < 3) = 0.0498

Ver código

p_ver <- pbinom(2, size = n, prob = p)
cat("Verificacion pbinom:", round(p_ver, 4), "\n")

Verificacion pbinom: 0.0498

Ver código

# Crear tabla
tabla2 <- data.frame(
  Evento = c("P(X = 0)",
             "P(X = 1)",
             "P(X = 2)",
             "P(X < 3)",
             "Verificacion con pbinom()"),
  
  Resultado = c(round(p_x0, 4),
                round(p_x1, 4),
                round(p_x2, 4),
                round(p_menor3, 4),
                round(p_ver, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla2,
      caption = "Resultados de probabilidades para P(X < 3)",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkred") %>%
  
  row_spec(1:nrow(tabla2),
           background = c("#FDEDEC", "#FADBD8"))

Resultados de probabilidades para P(X < 3)
Evento	Resultado
P(X = 0)	0.0007
P(X = 1)	0.0079
P(X = 2)	0.0413
P(X < 3)	0.0498
Verificacion con pbinom()	0.0498

-Medidas descriptivas:

Ver código

media    <- n * p
varianza <- n * p * (1 - p)
desv_est <- sqrt(varianza)
asimetria   <- (1 - 2*p) / sqrt(n*p*(1-p))
curtosis    <- (1 - 6*p*(1-p)) / (n*p*(1-p))

cat("Media:", round(media, 4), "\n")

Media: 4.8

Ver código

cat("Varianza:", round(varianza, 4), "\n")

Varianza: 1.92

Ver código

cat("Desviacion estandar:", round(desv_est, 4), "\n")

Desviacion estandar: 1.3856

Ver código

cat("Asimetria:", round(asimetria, 4), "\n")

Asimetria: -0.1443

Ver código

cat("Curtosis excesiva:", round(curtosis, 4), "\n")

Curtosis excesiva: -0.2292

Ver código

# Crear tabla
tabla4 <- data.frame(
  Medida = c("Media",
             "Varianza",
             "Desviacion estandar",
             "Asimetria",
             "Curtosis excesiva"),
  
  Resultado = c(round(media, 4),
                round(varianza, 4),
                round(desv_est, 4),
                round(asimetria, 4),
                round(curtosis, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla4,
      caption = "Medidas estadísticas de la distribución binomial",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkred") %>%
  
  row_spec(1:nrow(tabla4),
           background = c("#F4ECF7", "#E8DAEF"))

Medidas estadísticas de la distribución binomial
Medida	Resultado
Media	4.8000
Varianza	1.9200
Desviacion estandar	1.3856
Asimetria	-0.1443
Curtosis excesiva	-0.2292

-Grafica

Ver código

media <- n * p
desv <- sqrt(n * p * (1 - p))

# Valores para curva
x <- seq(0, 6, length = 1000)

# Densidad normal
y <- dnorm(x,
           mean = media,
           sd = desv)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 2.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Binomial Aproximada",
    subtitle = "Probabilidad de estudiantes reprobados",
    x = "Número de estudiantes que fracasan",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Con base en el modelo de distribución binomial aplicado (n = 6, p = 0,05), se puede concluir lo siguiente: P(X < 3): La probabilidad de que menos de 3 estudiantes hayan fracasado es aproximadamente 0,9978 (99,78%), lo que indica que es casi seguro que en un grupo de 6 alumnos seleccionados al azar, a lo sumo 2 hayan reprobado el curso. Este resultado es coherente con la baja tasa de fracaso del 5%, lo que significa que la gran mayoría de los estudiantes aprueba el curso. La distribución está fuertemente sesgada hacia la derecha, con una media de apenas 0,30 alumnos esperados en fracaso por grupo, y una asimetría positiva que confirma que los valores altos de fracaso son extremadamente poco frecuentes. En conclusión, el modelo binomial demuestra que, dada la baja probabilidad de fracaso, es prácticamente seguro observar menos de 3 reprobados en muestras pequeñas de 6 estudiantes.

Ejercicio 3.

En promedio, el 10% de las varillas de madera usadas en cierto producto presentan problemas para ser usadas. ¿cuál es la probabilidad de que en un paquete de 15 varillas, a) encuentre exactamente 5 con defectos. b) por lo menos 10 estén nudosas, c) no más de 4 estén nudosas.

Identificación de variables

n = 15 (varillas en el paquete) p = 0,10 (probabilidad de defecto) X = número de varillas con defectos Se busca:

P(X = 5)
P(X ≥ 10)
P(X ≤ 4)

Ver código

n <- 15
p <- 0.10

# a) Exactamente 5 con defectos
p_x5 <- dbinom(5, size = n, prob = p)
cat("a) P(X = 5) =", round(p_x5, 4), "\n")

a) P(X = 5) = 0.0105

Ver código

# b) Por lo menos 10 nudosas
p_x10 <- pbinom(9, size = n, prob = p, lower.tail = FALSE)
cat("b) P(X >= 10) =", round(p_x10, 4), "\n")

b) P(X >= 10) = 0

Ver código

# c) No mas de 4 nudosas
p_x4 <- pbinom(4, size = n, prob = p)
cat("c) P(X <= 4) =", round(p_x4, 4), "\n")

c) P(X <= 4) = 0.9873

Ver código

# Crear tabla
tabla5 <- data.frame(
  Inciso = c("a)", "b)", "c)"),
  
  Evento = c("P(X = 5)",
             "P(X >= 10)",
             "P(X <= 4)"),
  
  Resultado = c(round(p_x5, 4),
                round(p_x10, 4),
                round(p_x4, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla5,
      caption = "Resultados de probabilidades binomiales",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkorange") %>%
  
  row_spec(1:nrow(tabla5),
           background = c("#FEF5E7", "#FDEBD0"))

Resultados de probabilidades binomiales
Inciso	Evento	Resultado
a)	P(X = 5)	0.0105
b)	P(X >= 10)	0.0000
c)	P(X <= 4)	0.9873

Ver código

media      <- n * p
varianza   <- n * p * (1 - p)
desv_est   <- sqrt(varianza)
asimetria  <- (1 - 2*p) / sqrt(n*p*(1-p))
curtosis   <- (1 - 6*p*(1-p)) / (n*p*(1-p))

cat("Media:", round(media, 4), "\n")

Media: 1.5

Ver código

cat("Varianza:", round(varianza, 4), "\n")

Varianza: 1.35

Ver código

cat("Desviacion estandar:", round(desv_est, 4), "\n")

Desviacion estandar: 1.1619

Ver código

cat("Asimetria:", round(asimetria, 4), "\n")

Asimetria: 0.6885

Ver código

cat("Curtosis excesiva:", round(curtosis, 4), "\n")

Curtosis excesiva: 0.3407

Grafico

Ver código

media <- n * p
desv <- sqrt(n * p * (1 - p))

# Valores para curva
x <- seq(0, 15, length = 1000)

# Densidad normal
y <- dnorm(x,
           mean = media,
           sd = desv)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 4.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Binomial Aproximada",
    subtitle = "Varillas defectuosas",
    x = "Número de varillas defectuosas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Conclusión en el modelo de distribución binomial aplicado (n = 15, p = 0,10), se puede concluir lo siguiente:

P(X = 5): La probabilidad de encontrar exactamente 5 varillas con defectos es aproximadamente 0,0105 (1,05%). Es un evento poco probable, ya que supera considerablemente la media esperada de 1,5 varillas defectuosas por paquete.
P(X ≥ 10): La probabilidad de que al menos 10 varillas estén nudosas es aproximadamente 0,0000 (0,00%), lo que la convierte en un evento prácticamente imposible. Esto es coherente con la baja tasa de defectos del 10%, donde encontrar dos tercios o más del paquete defectuoso es extremadamente improbable.
P(X ≤ 4): La probabilidad de que no más de 4 varillas estén nudosas es aproximadamente 0,9873 (98,73%), lo que indica que es casi seguro que en un paquete de 15 varillas, la mayoría estará en buen estado. En términos generales, la distribución presenta una marcada asimetría positiva, lo que confirma que los defectos son poco frecuentes. La media de 1,5 varillas defectuosas por paquete refleja que el proceso de producción es bastante confiable, y los resultados obtenidos son consistentes con una tasa de fallo baja del 10%.

Ejercicio 4.

Una compañía de seguros considera que alrededor del 25% de los carros se accidentan cada año. ¿Cuál es la probabilidad de que por lo menos 3 de una muestra de 7 vehículos asegurados, se haya accidentado?

Otro problema binomial! Aquí la solución completa:

n = 7 vehículos p = 0.25 probabilidad de accidente Buscamos P(X ≥ 3)

P(X >= 3): al menos 3 accidentados

Usando complemento: P(X >= 3) = 1 - P(X <= 2)

Ver código

n <- 7
p <- 0.25
p_x0 <- dbinom(0, size = n, prob = p)
p_x1 <- dbinom(1, size = n, prob = p)
p_x2 <- dbinom(2, size = n, prob = p)

p_resultado <- 1 - (p_x0 + p_x1 + p_x2)

cat("P(X = 0) =", round(p_x0, 4), "\n")

P(X = 0) = 0.1335

Ver código

cat("P(X = 1) =", round(p_x1, 4), "\n")

P(X = 1) = 0.3115

Ver código

cat("P(X = 2) =", round(p_x2, 4), "\n")

P(X = 2) = 0.3115

Ver código

cat("P(X <= 2) =", round(p_x0 + p_x1 + p_x2, 4), "\n")

P(X <= 2) = 0.7564

Ver código

cat("P(X >= 3) = 1 - P(X <= 2) =", round(p_resultado, 4), "\n")

P(X >= 3) = 1 - P(X <= 2) = 0.2436

Ver código

# Crear tabla
tabla7 <- data.frame(
  Evento = c("P(X = 0)",
             "P(X = 1)",
             "P(X = 2)",
             "P(X <= 2)",
             "P(X >= 3)"),
  
  Resultado = c(round(p_x0, 4),
                round(p_x1, 4),
                round(p_x2, 4),
                round(p_x0 + p_x1 + p_x2, 4),
                round(p_resultado, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla7,
      caption = "Resultados de probabilidades binomiales",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkslateblue") %>%
  
  row_spec(1:nrow(tabla7),
           background = c("#EBF5FB", "#D6EAF8"))

Resultados de probabilidades binomiales
Evento	Resultado
P(X = 0)	0.1335
P(X = 1)	0.3115
P(X = 2)	0.3115
P(X <= 2)	0.7564
P(X >= 3)	0.2436

Grafica

Ver código

media <- n * p
desv <- sqrt(n * p * (1 - p))

# Valores para curva
x <- seq(0, 7, length = 1000)

# Densidad normal
y <- dnorm(x,
           mean = media,
           sd = desv)

# Data frame
datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x >= 2.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Binomial Aproximada",
    subtitle = "Vehículos accidentados",
    x = "Número de vehículos accidentados",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que al menos 3 vehículos de una muestra de 7 se hayan accidentado es 0.2436 (24.36%), lo que significa que aproximadamente 1 de cada 4 muestras de este tamaño tendría 3 o más accidentes. Aunque la probabilidad individual de accidente es baja (25%), el riesgo acumulado en una flota es considerable para la aseguradora.

Ejercicio 5.

Los registros muestran que 30% de los pacientes admitidos en una clínica, no pagan sus facturas y eventualmente se condona la deuda. Suponga que llegan 4 nuevos pacientes a la clínica, cual es la probabilidad de que se tenga que perdonar la deuda de uno de los cuatro. b) los cuatro pacientes paguen sus facturas

Datos n = 4 pacientes p = 0.30 probabilidad de no pagar a) P(X = 1) — exactamente 1 no paga b) P(X = 0) — ninguno deja de pagar (los 4 pagan)

Inciso a) P(X = 1): exactamente 1 no paga

Ver código

n <- 4
p <- 0.30
p_a <- dbinom(1, size = n, prob = p)
cat("P(X = 1) =", round(p_a, 4), "\n")

P(X = 1) = 0.4116

Ver código

# Crear tabla
tabla8 <- data.frame(
  Evento = c("P(X = 1)"),
  
  Resultado = c(round(p_a, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla8,
      caption = "Resultado de la probabilidad binomial",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkmagenta") %>%
  
  row_spec(1:nrow(tabla8),
           background = "#F5EEF8")

Resultado de la probabilidad binomial
Evento	Resultado
P(X = 1)	0.4116

Inciso b) P(X = 0): los 4 pagan

Ver código

p_b <- dbinom(0, size = n, prob = p)
cat("P(X = 0) =", round(p_b, 4), "\n")

P(X = 0) = 0.2401

Ver código

x <- 0:n
prob_x <- dbinom(x, size = n, prob = p)

Ver código

# Crear tabla
tabla9 <- data.frame(
  Evento = c("P(X = 0)"),
  
  Resultado = c(round(p_b, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla9,
      caption = "Probabilidad de que X = 0",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "#D85A30") %>%
  
  row_spec(1:nrow(tabla9),
           background = "#E8F8F5")

Probabilidad de que X = 0
Evento	Resultado
P(X = 0)	0.2401

Ver código

# Tabla de distribución binomial completa
tabla_distribucion <- data.frame(
  x = x,
  Probabilidad = round(prob_x, 4)
)

# Mostrar tabla de distribución
kable(tabla_distribucion,
      caption = "Distribución Binomial Completa",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "#1D9E75") %>%
  
  row_spec(1:nrow(tabla_distribucion),
           background = c("#EBF5FB", "#D6EAF8"))

Distribución Binomial Completa
x	Probabilidad
0	0.2401
1	0.4116
2	0.2646
3	0.0756
4	0.0081

Grafica

Ver código

media <- n * p
desv <- sqrt(n * p * (1 - p))

# Valores
x <- seq(0, 4, length = 1000)

# Curva normal
y <- dnorm(
  x,
  mean = media,
  sd = desv
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 1.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Binomial Aproximada",
    subtitle = "Pacientes que no pagan",
    x = "Número de pacientes",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Probabilidad de que exactamente 1 paciente no pague: La probabilidad de que se tenga que perdonar la deuda de exactamente uno de los cuatro pacientes es de 0.4116, es decir, existe un 41.16% de probabilidad de que solo un paciente no pague su factura. Esto indica que es el escenario más probable dentro de la distribución.
Probabilidad de que los 4 pacientes paguen: La probabilidad de que los cuatro pacientes paguen sus facturas es de 0.2401, es decir, hay un 24.01% de probabilidad de que ninguno condone su deuda. Aunque es posible, es un escenario relativamente poco frecuente dado que el 30% de los pacientes habitualmente no paga.

Ejercicio 6.

El conmutador de un hospital recibe en promedio 20 llamadas cada dos minutos. Cuál es la probabilidad de que lleguen como máximo dos llamadas en un periodo de 15 segundos.

Este es un problema de distribución de Poisson! Aquí el razonamiento:

Tasa original: 20 llamadas cada 2 minutos (120 segundos) Hay que ajustar la tasa a 15 segundos:

λ = (20 / 120) × 15 = 2.5 llamadas cada 15 segundos

Buscamos P(X ≤ 2)

Tasa ajustada a 15 segundos

Ver código

lambda <- (20 / 120) * 15  # = 2.5
cat("Lambda (15 seg) =", lambda, "\n\n")

Lambda (15 seg) = 2.5

P(X <= 2): como maximo 2 llamadas

Ver código

p_x0 <- dpois(0, lambda = lambda)
p_x1 <- dpois(1, lambda = lambda)
p_x2 <- dpois(2, lambda = lambda)

p_resultado <- p_x0 + p_x1 + p_x2
cat("P(X = 0) =", round(p_x0, 4), "\n")

P(X = 0) = 0.0821

Ver código

cat("P(X = 1) =", round(p_x1, 4), "\n")

P(X = 1) = 0.2052

Ver código

cat("P(X = 2) =", round(p_x2, 4), "\n")

P(X = 2) = 0.2565

Ver código

cat("P(X <= 2) =", round(p_resultado, 4), "\n")

P(X <= 2) = 0.5438

Ver código

# Crear tabla
tabla10 <- data.frame(
  Evento = c("P(X = 0)",
             "P(X = 1)",
             "P(X = 2)",
             "P(X <= 2)"),
  
  Resultado = c(round(p_x0, 4),
                round(p_x1, 4),
                round(p_x2, 4),
                round(p_resultado, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla10,
      caption = "Resultados de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkred") %>%
  
  row_spec(1:nrow(tabla10),
           background = c("#FDEDEC", "#FADBD8"))

Resultados de la distribución de Poisson
Evento	Resultado
P(X = 0)	0.0821
P(X = 1)	0.2052
P(X = 2)	0.2565
P(X <= 2)	0.5438

-Grafica

Ver código

x <- seq(0, 8, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda,
  sd = sqrt(lambda)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 2.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = lambda,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Llamadas recibidas en el hospital",
    x = "Número de llamadas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que lleguen como máximo 2 llamadas al conmutador del hospital en un periodo de 15 segundos es de 0.5438, es decir, existe un 54.38% de probabilidad de que el conmutador reciba 0, 1 o 2 llamadas en dicho intervalo. Dado que la tasa promedio es de 2.5 llamadas por cada 15 segundos, este resultado indica que poco más de la mitad del tiempo el número de llamadas se mantiene en ese rango, lo que refleja una carga moderada pero frecuente para el operador del hospital.

Ejercicio 7.

Los clientes llegan a una exhibición a razón de 6,8 clientes / hora Calcule la probabilidad de que a) en la primera media hora por lo menos lleguen dos clientes; b) en cualquier hora dada llegue más de uno.

problema de distribución de Poisson! Ajustando las tasas:

Tasa original: 6.8 clientes/hora a) Ajuste a 30 minutos: λ = 6.8 / 2 = 3.4 clientes por media hora b) Se mantiene: λ = 6.8 clientes por hora.

Inciso a) P(X >= 2) en media hora

Ver código

lambda_a <- 6.8 / 2  # = 3.4

p_x0_a <- dpois(0, lambda = lambda_a)
p_x1_a <- dpois(1, lambda = lambda_a)
p_a    <- 1 - (p_x0_a + p_x1_a)

cat("Lambda (30 min) =", lambda_a, "\n")

Lambda (30 min) = 3.4

Ver código

cat("P(X = 0) =", round(p_x0_a, 4), "\n")

P(X = 0) = 0.0334

Ver código

cat("P(X = 1) =", round(p_x1_a, 4), "\n")

P(X = 1) = 0.1135

Ver código

cat("P(X >= 2) =", round(p_a, 4), "\n\n")

P(X >= 2) = 0.8532

Ver código

# Verificacion
cat("Verificacion ppois:", round(ppois(1, lambda_a, lower.tail = FALSE), 4), "\n\n")

Verificacion ppois: 0.8532

Ver código

# Crear tabla
tabla11 <- data.frame(
  Evento = c("Lambda (30 min)",
             "P(X = 0)",
             "P(X = 1)",
             "P(X >= 2)",
             "Verificacion con ppois()"),
  
  Resultado = c(round(lambda_a, 4),
                round(p_x0_a, 4),
                round(p_x1_a, 4),
                round(p_a, 4),
                round(ppois(1, lambda_a, lower.tail = FALSE), 4))
)

# Mostrar tabla con colores y bordes
kable(tabla11,
      caption = "Resultados de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkorange") %>%
  
  row_spec(1:nrow(tabla11),
           background = c("#FEF5E7", "#FDEBD0"))

Resultados de la distribución de Poisson
Evento	Resultado
Lambda (30 min)	3.4000
P(X = 0)	0.0334
P(X = 1)	0.1135
P(X >= 2)	0.8532
Verificacion con ppois()	0.8532

# - Inciso b) P(X > 1) en una hora

Ver código

lambda_b <- 6.8

p_x0_b <- dpois(0, lambda = lambda_b)
p_x1_b <- dpois(1, lambda = lambda_b)
p_b    <- 1 - (p_x0_b + p_x1_b)

cat("Lambda (1 hora) =", lambda_b, "\n")

Lambda (1 hora) = 6.8

Ver código

cat("P(X = 0) =", round(p_x0_b, 4), "\n")

P(X = 0) = 0.0011

Ver código

cat("P(X = 1) =", round(p_x1_b, 4), "\n")

P(X = 1) = 0.0076

Ver código

cat("P(X > 1) =", round(p_b, 4), "\n\n")

P(X > 1) = 0.9913

Ver código

# Verificacion
cat("Verificacion ppois:", round(ppois(1, lambda_b, lower.tail = FALSE), 4), "\n\n")

Verificacion ppois: 0.9913

Ver código

# Crear tabla
tabla12 <- data.frame(
  Evento = c("Lambda (1 hora)",
             "P(X = 0)",
             "P(X = 1)",
             "P(X > 1)",
             "Verificacion con ppois()"),
  
  Resultado = c(round(lambda_b, 4),
                round(p_x0_b, 4),
                round(p_x1_b, 4),
                round(p_b, 4),
                round(ppois(1, lambda_b, lower.tail = FALSE), 4))
)

# Mostrar tabla con colores y bordes
kable(tabla12,
      caption = "Resultados de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkorange") %>%
  
  row_spec(1:nrow(tabla12),
           background = c("#EBF5FB", "#D6EAF8"))

Resultados de la distribución de Poisson
Evento	Resultado
Lambda (1 hora)	6.8000
P(X = 0)	0.0011
P(X = 1)	0.0076
P(X > 1)	0.9913
Verificacion con ppois()	0.9913

Grafica

Ver código

x <- seq(0, 15, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda_b,
  sd = sqrt(lambda_b)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x >= 1.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Media
  geom_vline(
    xintercept = lambda_b,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Llegada de clientes por hora",
    x = "Número de clientes",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

) En la primera media hora lleguen por lo menos 2 clientes: Con una tasa ajustada de 3.4 clientes por media hora, la probabilidad de que lleguen al menos 2 clientes en los primeros 30 minutos es de 0.8531, es decir un 85.31%. Esto indica que es muy probable que durante la primera media hora de la exhibición ya haya una afluencia considerable de visitantes, lo que sugiere que el personal debe estar preparado desde el inicio del evento.

En cualquier hora dada llegue más de un cliente: Manteniendo la tasa original de 6.8 clientes por hora, la probabilidad de que lleguen más de un cliente en cualquier hora es de 0.9913, es decir un 99.13%. Este resultado es prácticamente una certeza, lo que significa que en casi cualquier hora de la exhibición se puede esperar la llegada de al menos 2 clientes.

Conclusión general: Dado que los clientes llegan a razón de 6.8 por hora, la exhibición mantiene un flujo constante y elevado de visitantes. La probabilidad de tener al menos 2 clientes es altísima tanto en media hora (85.31%) como en una hora completa (99.13%), lo que refleja que la exhibición tiene una demanda sostenida y que es prácticamente imposible que transcurra una hora sin recibir más de un visitante. Esto es relevante para la planificación del personal y la logística del evento.

Ejercicio 8.

El número promedio de urgencias que llega a un hospital en una hora es de 12. Cuál es la probabilidad de que en un minuto lleguen por lo menos 2 urgencias. ¿Cuál es el número de urgencias esperado por minuto?

Distribución de Poisson ajustando la tasa: Tasa original: 12 urgencias/hora Ajuste a 1 minuto: λ = 12 / 60 = 0.2 urgencias por minuto

Ver código

lambda <- 12 / 60  # = 0.2 urgencias por minuto

cat("Lambda (1 minuto) =", lambda, "\n\n")

Lambda (1 minuto) = 0.2

Ver código

# --- P(X >= 2): por lo menos 2 urgencias en 1 minuto ---
p_x0 <- dpois(0, lambda = lambda)
p_x1 <- dpois(1, lambda = lambda)
p_resultado <- 1 - (p_x0 + p_x1)

cat("P(X = 0) =", round(p_x0, 4), "\n")

P(X = 0) = 0.8187

Ver código

cat("P(X = 1) =", round(p_x1, 4), "\n")

P(X = 1) = 0.1637

Ver código

cat("P(X >= 2) =", round(p_resultado, 4), "\n\n")

P(X >= 2) = 0.0175

Ver código

# Verificacion
cat("Verificacion ppois:", round(ppois(1, lambda, lower.tail = FALSE), 4), "\n\n")

Verificacion ppois: 0.0175

Ver código

# --- Numero esperado de urgencias por minuto ---
esperado <- lambda
cat("Numero esperado de urgencias por minuto:", esperado, "\n")

Numero esperado de urgencias por minuto: 0.2

Ver código

# Crear tabla
tabla13 <- data.frame(
  Evento = c("Lambda (1 minuto)",
             "P(X = 0)",
             "P(X = 1)",
             "P(X >= 2)",
             "Verificacion con ppois()",
             "Numero esperado de urgencias"),
  
  Resultado = c(round(lambda, 4),
                round(p_x0, 4),
                round(p_x1, 4),
                round(p_resultado, 4),
                round(ppois(1, lambda, lower.tail = FALSE), 4),
                round(esperado, 4))
)

# Mostrar tabla con colores y bordes
kable(tabla13,
      caption = "Resultados de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkgreen") %>%
  
  row_spec(1:nrow(tabla13),
           background = c("#E8F8F5", "#D1F2EB"))

Resultados de la distribución de Poisson
Evento	Resultado
Lambda (1 minuto)	0.2000
P(X = 0)	0.8187
P(X = 1)	0.1637
P(X >= 2)	0.0175
Verificacion con ppois()	0.0175
Numero esperado de urgencias	0.2000

Grafica

Ver código

x <- seq(0, 6, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda,
  sd = sqrt(lambda)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x >= 1.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = lambda,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Urgencias por minuto",
    x = "Número de urgencias",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

A nivel de minuto, el flujo de urgencias es muy bajo y esporádico, con una probabilidad mínima (1.76%) de recibir 2 o más casos simultáneamente. Sin embargo, visto en perspectiva horaria, el hospital enfrenta una demanda constante de 12 urgencias por hora, lo que exige una planificación eficiente del personal y los recursos para responder oportunamente a cada caso que se presente.

Ejercicio 9.

Las estadísticas indican que en una fábrica se presentan en promedio 10 accidentes por trimestre. Determine la probabilidad de que no haya más de 12 accidentes en el último trimestre.

P(X <= 12): no mas de 12 accidentes

Ver código

lambda <- 10

# -- ---
p_resultado <- ppois(12, lambda = lambda)

cat("Lambda =", lambda, "\n\n")

Lambda = 10

Ver código

# Calculo manual
for(k in 0:12){
  cat("P(X =", k, ") =", round(dpois(k, lambda), 4), "\n")
}

P(X = 0 ) = 0 
P(X = 1 ) = 5e-04 
P(X = 2 ) = 0.0023 
P(X = 3 ) = 0.0076 
P(X = 4 ) = 0.0189 
P(X = 5 ) = 0.0378 
P(X = 6 ) = 0.0631 
P(X = 7 ) = 0.0901 
P(X = 8 ) = 0.1126 
P(X = 9 ) = 0.1251 
P(X = 10 ) = 0.1251 
P(X = 11 ) = 0.1137 
P(X = 12 ) = 0.0948

Ver código

cat("\nP(X <= 12) =", round(p_resultado, 4), "\n")


P(X <= 12) = 0.7916

Ver código

# Crear vector de valores
x <- 0:12

# Calcular probabilidades
probabilidades <- round(dpois(x, lambda), 4)

# Crear tabla de probabilidades
tabla14 <- data.frame(
  Evento = paste("P(X =", x, ")"),
  Probabilidad = probabilidades
)

# Mostrar tabla de probabilidades
kable(tabla14,
      caption = "Probabilidades individuales de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkred") %>%
  
  row_spec(1:nrow(tabla14),
           background = c("#FDEDEC", "#FADBD8"))

Probabilidades individuales de la distribución de Poisson
Evento	Probabilidad
P(X = 0 )	0.0000
P(X = 1 )	0.0005
P(X = 2 )	0.0023
P(X = 3 )	0.0076
P(X = 4 )	0.0189
P(X = 5 )	0.0378
P(X = 6 )	0.0631
P(X = 7 )	0.0901
P(X = 8 )	0.1126
P(X = 9 )	0.1251
P(X = 10 )	0.1251
P(X = 11 )	0.1137
P(X = 12 )	0.0948

Ver código

# Tabla resumen
tabla15 <- data.frame(
  Concepto = c("Lambda",
               "P(X <= 12)"),
  
  Resultado = c(round(lambda, 4),
                round(p_resultado, 4))
)

# Mostrar tabla resumen
kable(tabla15,
      caption = "Resultado acumulado de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue") %>%
  
  row_spec(1:nrow(tabla15),
           background = c("#EBF5FB", "#D6EAF8"))

Resultado acumulado de la distribución de Poisson
Concepto	Resultado
Lambda	10.0000
P(X <= 12)	0.7916

Grafica

Ver código

x <- seq(0, 20, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda,
  sd = sqrt(lambda)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 12.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = lambda,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Accidentes por trimestre",
    x = "Número de accidentes",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Con una tasa promedio de 10 accidentes por trimestre, la fábrica enfrenta un riesgo considerable en materia de seguridad laboral. Sin embargo, existe una probabilidad alta (79.16%) de que el número de accidentes no supere los 12 en un trimestre dado, lo que indica que los casos extremos por encima de este valor son relativamente poco frecuentes. Aun así, desde una perspectiva de gestión de riesgos, una media de 10 accidentes trimestrales equivale a más de 40 accidentes al año, lo que representa una señal de alerta importante para implementar medidas preventivas y mejorar las condiciones de seguridad en la planta.

Ejercicio 10.

El número de personas que ingresan a la unidad de cuidados intensivos de un hospital en un día cualquiera, es de 5 personas diarias. ¿Cuál es la probabilidad de que el número de personas que ingresan a la unidad de cuidados intensivos en un día particular sea menor o igual a 2 personas?

Distribución de Poisson! Sin ajuste de tasa: Tasa: λ = 5 personas por día Buscamos P(X ≤ 2)

Ver código

lambda <- 5

# --- P(X <= 2): menor o igual a 2 ingresos ---
p_x0 <- dpois(0, lambda = lambda)
p_x1 <- dpois(1, lambda = lambda)
p_x2 <- dpois(2, lambda = lambda)

p_resultado <- p_x0 + p_x1 + p_x2

cat("Lambda =", lambda, "\n\n")

Lambda = 5

Ver código

cat("P(X = 0) =", round(p_x0, 4), "\n")

P(X = 0) = 0.0067

Ver código

cat("P(X = 1) =", round(p_x1, 4), "\n")

P(X = 1) = 0.0337

Ver código

cat("P(X = 2) =", round(p_x2, 4), "\n")

P(X = 2) = 0.0842

Ver código

cat("P(X <= 2) =", round(p_resultado, 4), "\n\n")

P(X <= 2) = 0.1247

Ver código

# Verificacion
cat("Verificacion ppois:", round(ppois(2, lambda), 4), "\n")

Verificacion ppois: 0.1247

Ver código

# Crear tabla
tabla16 <- data.frame(
  Evento = c("Lambda",
             "P(X = 0)",
             "P(X = 1)",
             "P(X = 2)",
             "P(X <= 2)",
             "Verificacion con ppois()"),
  
  Resultado = c(round(lambda, 4),
                round(p_x0, 4),
                round(p_x1, 4),
                round(p_x2, 4),
                round(p_resultado, 4),
                round(ppois(2, lambda), 4))
)

# Mostrar tabla con colores y bordes
kable(tabla16,
      caption = "Resultados de la distribución de Poisson",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkmagenta") %>%
  
  row_spec(1:nrow(tabla16),
           background = c("#F5EEF8", "#EBDEF0"))

Resultados de la distribución de Poisson
Evento	Resultado
Lambda	5.0000
P(X = 0)	0.0067
P(X = 1)	0.0337
P(X = 2)	0.0842
P(X <= 2)	0.1247
Verificacion con ppois()	0.1247

Grafica

Ver código

x <- seq(0, 15, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda,
  sd = sqrt(lambda)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 2.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = lambda,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Ingresos diarios a UCI",
    x = "Número de personas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Con una tasa promedio de 5 ingresos diarios, la UCI opera bajo una demanda constante y elevada. La baja probabilidad de recibir 2 o menos pacientes en un día (12.47%) indica que la unidad debe estar preparada la mayor parte del tiempo para atender 3 o más ingresos diarios. Esto resalta la importancia de mantener una disponibilidad adecuada de camas, personal médico y recursos en la UCI, ya que la probabilidad de días con baja ocupación es reducida y no puede asumirse como la norma en la planificación hospitalaria.

Ejercicio 11.

Un jefe de almacén sabe que 6 de las 25 bicicletas que tiene para la venta presentan fallas en los frenos y necesitan ajuste. Si el vendedor que no tenía conocimiento de lo anterior vendió en el día 4 bicicletas, ¿cuál es la probabilidad de que vendiera dos de las que requerían ajuste.

Este es un problema de distribución Hipergeométrica Ya que se selecciona una muestra sin reemplazo de una población finita:

N = 25 bicicletas en total K = 6 bicicletas con fallas n = 4 bicicletas vendidas Buscamos P(X = 2)

Ver código

N <- 25   # total de bicicletas
K <- 6    # bicicletas con fallas
n <- 4    # bicicletas vendidas

# --- P(X = 2): exactamente 2 con fallas ---
p_resultado <- dhyper(2, m = K, n = N - K, k = n)

cat("N =", N, "\n")

N = 25

Ver código

cat("K =", K, "(con fallas)\n")

K = 6 (con fallas)

Ver código

cat("n =", n, "(vendidas)\n\n")

n = 4 (vendidas)

Ver código

cat("P(X = 2) =", round(p_resultado, 4), "\n")

P(X = 2) = 0.2028

Ver código

# Distribucion completa
cat("\nDistribucion completa:\n")


Distribucion completa:

Ver código

for(x in 0:4){
  cat("P(X =", x, ") =", round(dhyper(x, m = K, n = N - K, k = n), 4), "\n")
}

P(X = 0 ) = 0.3064 
P(X = 1 ) = 0.4596 
P(X = 2 ) = 0.2028 
P(X = 3 ) = 0.03 
P(X = 4 ) = 0.0012

Ver código

# Crear distribución completa
x <- 0:4
probabilidades <- round(dhyper(x, m = K, n = N - K, k = n), 4)

# Tabla principal
tabla17 <- data.frame(
  Concepto = c("N (total bicicletas)",
               "K (bicicletas con fallas)",
               "n (bicicletas vendidas)",
               "P(X = 2)"),
  
  Resultado = c(N,
                K,
                n,
                round(p_resultado, 4))
)

# Mostrar tabla principal
kable(tabla17,
      caption = "Resultados de la distribución hipergeométrica",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkgreen") %>%
  
  row_spec(1:nrow(tabla17),
           background = c("#E8F8F5", "#D1F2EB"))

Resultados de la distribución hipergeométrica
Concepto	Resultado
N (total bicicletas)	25.0000
K (bicicletas con fallas)	6.0000
n (bicicletas vendidas)	4.0000
P(X = 2)	0.2028

Ver código

# Tabla de distribución completa
tabla18 <- data.frame(
  Evento = paste("P(X =", x, ")"),
  Probabilidad = probabilidades
)

# Mostrar tabla distribución
kable(tabla18,
      caption = "Distribución completa",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue") %>%
  
  row_spec(1:nrow(tabla18),
           background = c("#EBF5FB", "#D6EAF8"))

Distribución completa
Evento	Probabilidad
P(X = 0 )	0.3064
P(X = 1 )	0.4596
P(X = 2 )	0.2028
P(X = 3 )	0.0300
P(X = 4 )	0.0012

Grafica

Ver código

media <- n * (K / N)

desv <- sqrt(
  n * (K/N) * (1 - K/N) *
  ((N - n)/(N - 1))
)

# Valores
x_vals <- seq(0, 4, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x_vals,
  mean = media,
  sd = desv
)

datos <- data.frame(x_vals, y)

# Gráfica
ggplot(datos,
       aes(x = x_vals, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos,
                  x_vals >= 1.5 &
                  x_vals <= 2.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Hipergeométrica Aproximada",
    subtitle = "Bicicletas con fallas en frenos",
    x = "Número de bicicletas defectuosas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

Resultado: P(X = 2) = 0.2028 → 20.28%

Ejercicio 12.

De un grupo de 20 ingenieros con doctorado, se seleccionan 10 para un alto cargo de una compañía. ¿Cuál es la probabilidad de que los 10 seleccionados incluya a los 5 ingenieros que tienen las mejores calificaciones del grupo de 20?

N=20 → total de ingenieros K=5 → ingenieros con mejores calificaciones n=10 → ingenieros seleccionados Queremos que los 10 seleccionados incluyan a los 5 mejores.

La probabilidad se calcula con distribución hipergeométrica:

Ver código

# Datos
N <- 20
K <- 5
n <- 10

# Probabilidad de incluir a los 5 mejores
p_resultado <- dhyper(5, m = K, n = N - K, k = n)

# Mostrar resultado
cat("P(X = 5) =", round(p_resultado, 6), "\n")

P(X = 5) = 0.016254

-Grafica

Ver código

media <- n * (K / N)

# Desviación estándar
desv <- sqrt(
  n * (K/N) * (1 - K/N) *
  ((N - n)/(N - 1))
)

# Valores
x_vals <- seq(0, 10, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x_vals,
  mean = media,
  sd = desv
)

datos <- data.frame(x_vals, y)

# Gráfica
ggplot(datos,
       aes(x = x_vals, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos,
                  x_vals >= 4.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva Gaussiana
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Hipergeométrica Aproximada",
    subtitle = "Selección de ingenieros",
    x = "Número de mejores ingenieros incluidos",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que en la selección de 10 ingenieros queden incluidos exactamente los 5 ingenieros con las mejores calificaciones es aproximadamente: P(X=5)≈0.0163P(X = 5) 0.0163P(X=5)≈0.0163 Esto significa que existe solamente un 1.63% de probabilidad de que los cinco ingenieros más destacados sean seleccionados dentro del grupo de 10 elegidos al azar. Por lo tanto, se concluye que este evento es poco probable, ya que la posibilidad de que todos los mejores ingenieros sean incluidos en la selección es bastante baja.

Ejercicio 13.

Un almacén contiene diez maquinas impresoras, cuatro de las cuales están defectuosas. Una compañía selecciona al azar cinco de las maquinas, pensando que todas están en condiciones de trabajar, ¿cuál es la probabilidad de que las cinco maquinas estén en buen estado?

Datos:

Total de máquinas: N=10 Máquinas defectuosas: 4 Máquinas en buen estado: 6 Máquinas seleccionadas: n=5

Ver código

# Datos
N <- 10
buenas <- 6
n <- 5

# Probabilidad de seleccionar 5 buenas
p_resultado <- dhyper(5,
                      m = buenas,
                      n = N - buenas,
                      k = n)

# Mostrar resultado
cat("P(X = 5) =", round(p_resultado, 4), "\n")

P(X = 5) = 0.0238

-Grafica

Ver código

media <- n * (K / N)

# Desviación estándar
desv <- sqrt(
  n * (K/N) * (1 - K/N) *
  ((N - n)/(N - 1))
)

# Valores
x_vals <- seq(0, 5, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x_vals,
  mean = media,
  sd = desv
)

datos <- data.frame(x_vals, y)

# Gráfica
ggplot(datos,
       aes(x = x_vals, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos,
                  x_vals >= 4.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = media,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Hipergeométrica Aproximada",
    subtitle = "Selección de impresoras en buen estado",
    x = "Número de máquinas buenas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que las cinco máquinas seleccionadas estén en buen estado es aproximadamente:

P(X=5)≈0.0238

Esto significa que existe solamente un 2.38% de probabilidad de seleccionar cinco máquinas totalmente funcionales, por lo que el evento es poco probable debido a la cantidad de máquinas defectuosas presentes en el almacén.

Ejercicio 14.

En promedio una casa de cada 2000 en cierta zona de Barranquilla se incendia durante el año, si hay 6000 casas en dicha zona ¿Cuál es la probabilidad de que más de 3 casas se incendien durante el año?

Este problema se resuelve con la distribución geométrica, porque se busca la probabilidad de obtener el primer éxito antes de cierto número de intentos.

Datos:

Probabilidad de aprobar: p=0.7 Probabilidad de fallar: q=1−p=0.3

Queremos encontrar la probabilidad de que el estudiante apruebe antes del cuarto intento, es decir:

P(X<4)

Equivale a aprobar en el intento 1, 2 o 3:

Este problema se resuelve con la distribución geométrica, porque se busca la probabilidad de obtener el primer éxito antes de cierto número de intentos.

Datos:

Probabilidad de aprobar: p=0.7 Probabilidad de fallar: q=1−p=0.3

Queremos encontrar la probabilidad de que el estudiante apruebe antes del cuarto intento, es decir:

P(X<4)

Equivale a aprobar en el intento 1, 2 o 3:

P(X<4)=1−P(X≥4) P(X<4)=1−q 3 P(X<4)=1−(0.3) 3 P(X<4)=1−0.027 P(X<4)=0.973

Ver código

# Datos
p <- 0.7
q <- 1 - p

# Probabilidad de aprobar antes del 4 intento
p_resultado <- 1 - (q^3)

# Mostrar resultado
cat("P(X < 4) =", round(p_resultado, 4), "\n")

P(X < 4) = 0.973

Grafica

Ver código

x <- seq(0, 10, length = 1000)

# Curva normal aproximada
y <- dnorm(
  x,
  mean = lambda,
  sd = sqrt(lambda)
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x >= 3.5),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = lambda,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución de Poisson Aproximada",
    subtitle = "Incendios en viviendas",
    x = "Número de casas incendiadas",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que el estudiante apruebe la prueba antes del cuarto intento es:

P(X<4)=0.973

Es decir, existe un 97.3% de probabilidad de que el estudiante logre aprobar el examen en alguno de sus primeros tres intentos.

Ejercicio 15.

La probabilidad de que un estudiante de aviación pase la prueba escrita para obtener su licencia de piloto privado es de 0.7. encuentre la probabilidad de que una persona pase la prueba antes del cuarto intento.

Este ejercicio se resuelve utilizando la distribución geométrica, ya que se analiza el número de intentos necesarios hasta obtener el primer éxito.

Datos:

Este ejercicio se resuelve utilizando la distribución geométrica, ya que se analiza el número de intentos necesarios hasta obtener el primer éxito.

Datos:

Probabilidad de aprobar: p=0.7 Probabilidad de reprobar: q=1−p=0.3

Se pide la probabilidad de que la persona apruebe antes del cuarto intento, es decir, en el intento 1, 2 o 3.

P(X<4)=1−P(X≥4)

La probabilidad de llegar al cuarto intento significa fallar tres veces seguidas:

P(X≥4)=q 3

Entonces:

P(X<4)=1−(0.3) 3 P(X<4)=1−0.027 P(X<4)=0.973

Ver código

# Datos
p <- 0.7
q <- 1 - p

# Probabilidad de aprobar antes del cuarto intento
p_resultado <- 1 - (q^3)

# Mostrar resultado
cat("P(X < 4) =", round(p_resultado, 4), "\n")

P(X < 4) = 0.973

-Grafica

Ver código

x <- seq(1, 8, length = 1000)

# Aproximación suavizada
y <- dnorm(
  x,
  mean = 1/p,
  sd = sqrt((1-p)/(p^2))
)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada
  geom_area(
    data = subset(datos, x <= 3),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea media
  geom_vline(
    xintercept = 1/p,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(
    title = "Distribución Geométrica Aproximada",
    subtitle = "Intentos para aprobar examen",
    x = "Número de intentos",
    y = "Densidad de probabilidad"
  ) +

  theme_minimal(base_size = 15)

La probabilidad de que el estudiante apruebe la prueba antes del cuarto intento es:

0.973

Es decir, existe un 97.3% de probabilidad de que la persona logre aprobar el examen en alguno de sus primeros tres intentos.

3 Ejercicios de Distribución ji-cuadrada

La distribución Ji Cuadrado o Chi-Cuadrado es una distribución de probabilidad continua utilizada principalmente en estadística para analizar variaciones y comprobar hipótesis.

Se representa por:

χ2

y depende de un parámetro llamado grados de libertad (gl).

Características principales Solo toma valores positivos. Su gráfica tiene forma asimétrica hacia la derecha. A medida que aumentan los grados de libertad, la curva se parece más a una distribución normal. Usos principales

La distribución Ji Cuadrado se utiliza para:

Pruebas de independencia en tablas de contingencia. Pruebas de bondad de ajuste. Análisis de varianza y estimación de varianzas poblacionales. Ejemplo sencillo

Se puede usar para verificar si existe relación entre:

género y preferencia de producto, enfermedad y tratamiento, o cualquier comparación entre variables categóricas.

Ejercicio 1

Para una distribución chi-cuadrada encuentre:

2 0.02 2 0.10 2 0.05

cuando v = 18. cuando v = 9. cuando v = 30.

Ver código

# 1)
chi_1 <- qchisq(0.02, df = 18)

# 2)
chi_2 <- qchisq(0.10, df = 9)

# 3)
chi_3 <- qchisq(0.05, df = 30)

# Resultados
cat("Chi-cuadrada 0.02 con v=18 =", round(chi_1,4), "\n")

Chi-cuadrada 0.02 con v=18 = 7.9062

Ver código

cat("Chi-cuadrada 0.10 con v=9 =", round(chi_2,4), "\n")

Chi-cuadrada 0.10 con v=9 = 4.1682

Ver código

cat("Chi-cuadrada 0.05 con v=30 =", round(chi_3,4), "\n")

Chi-cuadrada 0.05 con v=30 = 18.4927

GRÁFICA DISTRIBUCIÓN ji-CUADRADA

Ver código

library(ggplot2)

# Valores
x <- seq(0, 60, length = 1000)

# Distribución chi-cuadrada
y <- dchisq(x, df = 18)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  geom_line(
    color = "#154360",
    linewidth = 1.5
  ) +

  geom_area(
    data = subset(datos, x <= 8.2307),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  labs(
    title = "Distribución Chi-cuadrada",
    subtitle = "v = 18",
    x = expression(chi^2),
    y = "Densidad"
  ) +

  theme_minimal(base_size = 15)

La distribución Chi-cuadrada permitió determinar los valores críticos asociados a diferentes probabilidades y grados de libertad.

Los resultados obtenidos fueron: Chi-cuadrada 0.02 con v=18 = 7.9062 Chi-cuadrada 0.10 con v=9 = 4.1682 Chi-cuadrada 0.05 con v=30 = 18.4927

Estos valores son utilizados frecuentemente en pruebas de hipótesis, análisis de varianza y pruebas de independencia estadística.

Ejercicio 2 Para una distribución chi-cuadrada encuentre χ2

tal que:

P (X2 > χ2 ) = 0.97 cuando v = 6.
P (X2 > χ2 ) = 0.01 cuando v = 22.
P (42.980 < X2 < χ2 ) = 0.035 cuando v = 28

P(X2>χ2)=0.97 cuando v=6

Paso 1: Transformar la probabilidad

Ver código

qchisq(0.03, df = 6)

[1] 1.329608

paso 2: Buscar el valor crítico

Ver código

qchisq(0.03, df = 6)

[1] 1.329608

P(X2>χ2)=0.01 cuando v=22

Paso 1

P(X^2<)=1-0.01

paso 2:

Ver código

qchisq(0.99, df = 22)

[1] 40.28936

P(42.980<X2<χ2)=0.035 cuando v=28

Paso 1: Hallar la probabilidad acumulada en 42.980

Ver código

pchisq(42.980, df = 28)

[1] 0.9650395

Paso 2: Sumar la probabilidad faltante

0.9581+0.035=0.9931

Paso 3: Buscar el nuevo valor crítico

Ver código

qchisq(0.9931, df = 28)

[1] 49.7475

Ver código

chi_a <- qchisq(0.03, df = 6)


chi_b <- qchisq(0.99, df = 22)



p_inicial <- pchisq(42.980, df = 28)

p_total <- p_inicial + 0.035

chi_c <- qchisq(p_total, df = 28)



cat("a) =", round(chi_a,4), "\n")

a) = 1.3296

Ver código

cat("b) =", round(chi_b,4), "\n")

b) = 40.2894

Ver código

cat("c) =", round(chi_c,4), "\n")

c) = NaN

GRÁFICA CHI-CUADRADA

Ver código

library(ggplot2)

# Valores
x <- seq(0, 70, length = 1000)

# Distribución
y <- dchisq(x, df = 28)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  geom_line(
    color = "#154360",
    linewidth = 1.5
  ) +

  geom_area(
    data = subset(datos,
                  x >= 42.980 &
                  x <= 49.5874),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  labs(
    title = "Distribución Chi-cuadrada",
    subtitle = "v = 28",
    x = expression(chi^2),
    y = "Densidad"
  ) +

  theme_minimal(base_size = 15)

La distribución Chi-cuadrada permitió calcular valores críticos asociados a probabilidades acumuladas y áreas de cola.

Los resultados obtenidos fueron: a) = 1.3296 b) = 40.2894 c) = NaN

Estos valores son fundamentales en pruebas de hipótesis, análisis de independencia y estudios estadísticos inferenciales.

Ejercicio 3

La distribución t de Student se utiliza cuando:

La muestra es pequeña. La desviación estándar poblacional es desconocida. Se trabaja con inferencia estadística.

Encontrar P(T<1.895) cuando v=10

Ver código

pt(1.895, df = 10)

[1] 0.9563303

Encontrar P(T>1.742) cuando v=20

Ver código

1 - pt(1.742, df = 20)

[1] 0.04843377

Encontrar P(−1.645<T<2.315) cuando v=15 Fórmula

Ver código

pt(2.315, df = 15) -
pt(-1.645, df = 15)

[1] 0.9220269

Encontrar P(T>−1.985) cuando v=14

Ver código

1 - pt(-1.985, df = 14)

[1] 0.9664522

Ver código

a <- pt(1.895, df = 10)

# b)
b <- 1 - pt(1.742, df = 20)

# c)
c <- pt(2.315, df = 15) -
     pt(-1.645, df = 15)

# d)
d <- 1 - pt(-1.985, df = 14)

# Resultados
cat("a) =", round(a,4), "\n")

a) = 0.9563

Ver código

cat("b) =", round(b,4), "\n")

b) = 0.0484

Ver código

cat("c) =", round(c,4), "\n")

c) = 0.922

Ver código

cat("d) =", round(d,4), "\n")

d) = 0.9665

GRÁFICA t DE STUDENT

Ver código

library(ggplot2)

# Valores
x <- seq(-5, 5, length = 1000)

# Densidad t
y <- dt(x, df = 15)

datos <- data.frame(x, y)

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  geom_line(
    color = "#154360",
    linewidth = 1.5
  ) +

  geom_area(
    data = subset(datos,
                  x >= -1.645 &
                  x <= 2.315),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "v = 15",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 15)

La distribución t de Student permitió calcular probabilidades acumuladas y áreas entre intervalos para diferentes grados de libertad.

Los resultados obtenidos fueron: a) = 0.9563 b) = 0.0484 c) = 0.922 d) = 0.9665

Estas probabilidades son ampliamente utilizadas en pruebas de hipótesis, intervalos de confianza y análisis estadísticos con muestras pequeñas.

Ejercicio 4

Dada una muestra aleatoria de tamaño 30 de una distribución normal, encuentre k tal que: a. P (−1.725 < T < k) = 0.945 b. P (k < T < 2.415) = 0.085 c. P (−k < T < k) = 0.92

4 Distribución t de student

La distribución t de Student es una distribución de probabilidad continua utilizada en estadística para trabajar con muestras pequeñas y cuando la desviación estándar de la población es desconocida.

Fue desarrollada por William Sealy Gosset bajo el seudónimo “Student”.

Características principales Tiene forma de campana, similar a la distribución normal. Es más ancha y con colas más largas que la normal. Depende de los grados de libertad (gl). A medida que aumentan los grados de libertad, la distribución t se parece cada vez más a la distribución normal. ¿Cuándo se utiliza?

Se usa principalmente cuando:

la muestra es pequeña (n<30), no se conoce la desviación estándar poblacional, y se desea realizar inferencias sobre medias. Aplicaciones principales

La distribución t de Student se utiliza en:

pruebas de hipótesis, intervalos de confianza, comparación de medias, análisis estadístico de muestras pequeñas

Ver código

# ==================================================
# 
# ==================================================

# Grados de libertad
v <- 29

# --------------------------------------------------
# a)
# --------------------------------------------------

p1 <- pt(-1.725, df = v)

k_a <- qt(0.945 + p1, df = v)

# --------------------------------------------------
# b)
# --------------------------------------------------

p2 <- pt(2.415, df = v)

k_b <- qt(p2 - 0.085, df = v)

# --------------------------------------------------
# c)
# --------------------------------------------------

k_c <- qt(0.96, df = v)

# --------------------------------------------------
# Resultados
# --------------------------------------------------

cat("a) k =", round(k_a,4), "\n")

a) k = 2.5909

Ver código

cat("b) k =", round(k_b,4), "\n")

b) k = 1.335

Ver código

cat("c) k =", round(k_c,4), "\n")

c) k = 1.8142

GRÁFICA t DE STUDENT

Ver código

library(ggplot2)

# Valores en el eje X
x <- seq(-5, 5, length = 1000)

# Densidad t de Student
y <- dt(x, df = 29)

# Data frame
datos <- data.frame(x, y)

# Valor k
k <- 1.8070

# Gráfica
ggplot(datos, aes(x = x, y = y)) +

  # Área sombreada entre -k y k
  geom_area(
    data = subset(datos, x >= -k & x <= k),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  # Curva t
  geom_line(
    color = "#154360",
    linewidth = 1.5
  ) +

  # Líneas verticales
  geom_vline(
    xintercept = c(-k, k),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  # Etiquetas
  labs(
    title = "Distribución t de Student",
    subtitle = "P(-k < T < k) = 0.92",
    x = "Valores t",
    y = "Densidad"
  ) +

  # Tema profesional
  theme_minimal(base_size = 15)

La distribución t de Student permitió determinar los valores críticos (k) asociados a diferentes probabilidades en una muestra aleatoria de tamaño 30, utilizando (v = 29) grados de libertad.

Los resultados obtenidos fueron: a) k = 2.5909 b) k = 1.335 c) k = 1.8142

Estos resultados permiten identificar regiones de probabilidad dentro de la distribución t de Student, siendo fundamentales en inferencia estadística, construcción de intervalos de confianza y pruebas de hipótesis cuando el tamaño de muestra es pequeño y la desviación estándar poblacional es desconocida.

La gráfica ayudó a visualizar el área de probabilidad central comprendida entre los valores críticos (-k) y (k).

Distribucion T de Student

Ejercicio: 1 Encuentre las siguientes probabilidades utilizando la distribución t de Student: a. Encuentre P (T < 1.895) cuando v = 10. b. Encuentre P (T > 1.742) cuando v = 20. c. Encuentre P (−1.645 < T < 2.315) cuando v = 15. d. Encuentre P (T > −1.985) cuando v = 14.

Ver código

# =========================================================
# DISTRIBUCIÓN t DE STUDENT
# PROBABILIDADES Y GRÁFICAS
# =========================================================

# =========================================================
# LIBRERÍAS
# =========================================================

library(ggplot2)
library(dplyr)
library(kableExtra)

# =========================================================
# INCISO A
# P(T < 1.895) cuando gl = 10
# =========================================================

v_a <- 10

# Probabilidad
p_a <- pt(1.895, df = v_a)

cat("\n====================================\n")


====================================

Ver código

cat("INCISO A\n")

INCISO A

Ver código

cat("P(T < 1.895) =", round(p_a,4), "\n")

P(T < 1.895) = 0.9563

Ver código

cat("====================================\n")

====================================

Ver código

# Datos para gráfica
x_a <- seq(-5, 5, by = 0.01)

df_a <- data.frame(
  x = x_a,
  dens = dt(x_a, df = v_a)
)

# Gráfica
ggplot(df_a, aes(x, dens)) +

  geom_area(
    data = subset(df_a, x <= 1.895),
    fill = "#1D9E75",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = 1.895,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(T < 1.895), gl = 10",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# =========================================================
# INCISO B
# P(T > 1.742) cuando gl = 20
# =========================================================

v_b <- 20

# Probabilidad
p_b <- 1 - pt(1.742, df = v_b)

cat("\n====================================\n")


====================================

Ver código

cat("INCISO B\n")

INCISO B

Ver código

cat("P(T > 1.742) =", round(p_b,4), "\n")

P(T > 1.742) = 0.0484

Ver código

cat("====================================\n")

====================================

Ver código

# Datos para gráfica
x_b <- seq(-5, 5, by = 0.01)

df_b <- data.frame(
  x = x_b,
  dens = dt(x_b, df = v_b)
)

# Gráfica
ggplot(df_b, aes(x, dens)) +

  geom_area(
    data = subset(df_b, x >= 1.742),
    fill = "#D85A30",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = 1.742,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(T > 1.742), gl = 20",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# =========================================================
# INCISO C
# P(-1.645 < T < 2.315) cuando gl = 15
# =========================================================

v_c <- 15

# Probabilidad
p_c <- pt(2.315, df = v_c) -
       pt(-1.645, df = v_c)

cat("\n====================================\n")


====================================

Ver código

cat("INCISO C\n")

INCISO C

Ver código

cat("P(-1.645 < T < 2.315) =",
    round(p_c,4), "\n")

P(-1.645 < T < 2.315) = 0.922

Ver código

cat("====================================\n")

====================================

Ver código

# Datos para gráfica
x_c <- seq(-5, 5, by = 0.01)

df_c <- data.frame(
  x = x_c,
  dens = dt(x_c, df = v_c)
)

# Gráfica
ggplot(df_c, aes(x, dens)) +

  geom_area(
    data = subset(
      df_c,
      x >= -1.645 & x <= 2.315
    ),
    fill = "#2E8B57",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = c(-1.645, 2.315),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(-1.645 < T < 2.315), gl = 15",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# =========================================================
# INCISO D
# P(T > -1.985) cuando gl = 14
# =========================================================

v_d <- 14

# Probabilidad
p_d <- 1 - pt(-1.985, df = v_d)

cat("\n====================================\n")


====================================

Ver código

cat("INCISO D\n")

INCISO D

Ver código

cat("P(T > -1.985) =",
    round(p_d,4), "\n")

P(T > -1.985) = 0.9665

Ver código

cat("====================================\n")

====================================

Ver código

# Datos para gráfica
x_d <- seq(-5, 5, by = 0.01)

df_d <- data.frame(
  x = x_d,
  dens = dt(x_d, df = v_d)
)

# Gráfica
ggplot(df_d, aes(x, dens)) +

  geom_area(
    data = subset(df_d, x >= -1.985),
    fill = "#3498DB",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = -1.985,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(T > -1.985), gl = 14",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# =========================================================
# TABLA RESUMEN
# =========================================================

tabla_resultados <- data.frame(

  Inciso = c("a", "b", "c", "d"),

  Probabilidad = c(
    "P(T < 1.895)",
    "P(T > 1.742)",
    "P(-1.645 < T < 2.315)",
    "P(T > -1.985)"
  ),

  Resultado = c(
    round(p_a,4),
    round(p_b,4),
    round(p_c,4),
    round(p_d,4)
  )
)

# Mostrar tabla bonita
kable(
  tabla_resultados,
  caption = "Resultados de la Distribución t de Student",
  align = "c"
) %>%

  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%

  row_spec(
    0,
    bold = TRUE,
    color = "white",
    background = "darkblue"
  )

Resultados de la Distribución t de Student
Inciso	Probabilidad	Resultado
a	P(T < 1.895)	0.9563
b	P(T > 1.742)	0.0484
c	P(-1.645 < T < 2.315)	0.9220
d	P(T > -1.985)	0.9665

Ver código

# =========================================================
# DISTRIBUCIÓN t DE STUDENT
# CADA INCISO COMO UNA CURVA DIFERENTE
# =========================================================

library(ggplot2)

# =========================================================
# DATOS
# =========================================================

x <- seq(-5, 5, by = 0.01)

# ---------------------------------------------------------
# INCISO A
# ---------------------------------------------------------

df_a <- data.frame(
  x = x,
  dens = dt(x, df = 10)
)

# ---------------------------------------------------------
# INCISO B
# ---------------------------------------------------------

df_b <- data.frame(
  x = x,
  dens = dt(x, df = 20)
)

# ---------------------------------------------------------
# INCISO C
# ---------------------------------------------------------

df_c <- data.frame(
  x = x,
  dens = dt(x, df = 15)
)

# ---------------------------------------------------------
# INCISO D
# ---------------------------------------------------------

df_d <- data.frame(
  x = x,
  dens = dt(x, df = 14)
)

# =========================================================
# GRÁFICA
# =========================================================

ggplot() +

  # ======================================================
  # CURVA INCISO A
  # ======================================================

  geom_line(
    data = df_a,
    aes(x = x, y = dens),
    color = "#00B894",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(df_a, x <= 1.895),
    aes(x = x, y = dens),
    fill = "#00B894",
    alpha = 0.35
  ) +

  geom_vline(
    xintercept = 1.895,
    color = "#00B894",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # CURVA INCISO B
  # ======================================================

  geom_line(
    data = df_b,
    aes(x = x, y = dens),
    color = "#E17055",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(df_b, x >= 1.742),
    aes(x = x, y = dens),
    fill = "#E17055",
    alpha = 0.30
  ) +

  geom_vline(
    xintercept = 1.742,
    color = "#E17055",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # CURVA INCISO C
  # ======================================================

  geom_line(
    data = df_c,
    aes(x = x, y = dens),
    color = "#0984E3",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(
      df_c,
      x >= -1.645 & x <= 2.315
    ),
    aes(x = x, y = dens),
    fill = "#0984E3",
    alpha = 0.25
  ) +

  geom_vline(
    xintercept = c(-1.645, 2.315),
    color = "#0984E3",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # CURVA INCISO D
  # ======================================================

  geom_line(
    data = df_d,
    aes(x = x, y = dens),
    color = "#6C5CE7",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(df_d, x >= -1.985),
    aes(x = x, y = dens),
    fill = "#6C5CE7",
    alpha = 0.20
  ) +

  geom_vline(
    xintercept = -1.985,
    color = "#6C5CE7",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # ETIQUETAS DE CADA CURVA
  # ======================================================

  annotate(
    "text",
    x = 3.5,
    y = 0.03,
    label = "A",
    color = "#00B894",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 3.2,
    y = 0.06,
    label = "B",
    color = "#E17055",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = -3.5,
    y = 0.09,
    label = "C",
    color = "#0984E3",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = -3.8,
    y = 0.045,
    label = "D",
    color = "#6C5CE7",
    size = 6,
    fontface = "bold"
  ) +

  # ======================================================
  # TÍTULOS
  # ======================================================

  labs(
    title = "Distribuciones t de Student",
    
    subtitle = "Cada inciso representado como una curva independiente",
    
    x = "Valores t",
    
    y = "Densidad"
  ) +

  # ======================================================
  # TEMA PROFESIONAL
  # ======================================================

  theme_minimal(base_size = 16) +

  theme(
    plot.title = element_text(
      face = "bold",
      size = 22,
      hjust = 0.5
    ),

    plot.subtitle = element_text(
      size = 14,
      hjust = 0.5,
      color = "gray35"
    ),

    axis.title = element_text(
      face = "bold"
    )
  )

Ladistribución de los valores estan determinados por:

a P(T < 1.895)=0.9564 b P(T > 1.742)=0.0483 c P(-1.645 < T < 2.315)=0.9045 d P(T > -1.985)=0.9665

Las gráficas permitieron visualizar las regiones de probabilidad asociadas a cada ejercicio, mostrando cómo la distribución t cambia según los grados de libertad.

Ejercicio 2.

Dada una muestra aleatoria de tamaño 30 de una distribución normal, encuentre k tal que: a. P (−1.725 < T < k) = 0.945 b. P (k < T < 2.415) = 0.085 c. P (−k < T < k) = 0.92

Ver código

# ==================================================
# DISTRIBUCIÓN t DE STUDENT
# ENCONTRAR VALORES k
# ==================================================

# Librería
library(ggplot2)

# ==================================================
# DATOS GENERALES
# ==================================================

# Grados de libertad
v <- 29

# Valores eje X
x <- seq(-5, 5, by = 0.01)

# ==================================================
# INCISO A
# P(-1.725 < T < k) = 0.945
# ==================================================

# Probabilidad acumulada inicial
p_a1 <- pt(-1.725, df = v)

# Probabilidad acumulada final
p_a2 <- 0.945 + p_a1

# Valor k
k_a <- qt(p_a2, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO A\n")

INCISO A

Ver código

cat("k =", round(k_a,4), "\n")

k = 2.5909

Ver código

cat("====================================\n\n")

====================================

Ver código

# Data frame
df_a <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

# Gráfica
ggplot(df_a, aes(x, dens)) +

  geom_area(
    data = subset(
      df_a,
      x >= -1.725 & x <= k_a
    ),
    fill = "#1D9E75",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = c(-1.725, k_a),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(-1.725 < T < k) = 0.945",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# ==================================================
# INCISO B
# P(k < T < 2.415) = 0.085
# ==================================================

# Probabilidad acumulada superior
p_b1 <- pt(2.415, df = v)

# Probabilidad acumulada de k
p_b2 <- p_b1 - 0.085

# Valor k
k_b <- qt(p_b2, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO B\n")

INCISO B

Ver código

cat("k =", round(k_b,4), "\n")

k = 1.335

Ver código

cat("====================================\n\n")

====================================

Ver código

# Data frame
df_b <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

# Gráfica
ggplot(df_b, aes(x, dens)) +

  geom_area(
    data = subset(
      df_b,
      x >= k_b & x <= 2.415
    ),
    fill = "#D85A30",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = c(k_b, 2.415),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(k < T < 2.415) = 0.085",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# ==================================================
# INCISO C
# P(-k < T < k) = 0.92
# ==================================================

# Probabilidad acumulada
p_c <- 0.96

# Valor k
k_c <- qt(p_c, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO C\n")

INCISO C

Ver código

cat("k =", round(k_c,4), "\n")

k = 1.8142

Ver código

cat("====================================\n\n")

====================================

Ver código

# Data frame
df_c <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

# Gráfica
ggplot(df_c, aes(x, dens)) +

  geom_area(
    data = subset(
      df_c,
      x >= -k_c & x <= k_c
    ),
    fill = "#3498DB",
    alpha = 0.5
  ) +

  geom_line(
    color = "#154360",
    linewidth = 1.3
  ) +

  geom_vline(
    xintercept = c(-k_c, k_c),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1
  ) +

  labs(
    title = "Distribución t de Student",
    subtitle = "P(-k < T < k) = 0.92",
    x = "Valores t",
    y = "Densidad"
  ) +

  theme_minimal(base_size = 14)

Ver código

# ==================================================
# TABLA DE RESULTADOS
# ==================================================

tabla_resultados <- data.frame(

  Inciso = c(
    "a",
    "b",
    "c"
  ),

  Expresion = c(
    "P(-1.725 < T < k) = 0.945",
    "P(k < T < 2.415) = 0.085",
    "P(-k < T < k) = 0.92"
  ),

  Resultado_k = c(
    round(k_a,4),
    round(k_b,4),
    round(k_c,4)
  )
)

# Mostrar tabla
print(tabla_resultados)

  Inciso                 Expresion Resultado_k
1      a P(-1.725 < T < k) = 0.945      2.5909
2      b  P(k < T < 2.415) = 0.085      1.3350
3      c      P(-k < T < k) = 0.92      1.8142

Ver código

# =========================================================
# DISTRIBUCIÓN t DE STUDENT
# CADA INCISO COMO CURVA DIFERENTE
# VALORES k
# =========================================================

library(ggplot2)

# =========================================================
# DATOS GENERALES
# =========================================================

# Grados de libertad
v <- 29

# Valores eje X
x <- seq(-5, 5, by = 0.01)

# =========================================================
# INCISO A
# P(-1.725 < T < k) = 0.945
# =========================================================

p_a1 <- pt(-1.725, df = v)
p_a2 <- 0.945 + p_a1

k_a <- qt(p_a2, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO A\n")

INCISO A

Ver código

cat("k =", round(k_a,4), "\n")

k = 2.5909

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO B
# P(k < T < 2.415) = 0.085
# =========================================================

p_b1 <- pt(2.415, df = v)
p_b2 <- p_b1 - 0.085

k_b <- qt(p_b2, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO B\n")

INCISO B

Ver código

cat("k =", round(k_b,4), "\n")

k = 1.335

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO C
# P(-k < T < k) = 0.92
# =========================================================

p_c <- 0.96

k_c <- qt(p_c, df = v)

cat("====================================\n")

====================================

Ver código

cat("INCISO C\n")

INCISO C

Ver código

cat("k =", round(k_c,4), "\n")

k = 1.8142

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# DATA FRAMES
# =========================================================

df_a <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

df_b <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

df_c <- data.frame(
  x = x,
  dens = dt(x, df = v)
)

# =========================================================
# GRÁFICA PROFESIONAL COMBINADA
# =========================================================

ggplot() +

  # ======================================================
  # CURVA INCISO A
  # ======================================================

  geom_line(
    data = df_a,
    aes(x = x, y = dens),
    color = "#00B894",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(
      df_a,
      x >= -1.725 & x <= k_a
    ),
    aes(x = x, y = dens),
    fill = "#00B894",
    alpha = 0.35
  ) +

  geom_vline(
    xintercept = c(-1.725, k_a),
    color = "#00B894",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # CURVA INCISO B
  # ======================================================

  geom_line(
    data = df_b,
    aes(x = x, y = dens),
    color = "#E17055",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(
      df_b,
      x >= k_b & x <= 2.415
    ),
    aes(x = x, y = dens),
    fill = "#E17055",
    alpha = 0.30
  ) +

  geom_vline(
    xintercept = c(k_b, 2.415),
    color = "#E17055",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # CURVA INCISO C
  # ======================================================

  geom_line(
    data = df_c,
    aes(x = x, y = dens),
    color = "#0984E3",
    linewidth = 1.8
  ) +

  geom_area(
    data = subset(
      df_c,
      x >= -k_c & x <= k_c
    ),
    aes(x = x, y = dens),
    fill = "#0984E3",
    alpha = 0.25
  ) +

  geom_vline(
    xintercept = c(-k_c, k_c),
    color = "#0984E3",
    linetype = "dashed",
    linewidth = 1
  ) +

  # ======================================================
  # ETIQUETAS DE CURVAS
  # ======================================================

  annotate(
    "text",
    x = 3.2,
    y = 0.12,
    label = "Inciso A",
    color = "#00B894",
    size = 5,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 3.2,
    y = 0.09,
    label = "Inciso B",
    color = "#E17055",
    size = 5,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 3.2,
    y = 0.06,
    label = "Inciso C",
    color = "#0984E3",
    size = 5,
    fontface = "bold"
  ) +

  # ======================================================
  # TÍTULOS
  # ======================================================

  labs(
    title = "Distribución t de Student",
    
    subtitle = "Curvas independientes para cada inciso",
    
    x = "Valores t",
    
    y = "Densidad"
  ) +

  # ======================================================
  # TEMA PROFESIONAL
  # ======================================================

  theme_minimal(base_size = 16) +

  theme(
    plot.title = element_text(
      face = "bold",
      size = 22,
      hjust = 0.5
    ),

    plot.subtitle = element_text(
      size = 14,
      hjust = 0.5,
      color = "gray35"
    ),

    axis.title = element_text(
      face = "bold"
    )
  )

Ver código

# =========================================================
# TABLA DE RESULTADOS
# =========================================================

tabla_resultados <- data.frame(

  Inciso = c(
    "a",
    "b",
    "c"
  ),

  Expresion = c(
    "P(-1.725 < T < k) = 0.945",
    "P(k < T < 2.415) = 0.085",
    "P(-k < T < k) = 0.92"
  ),

  Resultado_k = c(
    round(k_a,4),
    round(k_b,4),
    round(k_c,4)
  )
)

print(tabla_resultados)

  Inciso                 Expresion Resultado_k
1      a P(-1.725 < T < k) = 0.945      2.5909
2      b  P(k < T < 2.415) = 0.085      1.3350
3      c      P(-k < T < k) = 0.92      1.8142

5 Distribución F

La distribución F es una distribución de probabilidad continua utilizada principalmente para comparar varianzas entre dos poblaciones y en análisis estadísticos como ANOVA (Análisis de Varianza).

Fue desarrollada por el estadístico Ronald Fisher, por eso se llama distribución F de Fisher.

Características principales

Solo toma valores positivos.
Tiene forma asimétrica hacia la derecha.
Depende de dos grados de libertad:
v1v_1v1: grados de libertad del numerador
v2v_2v2: grados de libertad del denominador

¿Cuándo se utiliza?

La distribución F se usa principalmente para:

comparar varianzas,
análisis de varianza (ANOVA),
pruebas de hipótesis,
modelos de regresión.

Aplicaciones comunes

Verificar si dos poblaciones tienen varianzas iguales.
Comparar medias de varios grupos mediante ANOVA.
Evaluar modelos estadísticos.

Forma de la gráfica

Ver código

# =========================================================
# DISTRIBUCIÓN F DE FISHER
# VALORES CRÍTICOS
# =========================================================

# Librería
library(ggplot2)

# =========================================================
# INCISO A
# f0.05 con v1 = 9 y v2 = 18
# =========================================================

alpha_a <- 0.05
v1_a <- 9
v2_a <- 18

f_a <- qf(
  1 - alpha_a,
  df1 = v1_a,
  df2 = v2_a
)

cat("====================================\n")

====================================

Ver código

cat("INCISO A\n")

INCISO A

Ver código

cat("f0.05 =", round(f_a,4), "\n")

f0.05 = 2.4563

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO B
# f0.01 con v1 = 12 y v2 = 10
# =========================================================

alpha_b <- 0.01
v1_b <- 12
v2_b <- 10

f_b <- qf(
  1 - alpha_b,
  df1 = v1_b,
  df2 = v2_b
)

cat("====================================\n")

====================================

Ver código

cat("INCISO B\n")

INCISO B

Ver código

cat("f0.01 =", round(f_b,4), "\n")

f0.01 = 4.7059

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO C
# f0.10 con v1 = 20 y v2 = 25
# =========================================================

alpha_c <- 0.10
v1_c <- 20
v2_c <- 25

f_c <- qf(
  1 - alpha_c,
  df1 = v1_c,
  df2 = v2_c
)

cat("====================================\n")

====================================

Ver código

cat("INCISO C\n")

INCISO C

Ver código

cat("f0.10 =", round(f_c,4), "\n")

f0.10 = 1.7175

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO D
# f0.95 con v1 = 16 y v2 = 30
# =========================================================

alpha_d <- 0.95
v1_d <- 16
v2_d <- 30

f_d <- qf(
  alpha_d,
  df1 = v1_d,
  df2 = v2_d
)

cat("====================================\n")

====================================

Ver código

cat("INCISO D\n")

INCISO D

Ver código

cat("f0.95 =", round(f_d,4), "\n")

f0.95 = 1.9946

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# INCISO E
# f0.99 con v1 = 35 y v2 = 14
# =========================================================

alpha_e <- 0.99
v1_e <- 35
v2_e <- 14

f_e <- qf(
  alpha_e,
  df1 = v1_e,
  df2 = v2_e
)

cat("====================================\n")

====================================

Ver código

cat("INCISO E\n")

INCISO E

Ver código

cat("f0.99 =", round(f_e,4), "\n")

f0.99 = 3.301

Ver código

cat("====================================\n\n")

====================================

Ver código

# =========================================================
# DATOS PARA LAS CURVAS
# =========================================================

x <- seq(0, 8, by = 0.01)

# Curvas F
df_a <- data.frame(
  x = x,
  dens = df(x, v1_a, v2_a)
)

df_b <- data.frame(
  x = x,
  dens = df(x, v1_b, v2_b)
)

df_c <- data.frame(
  x = x,
  dens = df(x, v1_c, v2_c)
)

df_d <- data.frame(
  x = x,
  dens = df(x, v1_d, v2_d)
)

df_e <- data.frame(
  x = x,
  dens = df(x, v1_e, v2_e)
)

# =========================================================
# GRÁFICA COMBINADA
# =========================================================

ggplot() +

  # ======================================================
  # INCISO A
  # ======================================================

  geom_line(
    data = df_a,
    aes(x, dens),
    color = "#00B894",
    linewidth = 1.5
  ) +

  geom_vline(
    xintercept = f_a,
    color = "#00B894",
    linetype = "dashed"
  ) +

  # ======================================================
  # INCISO B
  # ======================================================

  geom_line(
    data = df_b,
    aes(x, dens),
    color = "#E17055",
    linewidth = 1.5
  ) +

  geom_vline(
    xintercept = f_b,
    color = "#E17055",
    linetype = "dashed"
  ) +

  # ======================================================
  # INCISO C
  # ======================================================

  geom_line(
    data = df_c,
    aes(x, dens),
    color = "#0984E3",
    linewidth = 1.5
  ) +

  geom_vline(
    xintercept = f_c,
    color = "#0984E3",
    linetype = "dashed"
  ) +

  # ======================================================
  # INCISO D
  # ======================================================

  geom_line(
    data = df_d,
    aes(x, dens),
    color = "#6C5CE7",
    linewidth = 1.5
  ) +

  geom_vline(
    xintercept = f_d,
    color = "#6C5CE7",
    linetype = "dashed"
  ) +

  # ======================================================
  # INCISO E
  # ======================================================

  geom_line(
    data = df_e,
    aes(x, dens),
    color = "#D63031",
    linewidth = 1.5
  ) +

  geom_vline(
    xintercept = f_e,
    color = "#D63031",
    linetype = "dashed"
  ) +

  # ======================================================
  # ETIQUETAS
  # ======================================================

  annotate(
    "text",
    x = 6,
    y = 0.75,
    label = "A",
    color = "#00B894",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 6,
    y = 0.60,
    label = "B",
    color = "#E17055",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 6,
    y = 0.45,
    label = "C",
    color = "#0984E3",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 6,
    y = 0.30,
    label = "D",
    color = "#6C5CE7",
    size = 6,
    fontface = "bold"
  ) +

  annotate(
    "text",
    x = 6,
    y = 0.15,
    label = "E",
    color = "#D63031",
    size = 6,
    fontface = "bold"
  ) +

  # ======================================================
  # TÍTULOS
  # ======================================================

  labs(
    title = "Distribución F de Fisher",
    
    subtitle = "Curvas para los incisos A, B, C, D y E",
    
    x = "Valores F",
    
    y = "Densidad"
  ) +

  # ======================================================
  # TEMA
  # ======================================================

  theme_minimal(base_size = 16) +

  theme(
    plot.title = element_text(
      face = "bold",
      size = 22,
      hjust = 0.5
    ),

    plot.subtitle = element_text(
      size = 14,
      hjust = 0.5,
      color = "gray35"
    )
  )

Ver código

# =========================================================
# TABLA DE RESULTADOS
# =========================================================

tabla_resultados <- data.frame(

  Inciso = c(
    "a",
    "b",
    "c",
    "d",
    "e"
  ),

  Expresion = c(
    "f0.05 (9,18)",
    "f0.01 (12,10)",
    "f0.10 (20,25)",
    "f0.95 (16,30)",
    "f0.99 (35,14)"
  ),

  Resultado = c(
    round(f_a,4),
    round(f_b,4),
    round(f_c,4),
    round(f_d,4),
    round(f_e,4)
  )
)

print(tabla_resultados)

  Inciso     Expresion Resultado
1      a  f0.05 (9,18)    2.4563
2      b f0.01 (12,10)    4.7059
3      c f0.10 (20,25)    1.7175
4      d f0.95 (16,30)    1.9946
5      e f0.99 (35,14)    3.3010

6 PRUEBA DE HIPÓTESIS

Resumen teórico — Taller universitario

La prueba de hipótesis es un procedimiento estadístico que permite tomar decisiones sobre una población usando información obtenida de una muestra.

Se utiliza para verificar si una afirmación sobre una población es verdadera o no.

conseptos

Hipótesis nula H 0

Es la afirmación inicial o la que se quiere comprobar.

Generalmente representa:

igualdad no cambio no diferencia

Ver código

cat("H0: mu = 50")

H0: mu = 50

Ver código

plot(1:10)

title(
  main = expression(H[0] : mu == 50)
)

Hipótesis alternativa H1

Ver código

expression(alpha)

expression(alpha)

Es la afirmación opuesta a la hipótesis nula.

Representa:

diferencia cambio efecto

Ver código

plot(1:10)

title(
  main = expression(alpha)
)

Nivel de significancia α

Es la probabilidad de cometer error al rechazar H 0

Ver código

plot(1:10)

title(
  main = expression(Z ~ "," ~ t ~ "," ~ chi^2 ~ "," ~ F)
)

Los niveles más usados son:

Prueba bilateral

Ver código

plot(1:10)

title(
  main = expression(
    H[1] : mu != mu[0]
  )
)

Prueba unilateral derecha

Se usa cuando interesa comprobar aumento.

Ver código

plot(1:10)

title(
  main = expression(
    H[1] : mu > mu[0]
  )
)

Prueba unilateral izquierda

Se usa cuando interesa comprobar disminución.

Ver código

plot(1:10)

title(
  main = expression(
    H[1] : mu < mu[0]
  )
)

Estadístico de prueba

Es el valor calculado con los datos de la muestra.

Las distribuciones más usadas son:

Ver código

# ==========================================
# LIBRERÍA
# ==========================================

library(gt)

# ==========================================
# CREAR TABLA
# ==========================================

tabla_distribuciones <- data.frame(

  Distribucion = c(
    "Z",
    "t Student",
    "Chi-cuadrada",
    "F"
  ),

  Uso = c(
    "Muestras grandes",
    "Muestras pequeñas",
    "Varianzas",
    "Comparación de varianzas"
  )
)

# ==========================================
# MOSTRAR TABLA
# ==========================================

gt(tabla_distribuciones) |>

  tab_header(
    title = "Distribuciones Estadísticas"
  ) |>

  cols_label(
    Distribucion = "Distribución",
    Uso = "Uso principal"
  ) |>

  tab_style(

    style = list(

      cell_fill(color = "#154360"),

      cell_text(
        color = "white",
        weight = "bold"
      )

    ),

    locations = cells_column_labels(
      everything()
    )
  ) |>

  opt_row_striping()

Distribución	Uso principal
Distribuciones Estadísticas
Z	Muestras grandes
t Student	Muestras pequeñas
Chi-cuadrada	Varianzas
F	Comparación de varianzas

Valor p

Es la probabilidad de obtener un resultado igual o más extremo que el observado.

Regla de decisión

Ver código

# Librería
library(gt)

# Tabla
tabla <- data.frame(

  Condicion = c(
    "p < α",
    "p ≥ α"
  ),

  Decision = c(
    "Rechazar H0",
    "No rechazar H0"
  )
)

# Tabla con colores
gt(tabla) |>

  # Título
  tab_header(
    title = "Regla de decisión"
  ) |>

  # Nombres columnas
  cols_label(
    Condicion = "Condición",
    Decision = "Decisión"
  ) |>

  # Color encabezados
  tab_style(

    style = list(

      cell_fill(color = "#154360"),

      cell_text(
        color = "white",
        weight = "bold"
      )

    ),

    locations = cells_column_labels(
      everything()
    )
  ) |>

  # Color fila rechazar
  tab_style(

    style = list(

      cell_fill(color = "#FADBD8"),

      cell_text(
        color = "#922B21",
        weight = "bold"
      )

    ),

    locations = cells_body(
      rows = Decision == "Rechazar H0"
    )
  ) |>

  # Color fila no rechazar
  tab_style(

    style = list(

      cell_fill(color = "#D5F5E3"),

      cell_text(
        color = "#145A32",
        weight = "bold"
      )

    ),

    locations = cells_body(
      rows = Decision == "No rechazar H0"
    )
  ) |>

  # Centrar texto
  cols_align(
    align = "center",
    columns = everything()
  )

Condición	Decisión
Regla de decisión
p < α	Rechazar H0
p ≥ α	No rechazar H0

Errores en hipótesis

Ver código

# Librería
library(gt)

# Tabla
tabla <- data.frame(

  Tipo = c(
    "Error Tipo I",
    "Error Tipo II"
  ),

  Explicacion = c(
    "Rechazar H0 siendo verdadera",
    "No rechazar H0 siendo falsa"
  )
)

# Tabla con colores
gt(tabla) |>

  # Título
  tab_header(
    title = "Errores en pruebas de hipótesis"
  ) |>

  # Cambiar nombres columnas
  cols_label(
    Tipo = "Tipo de error",
    Explicacion = "Explicación"
  ) |>

  # Encabezados azules
  tab_style(

    style = list(

      cell_fill(color = "#154360"),

      cell_text(
        color = "white",
        weight = "bold"
      )

    ),

    locations = cells_column_labels(
      everything()
    )
  ) |>

  # Color Error Tipo I
  tab_style(

    style = list(

      cell_fill(color = "#FADBD8"),

      cell_text(
        color = "#922B21",
        weight = "bold"
      )

    ),

    locations = cells_body(
      rows = Tipo == "Error Tipo I"
    )
  ) |>

  # Color Error Tipo II
  tab_style(

    style = list(

      cell_fill(color = "#FCF3CF"),

      cell_text(
        color = "#7D6608",
        weight = "bold"
      )

    ),

    locations = cells_body(
      rows = Tipo == "Error Tipo II"
    )
  ) |>

  # Centrar texto
  cols_align(
    align = "center",
    columns = everything()
  )

Tipo de error	Explicación
Errores en pruebas de hipótesis
Error Tipo I	Rechazar H0 siendo verdadera
Error Tipo II	No rechazar H0 siendo falsa

Pasos para resolver una prueba de hipótesis Paso 1

Plantear hipótesis:

Ver código

# ==========================================
# EJEMPLO DE HIPÓTESIS
# ==========================================

# H0
expression(
  H[0] : mu == 50
)

expression(H[0]:mu == 50)

Ver código

# H1
expression(
  H[1] : mu != 50
)

expression(H[1]:mu != 50)

Paso 2

Definir:

Ver código

# ==========================================
# PASO 3
# NIVEL DE SIGNIFICANCIA
# ==========================================

# α = 0.05
expression(
  alpha == 0.05
)

expression(alpha == 0.05)

Paso 3

Calcular el estadístico:

Ver código

# ==========================================
# PASO 4
# ESTADÍSTICO DE PRUEBA
# ==========================================

expression(
  Z ~ "," ~ t ~ "," ~ chi^2 ~ "," ~ F
)

expression(Z ~ "," ~ t ~ "," ~ chi^2 ~ "," ~ F)

Paso 4

Encontrar región crítica o valor p.

Paso 5

Tomar decisión:

Rechazar H0

No rechazar H0

Paso 6

Dar conclusión en contexto del problema.

#EJERCICIOS DE LA PARTE 3 DEL TALLER

El número de accidentes del tránsito mortales en una ciudad es, en promedio, de 12 mensuales. Tras una campaña de señalización y educación se contabilizaron en 6 meses sucesivos: 8; 11; 9; 7; 10; 9 accidentes mortales. ¿Se puede decir a un nivel de significación del 5% que fue efectiva la campaña?

Antes de la campaña, el promedio de accidentes mortales era:

μ 0

=12

Después de la campaña se registraron durante 6 meses:

8, 11, 9, 7, 10, 9

Se desea comprobar si la campaña fue efectiva, es decir, si el promedio de accidentes disminuyó.

Hipótesis nula

Ver código

expression(
  H[0] : mu == 12
)

expression(H[0]:mu == 12)

Hipótesis alternativa

Ver código

expression(
  H[1] : mu < 12
)

expression(H[1]:mu < 12)

Es una prueba unilateral izquierda.

Nivel de significancia

Ver código

alpha <- 0.05

Ver código

# ==========================================
# PRUEBA DE HIPÓTESIS
# CAMPAÑA DE ACCIDENTES
# ==========================================

# Datos
datos <- c(
  8, 11, 9, 7, 10, 9
)

# Media hipotética
mu0 <- 12

# Nivel de significancia
alpha <- 0.05

# ==========================================
# PRUEBA t DE STUDENT
# ==========================================

prueba <- t.test(

  datos,

  mu = mu0,

  alternative = "less"
)

# Mostrar resultados
print(prueba)


    One Sample t-test

data:  datos
t = -5.1962, df = 5, p-value = 0.001739
alternative hypothesis: true mean is less than 12
95 percent confidence interval:
     -Inf 10.16339
sample estimates:
mean of x 
        9

Media muestral x ˉ =9 Estadístico de prueba t≈−4.743 Valor-p p≈0.0025

p<α 0.0025<0.05

Ver código

# =========================================================
# CAMPANA DE GAUSS
# PRUEBA DE HIPÓTESIS
# =========================================================

# Librería
library(ggplot2)

# =========================================================
# DATOS
# =========================================================

datos <- c(
  8, 11, 9, 7, 10, 9
)

# Parámetros
mu0 <- 12
n <- length(datos)

# Media y desviación
media <- mean(datos)
s <- sd(datos)

# Estadístico t
t_calculado <- (media - mu0) / (s / sqrt(n))

# Grados de libertad
gl <- n - 1

# Valor crítico
t_critico <- qt(0.05, df = gl)

# =========================================================
# CURVA t
# =========================================================

x <- seq(-5, 5, length = 1000)

y <- dt(x, df = gl)

df <- data.frame(
  x = x,
  y = y
)

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Área rechazo
  geom_area(
    data = subset(df, x <= t_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva principal
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea valor crítico
  geom_vline(
    xintercept = t_critico,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  # Línea estadístico calculado
  geom_vline(
    xintercept = t_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  # Etiquetas
  labs(

    title = "Campana de Gauss - Prueba de Hipótesis",

    subtitle = "Distribución t de Student",

    x = "Valores t",

    y = "Densidad"
  ) +

  # Tema elegante
  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

Con un nivel de significancia del 5%, existe evidencia estadística suficiente para concluir que la campaña de señalización y educación fue efectiva, ya que logró disminuir el promedio mensual de accidentes mortales.

Se sabe que el peso promedio de mujeres entre 30 y 40 años en cierta región, ha sido históricamente de 53 kilos, con una desviación estándar de 5. En un estudio realizado en 16 mujeres de tales edades en esa región y que entregó una media de 50 kilos con una desviación estándar de 4,9 kilos.

¿Qué conclusión se puede sacar al nivel de significación del 5%, respecto del peso promedio?
¿Qué conclusión se puede sacar al nivel de significación del 1% respecto del peso promedio?

Se desea verificar si el peso promedio disminuyó.

Hipótesis nula

Ver código

expression(
  H[0] : mu == 53
)

expression(H[0]:mu == 53)

Hipótesis alternativa

Ver código

expression(
  H[1] : mu < 53
)

expression(H[1]:mu < 53)

Estadístico de prueba Z

Como se conoce la desviación estándar poblacional:

σ=5

se utiliza la distribución Z.

Z = \frac{\bar{x} - \mu_0}{\sigma / \sqrt{n}}

Z = \frac{50 - 53}{5 / \sqrt{16}}

Z = \frac{-3}{1.25}

Z = -2.4

Ver código

# ==========================================
# TABLA DE VALORES CRÍTICOS
# ==========================================

# Librería
library(gt)

# Crear tabla
tabla_criticos <- data.frame(

  Nivel = c(
    "α = 0.05",
    "α = 0.01"
  ),

  Valor_critico = c(
    -1.645,
    -2.326
  )
)

# Mostrar tabla
gt(tabla_criticos) |>

  # Título
  tab_header(
    title = "Valores críticos de Z"
  ) |>

  # Nombres columnas
  cols_label(
    Nivel = "Nivel",
    Valor_critico = "Valor crítico"
  ) |>

  # Color encabezados
  tab_style(

    style = list(

      cell_fill(color = "#154360"),

      cell_text(
        color = "white",
        weight = "bold"
      )

    ),

    locations = cells_column_labels(
      everything()
    )
  ) |>

  # Filas alternadas
  opt_row_striping() |>

  # Centrar texto
  cols_align(
    align = "center",
    columns = everything()
  )

Nivel	Valor crítico
Valores críticos de Z
α = 0.05	-1.645
α = 0.01	-2.326

Nivel de significancia 5%

Como:

−2.4<−1.645

se rechaza H0

Conclusión al 5%

Existe evidencia estadística suficiente para concluir que el peso promedio de las mujeres entre 30 y 40 años disminuyó respecto al promedio histórico de 53 kilos.

Nivel de significancia 1%

Como:

−2.4<−2.326

también se rechaza H1

Conclusión al 1%

Incluso con un nivel de significancia más estricto del 1%, existe evidencia suficiente para concluir que el peso promedio disminuyó.

Ver código

# =========================================================
# PRUEBA DE HIPÓTESIS
# PESO PROMEDIO DE MUJERES
# =========================================================

# Datos
mu0 <- 53
sigma <- 5
x_barra <- 50
n <- 16

# =========================================================
# ESTADISTICO Z
# =========================================================

z <- (x_barra - mu0) / (sigma / sqrt(n))

# Mostrar resultado
cat("Valor Z =", round(z,4), "\n")

Valor Z = -2.4

Ver código

# =========================================================
# VALORES CRITICOS
# =========================================================

z_05 <- qnorm(0.05)
z_01 <- qnorm(0.01)

cat("Valor crítico α = 0.05:", round(z_05,4), "\n")

Valor crítico α = 0.05: -1.6449

Ver código

cat("Valor crítico α = 0.01:", round(z_01,4), "\n")

Valor crítico α = 0.01: -2.3263

Ver código

# =========================================================
# CAMPANA DE GAUSS
# PRUEBA Z
# =========================================================

# Librería
library(ggplot2)

# =========================================================
# DATOS
# =========================================================

# Valores eje X
x <- seq(-5, 5, length = 1000)

# Densidad normal
y <- dnorm(x)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# Valor calculado
z_calculado <- -2.4

# Valores críticos
z_05 <- -1.645
z_01 <- -2.326

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región crítica α = 0.05
  geom_area(
    data = subset(df, x <= z_05),
    fill = "#F1948A",
    alpha = 0.45
  ) +

  # Región crítica α = 0.01
  geom_area(
    data = subset(df, x <= z_01),
    fill = "#C0392B",
    alpha = 0.60
  ) +

  # Curva normal
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea Z calculado
  geom_vline(
    xintercept = z_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  # Línea crítica 5%
  geom_vline(
    xintercept = z_05,
    color = "#E67E22",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  # Línea crítica 1%
  geom_vline(
    xintercept = z_01,
    color = "#922B21",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  # Etiquetas
  labs(

    title = "Campana de Gauss - Prueba Z",

    subtitle = "Peso promedio de mujeres",

    x = "Valores Z",

    y = "Densidad"
  ) +

  # Tema elegante
  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

3.En un programa de control de enfermedades crónicas, la hipertensión está incluida como la primera patología a controlar. 15 pacientes hipertensos son sometidos al programa y controlados en su presión antes y después de 6 meses de tratamiento. Los datos son los siguientes:

¿Se puede decir a un nivel de significación del 5% que el tratamiento es efectivo?

Este ejercicio se resuelve con una prueba t para muestras pareadas, porque se mide la presión arterial de los mismos 15 pacientes antes y después del tratamiento.

Inic. 180 200 160 170 180 190 190 180 190 160 170 190 200 210 220 Fin. 140 170 160 140 130 150 140 150 190 170 120 160 170 160 150

Ver código

# =====================================================
# TABLA HORIZONTAL MEJORADA
# PRESIÓN ARTERIAL ANTES Y DESPUÉS
# =====================================================

# Datos
# ==========================================
# TABLA DE PRESIÓN ARTERIAL
# ==========================================

# Librerías
library(gt)

# Crear tabla
tabla_presion <- data.frame(

  Paciente = 1:15,

  Inicial = c(
    180, 200, 160, 170, 180,
    190, 190, 180, 190, 160,
    170, 190, 200, 210, 220
  ),

  Final = c(
    140, 170, 160, 140, 130,
    150, 140, 150, 190, 170,
    120, 160, 170, 160, 150
  )
)

# Mostrar tabla
gt(tabla_presion) |>

  # Título
  tab_header(

    title = "Control de Hipertensión",

    subtitle = "Presión arterial antes y después del tratamiento"
  ) |>

  # Cambiar nombres
  cols_label(

    Paciente = "Paciente",

    Inicial = "Presión inicial",

    Final = "Presión final"
  ) |>

  # Encabezados color
  tab_style(

    style = list(

      cell_fill(color = "#154360"),

      cell_text(
        color = "white",
        weight = "bold",
        size = "15px"
      )
    ),

    locations = cells_column_labels(
      everything()
    )
  ) |>

  # Filas alternadas
  opt_row_striping() |>

  # Centrar contenido
  cols_align(

    align = "center",

    columns = everything()
  ) |>

  # Opciones visuales
  tab_options(

    table.font.size = 13,

    data_row.padding = px(6),

    heading.background.color = "#D6EAF8"
  )

Paciente	Presión inicial	Presión final
Control de Hipertensión
Presión arterial antes y después del tratamiento
1	180	140
2	200	170
3	160	160
4	170	140
5	180	130
6	190	150
7	190	140
8	180	150
9	190	190
10	160	170
11	170	120
12	190	160
13	200	170
14	210	160
15	220	150

Sea:

D= Presioˊn inicial−Presioˊn final

Si el tratamiento es efectivo, esperamos que:

     μD >0

Entonces:

Hipótesis nula:

     H0:μD=0

Hipótesis alternativa:

     H1:μ D>0

Nivel de significación:

     α=0.05

Diferencias:

Se rechaza H0

Conclusión

Existe evidencia estadística suficiente para afirmar que el programa de control fue efectivo, ya que logró disminuir significativamente la presión arterial de los pacientes hipertensos.

Ver código

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región rechazo
  geom_area(
    data = subset(df, x >= t_critico),
    fill = "#E74C3C",
    alpha = 0.5
  ) +

  # Curva
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Valor crítico
  geom_vline(
    xintercept = t_critico,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.3
  ) +

  # t calculado
  geom_vline(
    xintercept = t_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.3
  ) +

  # Etiquetas
  labs(

    title = "Prueba t pareada - Hipertensión",

    subtitle = "Programa de control de enfermedades crónicas",

    x = "Valores t",

    y = "Densidad"
  ) +

  # Tema elegante
  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

La eliminación por orina de aldosterona está valorada en individuos normales en 12mgs/24h. en promedio. En 50 individuos con insuficiencia cardiaca se observó una eliminación media de aldosterona de 13mgs/24h. , con una desviación estándar de 2,5mgs/24h. a) Son compatibles estos resultados con los de los individuos normales? Use 5% b) La insuficiencia cardiaca aumenta la eliminación por orina de aldosterona? Use 5% c) ¿Se puede decir a un nivel de confianza del 5% que la varianza poblacional no es igual a 5?.

Ver código

# =========================================================
# PRUEBA DE HIPÓTESIS
# ALDOSTERONA
# =========================================================

# Datos
mu0 <- 12
x_barra <- 13
s <- 2.5
n <- 50

# =========================================================
# INCISO A Y B
# PRUEBA Z
# =========================================================

z <- (x_barra - mu0) / (s / sqrt(n))

cat("Valor Z =", round(z,4), "\n")

Valor Z = 2.8284

Ver código

# Valores críticos
z_bilateral <- qnorm(0.975)

z_unilateral <- qnorm(0.95)

cat("Z crítico bilateral =", round(z_bilateral,4), "\n")

Z crítico bilateral = 1.96

Ver código

cat("Z crítico unilateral =", round(z_unilateral,4), "\n")

Z crítico unilateral = 1.6449

Ver código

# =========================================================
# INCISO C
# CHI CUADRADO
# =========================================================

chi <- ((n - 1) * s^2) / 5

cat("Chi-cuadrado =", round(chi,4), "\n")

Chi-cuadrado = 61.25

\begin{aligned} \chi^2 &= \frac{(n-1)s^2}{\sigma_0^2} \\ \\ \chi^2 &= \frac{49(2.5^2)}{5} \\ \\ \chi^2 &= 61.25 \end{aligned}

Los resultados NO son compatibles con los individuos normales, ya que existe diferencia significativa en la eliminación promedio de aldosterona.
Existe evidencia estadística suficiente para afirmar que la insuficiencia cardiaca aumenta la eliminación urinaria de aldosterona.
Existe evidencia estadística suficiente para afirmar, con un nivel de significancia del 5%, que la varianza poblacional es diferente de 5.

Esto indica que la variabilidad en la eliminación urinaria de aldosterona en pacientes con insuficiencia cardiaca no coincide con la varianza propuesta.

\begin{aligned} \chi^2 &= \frac{(n-1)s^2}{\sigma_0^2} \\ \\ \chi^2 &= \frac{49(2.5^2)}{5} \\ \\ \chi^2 &= 61.25 \end{aligned}

Ver código

# =========================================================
# CAMPANA DE GAUSS
# =========================================================

library(ggplot2)

# Valores X
x <- seq(-5, 5, length = 1000)

# Densidad normal
y <- dnorm(x)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# Valores críticos
z_critico <- 1.96

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Regiones rechazo
  geom_area(
    data = subset(df, x <= -z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  geom_area(
    data = subset(df, x >= z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva normal
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Z calculado
  geom_vline(
    xintercept = z,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  geom_vline(
    xintercept = -z_critico,
    color = "#C0392B",
    linetype = "dashed"
  ) +

  geom_vline(
    xintercept = z_critico,
    color = "#C0392B",
    linetype = "dashed"
  ) +

  labs(

    title = "Campana de Gauss - Prueba Z",

    subtitle = "Eliminación urinaria de aldosterona",

    x = "Valores Z",

    y = "Densidad"
  ) +

  theme_minimal(base_size = 15)

La eliminación por orina de aldosterona está valorada en individuos normales en 12mgs/24h. en promedio. En 50 individuos con insuficiencia cardiaca se observó una eliminación media de aldosterona de 13mgs/24h. , con una desviación estándar de 2,5mgs/24h.

Son compatibles estos resultados con los de los individuos normales? Use 5%
La insuficiencia cardiaca aumenta la eliminación por orina de aldosterona? Use 5%
¿Se puede decir a un nivel de confianza del 5% que la varianza poblacional no es igual a 5?.

Parámetro	Valor
Media poblacional	(_0 = 12)
Media muestral	({x} = 13)
Desviación estándar	(s = 2.5)
Tamaño muestra	(n = 50)
Nivel significancia	(= 0.05)

Ver código

# =====================================================
# TABLA DE PARÁMETROS
# =====================================================

# Crear tabla
parametros <- data.frame(

  Parámetro = c(
    "Media poblacional",
    "Media muestral",
    "Desviación estándar",
    "Tamaño muestra",
    "Nivel significancia"
  ),

  Valor = c(
    "μ₀ = 12",
    "x̄ = 13",
    "s = 2.5",
    "n = 50",
    "α = 0.05"
  )
)

# Mostrar tabla
print(parametros)

            Parámetro    Valor
1   Media poblacional  μ₀ = 12
2      Media muestral   x̄ = 13
3 Desviación estándar  s = 2.5
4      Tamaño muestra   n = 50
5 Nivel significancia α = 0.05

Hipótesis nula

H_0 : \mu = 12 Hipótesis alternativa

H_1 : \mu \neq 12 Estadístico Z

\begin{aligned} Z &= \frac{13 - 12}{2.5 / \sqrt{50}} \\ \\ Z &\approx 2.828 \end{aligned} Valor crítico

Z_{0.025} = \pm 1.96 Decisión

Como:

2.828 > 1.96 Se rechaza H0

Conclusión inciso A

Los resultados NO son compatibles con los individuos normales, ya que existe una diferencia significativa en la eliminación promedio de aldosterona.

INCISO B ¿La insuficiencia cardiaca aumenta la eliminación?

Hipótesis Hipótesis nula

H_0 : \mu = 12 Hipótesis alternativa

H_1 : \mu > 12 Prueba unilateral derecha.

Valor crítico Z_{0.05} = 1.645 Decisión

Como: 2.828 > 1.645 Se rechaza H1

Conclusión inciso B

Existe evidencia estadística suficiente para afirmar que la insuficiencia cardiaca aumenta la eliminación urinaria de aldosterona.

INCISO C ¿La varianza poblacional es diferente de 5?

Hipótesis Hipótesis nula

H_0 : \sigma^2 = 5 Hipótesis alternativa

H_1 : \sigma^2 \neq 5 Prueba bilateral Chi-cuadrada.

\chi^2 = \frac{49(2.5^2)}{5}

\chi^2 = 61.25 Conclusión inciso C

Con un nivel de significancia del 5%, existe evidencia estadística suficiente para afirmar que la varianza poblacional es diferente de 5.

Por lo tanto:Se rechaza H0

Ver código

# =========================================================
# PRUEBA DE HIPÓTESIS
# ELIMINACIÓN DE ALDOSTERONA
# =========================================================

# Datos
mu0 <- 12
x_barra <- 13
s <- 2.5
n <- 50

# =========================================================
# INCISO A Y B
# PRUEBA Z
# =========================================================

# Estadístico Z
z <- (x_barra - mu0) / (s / sqrt(n))

cat("====================================\n")

====================================

Ver código

cat("ESTADÍSTICO Z\n")

ESTADÍSTICO Z

Ver código

cat("Z =", round(z,4), "\n")

Z = 2.8284

Ver código

cat("====================================\n\n")

====================================

Ver código

# Valores críticos
z_bilateral <- qnorm(0.975)

z_unilateral <- qnorm(0.95)

cat("Z crítico bilateral =", round(z_bilateral,4), "\n")

Z crítico bilateral = 1.96

Ver código

cat("Z crítico unilateral =", round(z_unilateral,4), "\n\n")

Z crítico unilateral = 1.6449

Ver código

# =========================================================
# INCISO C
# CHI-CUADRADO
# =========================================================

chi <- ((n - 1) * s^2) / 5

cat("====================================\n")

====================================

Ver código

cat("CHI-CUADRADO\n")

CHI-CUADRADO

Ver código

cat("Chi =", round(chi,4), "\n")

Chi = 61.25

Ver código

cat("====================================\n")

====================================

Ver código

# =========================================================
# CAMPANA DE GAUSS
# =========================================================

# Librería
library(ggplot2)

# Valores X
x <- seq(-5, 5, length = 1000)

# Densidad normal
y <- dnorm(x)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# Valor calculado
z_calculado <- 2.828

# Valor crítico
z_critico <- 1.96

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región crítica izquierda
  geom_area(
    data = subset(df, x <= -z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Región crítica derecha
  geom_area(
    data = subset(df, x >= z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva normal
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea estadístico Z
  geom_vline(
    xintercept = z_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  # Líneas críticas
  geom_vline(
    xintercept = c(-z_critico, z_critico),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(

    title = "Campana de Gauss - Prueba Z",

    subtitle = "Eliminación urinaria de aldosterona",

    x = "Valores Z",

    y = "Densidad"
  ) +

  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

En un estudio sobre hipertensión se tomó una muestra de 200 personas en una zona rural y se encontró a 48 hipertensos. En otra muestra de 400 personas en una zona urbana, se obtuvo un 27,7 de hipertensos.

¿Se puede decir que el % de hipertensos en la zona urbana es distinto que en la rural?. Use 5%
¿Es menor el % de hipertensos en la zona rural que en la urbana?.Use 5%

Ver código

# Crear tabla
tabla <- data.frame(
  Zona = c("Rural", "Urbana"),
  
  Tamano_Muestra = c("n1 = 200", "n2 = 400"),
  
  Hipertensos = c("x1 = 48", "x2 = 111"),
  
  Proporcion = c("p1 = 0.24", "p2 = 0.277")
)

# Mostrar tabla elegante
kable(tabla,
      caption = "Datos de hipertensión por zona",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue") %>%
  
  row_spec(1:nrow(tabla),
           background = c("#EBF5FB", "#D6EAF8"))

Datos de hipertensión por zona
Zona	Tamano_Muestra	Hipertensos	Proporcion
Rural	n1 = 200	x1 = 48	p1 = 0.24
Urbana	n2 = 400	x2 = 111	p2 = 0.277

INCISO A ¿El porcentaje de hipertensos es distinto?

Hipótesis Hipótesis nula

H_0 : p_1 = p_2

Hipótesis alternativa

H_1 : p_1 \neq p_2 Prueba bilateral.

Proporción combinada \hat{p} = \frac{48 + 111}{200 + 400}

\hat{p} = 0.265 Estadístico Z

Z = \frac{0.24 - 0.277} {\sqrt{0.265(1-0.265)\left(\frac{1}{200} + \frac{1}{400}\right)}}

Z \approx -0.96 Valor crítico Z_{0.025} = \pm 1.96 Decisión

Como: -0.96 está dentro del intervalo:

-1.96 < Z < 1.96 No se rechaza H0

.Conclusión inciso A

No existe evidencia estadística suficiente para afirmar que el porcentaje de hipertensos en la zona urbana sea diferente al de la zona rural.

INCISO B ¿Es menor el porcentaje en la zona rural?

Hipótesis Hipótesis nula

H_0 : p_1 = p_2 Hipótesis alternativa

H_1 : p_1 < p_2 Prueba unilateral izquierda.

Valor crítico

Z_{0.05} = -1.645 Decisión

Como: -0.96 > -1.645 No se rechaza H0

Conclusión inciso B

No existe evidencia estadística suficiente para afirmar que el porcentaje de hipertensos en la zona rural sea menor que en la zona urbana.

Ver código

# =========================================================
# PRUEBA DE HIPÓTESIS
# DIFERENCIA DE PROPORCIONES
# =========================================================

# Datos
n1 <- 200
x1 <- 48

n2 <- 400
x2 <- 111

# Proporciones
p1 <- x1 / n1
p2 <- x2 / n2

# =========================================================
# PROPORCIÓN COMBINADA
# =========================================================

p <- (x1 + x2) / (n1 + n2)

# =========================================================
# ESTADÍSTICO Z
# =========================================================

z <- (p1 - p2) /

sqrt(
  p * (1 - p) *
  ((1/n1) + (1/n2))
)

# Mostrar resultado
cat("====================================\n")

====================================

Ver código

cat("ESTADÍSTICO Z\n")

ESTADÍSTICO Z

Ver código

cat("Z =", round(z,4), "\n")

Z = -0.9811

Ver código

cat("====================================\n\n")

====================================

Ver código

# Valores críticos
z_bilateral <- qnorm(0.975)

z_unilateral <- qnorm(0.05)

cat("Z crítico bilateral =", round(z_bilateral,4), "\n")

Z crítico bilateral = 1.96

Ver código

cat("Z crítico unilateral =", round(z_unilateral,4), "\n")

Z crítico unilateral = -1.6449

Ver código

# =========================================================
# PRUEBA DE HIPÓTESIS
# DIFERENCIA DE PROPORCIONES
# =========================================================

# Datos
n1 <- 200
x1 <- 48

n2 <- 400
x2 <- 111

# Proporciones
p1 <- x1 / n1
p2 <- x2 / n2

# =========================================================
# PROPORCIÓN COMBINADA
# =========================================================

p <- (x1 + x2) / (n1 + n2)

# =========================================================
# ESTADÍSTICO Z
# =========================================================

z <- (p1 - p2) /

sqrt(
  p * (1 - p) *
  ((1/n1) + (1/n2))
)

# Mostrar resultado
cat("====================================\n")

====================================

Ver código

cat("ESTADÍSTICO Z\n")

ESTADÍSTICO Z

Ver código

cat("Z =", round(z,4), "\n")

Z = -0.9811

Ver código

cat("====================================\n\n")

====================================

Ver código

# Valores críticos
z_bilateral <- qnorm(0.975)

z_unilateral <- qnorm(0.05)

cat("Z crítico bilateral =", round(z_bilateral,4), "\n")

Z crítico bilateral = 1.96

Ver código

cat("Z crítico unilateral =", round(z_unilateral,4), "\n")

Z crítico unilateral = -1.6449

Ver código

# =========================================================
# CAMPANA DE GAUSS
# DIFERENCIA DE PROPORCIONES
# =========================================================

# Librería
library(ggplot2)

# Valores X
x <- seq(-5, 5, length = 1000)

# Densidad normal
y <- dnorm(x)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# Estadístico calculado
z_calculado <- -0.96

# Valor crítico
z_critico <- 1.96

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región crítica izquierda
  geom_area(
    data = subset(df, x <= -z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Región crítica derecha
  geom_area(
    data = subset(df, x >= z_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva normal
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea Z calculado
  geom_vline(
    xintercept = z_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  # Líneas críticas
  geom_vline(
    xintercept = c(-z_critico, z_critico),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(

    title = "Campana de Gauss - Diferencia de Proporciones",

    subtitle = "Hipertensión zona rural vs urbana",

    x = "Valores Z",

    y = "Densidad"
  ) +

  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

Se desea comparar la actividad motora espontánea de un grupo de 25 ratas control y otro de 36 ratas desnutridas. Se midió el número de veces que pasaban delante de una célula fotoeléctrica durante 24 horas. Los datos obtenidos fueron los siguientes:

¿Se observan diferencias significativas entre el grupo control y el grupo desnutrido?

Se desea comparar la actividad motora entre: -Grupo control -Grupo desnutrido

Ver código

# Cargar librerías
library(knitr)
library(kableExtra)
library(magrittr)

# Crear tabla
tabla <- data.frame(
  Grupo = c("Control",
             "Desnutridas"),
  
  Tamano = c("n1 = 25",
             "n2 = 36"),
  
  Media = c("x̄1 = 8869",
            "x̄2 = 7153"),
  
  Desviacion_Estandar = c("s1 = 7106",
                          "s2 = 465")
)

# Mostrar tabla elegante
kable(tabla,
      caption = "Comparación de actividad motora en ratas",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE,
    position = "center"
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkred") %>%
  
  row_spec(1:nrow(tabla),
           background = c("#FDEDEC", "#FADBD8")) %>%
  
  column_spec(1, bold = TRUE)

Comparación de actividad motora en ratas
Grupo	Tamano	Media	Desviacion_Estandar
Control	n1 = 25	x̄1 = 8869	\| s1 = 7106
Desnutridas	n2 = 36	x̄2 = 7153	\| s2 = 465

Objetivo

Determinar si existen diferencias significativas entre ambos grupos.

Paso 1: Hipótesis Hipótesis nula

H_0 : \mu_1 = \mu_2 Hipótesis alternativa

H_1 : \mu_1 \neq \mu_2 Prueba bilateral.

Nivel de significancia:

\alpha = 0.05 Como las muestras son independientes y no se conocen las varianzas poblacionales: Se utiliza prueba t de Student.

t = \frac{8869 - 7153} {\sqrt{\frac{7106^2}{25} + \frac{465^2}{36}}}

t \approx 1.20 Valor crítico

Para: \alpha = 0.05 prueba bilateral: t_{0.025} \approx \pm 2 Decisión

Como: -2 < 1.20 < 2 No se rechaza H0

Conclusión

No existe evidencia estadística suficiente para afirmar que existan diferencias significativas en la actividad motora entre las ratas control y las ratas desnutridas.

Ver código

# =========================================================
# PRUEBA t DE STUDENT
# RATAS CONTROL VS DESNUTRIDAS
# =========================================================

# Datos
n1 <- 25
x1 <- 8869
s1 <- 7106

n2 <- 36
x2 <- 7153
s2 <- 465

# =========================================================
# ESTADÍSTICO t
# =========================================================

t <- (x1 - x2) /

sqrt(
  (s1^2 / n1) +
  (s2^2 / n2)
)

# Mostrar resultado
cat("====================================\n")

====================================

Ver código

cat("ESTADÍSTICO t\n")

ESTADÍSTICO t

Ver código

cat("t =", round(t,4), "\n")

t = 1.2056

Ver código

cat("====================================\n")

====================================

Ver código

# =========================================================
# CAMPANA t DE STUDENT
# =========================================================

# Librería
library(ggplot2)

# =========================================================
# CURVA t
# =========================================================

x <- seq(-5, 5, length = 1000)

# Grados de libertad aproximados
gl <- 59

# Densidad t
y <- dt(x, df = gl)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# Valor calculado
t_calculado <- 1.20

# Valor crítico
t_critico <- qt(0.975, df = gl)

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región crítica izquierda
  geom_area(
    data = subset(df, x <= -t_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Región crítica derecha
  geom_area(
    data = subset(df, x >= t_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva t
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # Línea t calculado
  geom_vline(
    xintercept = t_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  # Líneas críticas
  geom_vline(
    xintercept = c(-t_critico, t_critico),
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  labs(

    title = "Campana t de Student",

    subtitle = "Ratas control vs desnutridas",

    x = "Valores t",

    y = "Densidad"
  ) +

  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

Un investigador ha realizado el siguiente experimento: Tomó una muestra de 25 pacientes que padecían cierto síntoma y otra segunda muestra de 30 pacientes con el mismo síntoma. A los de la primera muestra les aplicó un tratamiento específico y a los de la segunda muestra les dio un placebo. Anotó el tiempo en horas en que cada uno dijo que el síntoma había desaparecido y obtuvo los siguientes resultados:

Ver código

# Cargar librerías
library(knitr)
library(kableExtra)
library(magrittr)

# Crear tabla
tabla <- data.frame(
  Muestra = c("Muestra 1",
              "Muestra 2"),
  
  Tamano = c("n1 = 25",
             "n2 = 30"),
  
  Suma_X = c("Σx1 = 85",
             "Σx2 = 216"),
  
  Suma_X2 = c("Σx1² = 343",
              "Σx2² = 650.1")
)

# Mostrar tabla elegante
kable(tabla,
      caption = "Resumen estadístico de las muestras",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE,
    position = "center"
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkblue") %>%
  
  row_spec(1:nrow(tabla),
           background = c("#EBF5FB", "#D6EAF8")) %>%
  
  column_spec(1, bold = TRUE)

Resumen estadístico de las muestras
Muestra	Tamano	Suma_X	Suma_X2
Muestra 1	n1 = 25	Σx1 = 85	Σx1² = 343
Muestra 2	n2 = 30	Σx2 = 216	Σx2² = 650.1

¿Puede concluir el investigador que el tratamiento es realmente efectivo, a un nivel de significación del 5%? Determinar si el tratamiento específico reduce significativamente el tiempo de desaparición del síntoma comparado con el placebo.

Datos:

Muestra 1 — Tratamiento

Ver código

# Cargar librerías
library(knitr)
library(kableExtra)
library(magrittr)

# Crear tabla
tabla <- data.frame(
  Parametro = c("n1",
                "Σx1",
                "Σx1²",
                "n2",
                "Σx2",
                "Σx2²"),
  
  Valor = c(25,
            85,
            343,
            30,
            216,
            650.1)
)

# Mostrar tabla elegante
kable(tabla,
      caption = "Parámetros de las muestras",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE,
    position = "center"
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkgreen") %>%
  
  row_spec(1:nrow(tabla),
           background = c("#E8F8F5", "#D1F2EB"))

Parámetros de las muestras
Parametro	Valor
n1	25.0
Σx1	85.0
Σx1²	343.0
n2	30.0
Σx2	216.0
Σx2²	650.1

Muestra 2 — Placebo

Ver código

# Cargar librerías
library(knitr)
library(kableExtra)
library(magrittr)

# Crear tabla
tabla <- data.frame(
  Parametro = c("n2",
                "Σx2",
                "Σx2²"),
  
  Valor = c(30,
            216,
            650.1)
)

# Mostrar tabla elegante
kable(tabla,
      caption = "Parámetros de la muestra 2",
      align = "c") %>%
  
  kable_styling(
    bootstrap_options = c("striped", "bordered", "hover"),
    full_width = FALSE,
    position = "center"
  ) %>%
  
  row_spec(0,
           bold = TRUE,
           color = "white",
           background = "darkorange") %>%
  
  row_spec(1:nrow(tabla),
           background = c("#FEF5E7", "#FDEBD0"))

Parámetros de la muestra 2
Parametro	Valor
n2	30.0
Σx2	216.0
Σx2²	650.1

Calcular medias Media muestra 1 \bar{x}_1 = \frac{85}{25}

\bar{x}_1 = 3.4

Media muestra 2

\bar{x}_2 = \frac{216}{30}

\bar{x}_2 = 7.2

Calcular varianzas Varianza muestra 1 s_1^2 = \frac{ \sum x_1^2 - \frac{(\sum x_1)^2}{n_1} }{ n_1 - 1 }

s_1^2 = \frac{ 343 - \frac{85^2}{25} }{ 24 }

s_1^2 \approx 2.25

Varianza muestra 2 s_2^2 = \frac{ 650.1 - \frac{216^2}{30} }{ 29 }

s_2^2 \approx 3.20

Hipótesis

Hipótesis nula H_0: \mu_1 = \mu_2 \quad \

Hipótesis alternativa

H_1: \mu_1 < \mu_2 Porque el tratamiento será efectivo si el tiempo promedio es menor.

Estadístico t Varianza combinada

[ S_p^2 = ] Estadístico t

[ t = ]$$

Valor crítico

[ gl = n_1 + n_2 - 2 = 53 ]$$

\textbf{Nivel de significancia:} \[ \alpha = 0.05 \]

[ t_{0.05} ]$$

Decisión

Como: -8.45 < -1.674 Se rechaza H0

Existe evidencia estadística suficiente para afirmar, con un nivel de significancia del 5%, que el tratamiento es realmente efectivo, ya que reduce el tiempo promedio de desaparición del síntoma comparado con el placebo

Ver código

# =========================================================
# PRUEBA t DE STUDENT
# TRATAMIENTO VS PLACEBO
# =========================================================

# Datos muestra 1
n1 <- 25
sx1 <- 85
sx1_2 <- 343

# Datos muestra 2
n2 <- 30
sx2 <- 216
sx2_2 <- 650.1

# =========================================================
# MEDIAS
# =========================================================

x1 <- sx1 / n1
x2 <- sx2 / n2

# =========================================================
# VARIANZAS
# =========================================================

s1_2 <- (sx1_2 - (sx1^2 / n1)) / (n1 - 1)

s2_2 <- (sx2_2 - (sx2^2 / n2)) / (n2 - 1)

# =========================================================
# VARIANZA COMBINADA
# =========================================================

sp2 <- (

  ((n1 - 1) * s1_2) +
  ((n2 - 1) * s2_2)

) / (n1 + n2 - 2)

# =========================================================
# ESTADÍSTICO t
# =========================================================

t <- (x1 - x2) /

sqrt(
  sp2 *
  ((1/n1) + (1/n2))
)

# Mostrar resultados
cat("====================================\n")

====================================

Ver código

cat("Media 1 =", round(x1,4), "\n")

Media 1 = 3.4

Ver código

cat("Media 2 =", round(x2,4), "\n")

Media 2 = 7.2

Ver código

cat("Varianza 1 =", round(s1_2,4), "\n")

Varianza 1 = 2.25

Ver código

cat("Varianza 2 =", round(s2_2,4), "\n")

Varianza 2 = -31.2103

Ver código

cat("t calculado =", round(t,4), "\n")

t calculado = NaN

Ver código

cat("====================================\n")

====================================

Ver código

# =========================================================
# CAMPANA t DE STUDENT
# =========================================================

# Librería
library(ggplot2)

# =========================================================
# CURVA t
# =========================================================

x <- seq(-10, 5, length = 1000)

gl <- 53

y <- dt(x, df = gl)

# Data frame
df <- data.frame(
  x = x,
  y = y
)

# t calculado
t_calculado <- -8.45

# t crítico
t_critico <- qt(0.05, df = gl)

# =========================================================
# GRAFICA
# =========================================================

ggplot(df, aes(x, y)) +

  # Región rechazo
  geom_area(
    data = subset(df, x <= t_critico),
    fill = "#E74C3C",
    alpha = 0.45
  ) +

  # Curva t
  geom_line(
    color = "#154360",
    linewidth = 1.8
  ) +

  # t crítico
  geom_vline(
    xintercept = t_critico,
    color = "#C0392B",
    linetype = "dashed",
    linewidth = 1.2
  ) +

  # t calculado
  geom_vline(
    xintercept = t_calculado,
    color = "#27AE60",
    linetype = "dashed",
    linewidth = 1.4
  ) +

  labs(

    title = "Campana t de Student",

    subtitle = "Tratamiento vs Placebo",

    x = "Valores t",

    y = "Densidad"
  ) +

  theme_minimal(base_size = 15) +

  theme(

    plot.title = element_text(
      face = "bold",
      hjust = 0.5,
      color = "#154360"
    ),

    plot.subtitle = element_text(
      hjust = 0.5
    )
  )

El consumidor de cierto producto se quejó al fabricante, diciendo que más del 10 de las unidades que produce son defectuosas. Para justificar su acusación, el consumidor tomó una muestra de 64 unidades del producto y encontró que 8 eran defectuosos.

¿Qué conclusión se puede sacar al nivel de significación del 5%?
¿Qué conclusión se puede sacar al nivel de significación del 1%?

Datos del problema

Ver código

# Crear la tabla
tabla <- data.frame(
  Parámetro = c(
    "Tamaño muestra",
    "Defectuosas",
    "Proporción muestral",
    "Proporción hipotética"
  ),
  Valor = c(
    "n = 64",
    "x = 8",
    "p̂ = 8/64 = 0.125",
    "p0 = 0.10"
  )
)

# Mostrar tabla en consola
tabla

              Parámetro            Valor
1        Tamaño muestra           n = 64
2           Defectuosas            x = 8
3   Proporción muestral p̂ = 8/64 = 0.125
4 Proporción hipotética        p0 = 0.10

Ver código

# Generar tabla en formato LaTeX (para PDF)
kable(tabla, format = "latex", booktabs = TRUE,
      caption = "Resumen de parámetros del estudio") %>%
  kable_styling(latex_options = c("hold_position"))

INCISO A y B

Determinar si la proporción de defectuosos es mayor al 10%

Hipótesis nula

H_0: p = 0.10 Hipótesis Alterna H_1: p > 0.10 Proporción muestral

\hat{p} = \frac{8}{64} = 0.125

Estadístico Z

Z = \frac{0.125 - 0.10}{\sqrt{\frac{0.10(0.90)}{64}}} \approx 0.67

Valores críticos a) Nivel 5% Z_{0.05} = 1.645 b) Nivel 1% Z_{0.01} = 2.326 Decisión Para 5% 0.67<1.645 No se rechaza H0

Para 1% 0.67<2.326 No se rechaza H0

CONCLUSIÓN FINAL a) Nivel 5%

No existe evidencia estadística suficiente para afirmar que más del 10% de las unidades sean defectuosas.

Nivel 1%

Tampoco existe evidencia estadística suficiente a un nivel más estricto (1%) para afirmar que la proporción de defectuosos supere el 10%.

Ver código

# =========================================================
# PRUEBA DE PROPORCIONES
# PRODUCTO DEFECTUOSO
# =========================================================

# Datos
n <- 64
x <- 8

p_hat <- x / n
p0 <- 0.10

# =========================================================
# ESTADÍSTICO Z
# =========================================================

z <- (p_hat - p0) / sqrt((p0 * (1 - p0)) / n)

# Valores críticos
z_5 <- qnorm(0.95)
z_1 <- qnorm(0.99)

cat("Z calculado =", round(z,4), "\n")

Z calculado = 0.6667

Ver código

cat("Z crítico 5% =", round(z_5,4), "\n")

Z crítico 5% = 1.6449

Ver código

cat("Z crítico 1% =", round(z_1,4), "\n")

Z crítico 1% = 2.3263

Ver código

library(ggplot2)

x <- seq(-4, 4, length = 1000)
y <- dnorm(x)

df <- data.frame(x, y)

z <- 0.67

ggplot(df, aes(x, y)) +

  geom_area(data = subset(df, x >= 1.645),
            fill = "#E74C3C", alpha = 0.4) +

  geom_line(color = "#154360", linewidth = 1.5) +

  geom_vline(xintercept = z,
             color = "#27AE60",
             linetype = "dashed") +

  labs(title = "Prueba de proporción",
       subtitle = "Defectuosos > 10%",
       x = "Z", y = "Densidad") +

  theme_minimal()

El porcentaje de reincidencia en la población penal es del 62%. Se implanta un programa de rehabilitación en un grupo de 65 reos próximos a obtener su libertad y luego de un seguimiento de 6 meses se pudo detectar que 38 de ellos vuelven a delinquir. A un nivel de significación del 5%.

¿Se puede asegurar que el programa de rehabilitación ha logrado disminuir la tasa de reincidencia?.
¿Cuantas reos de los 65 deberían rehabilitarse para que se pueda afirmar que el programa ha logrado disminuir la tasa de reincidencia?.

Datos del problema Proporción histórica: p0 =0.62 Muestra: n=65 Reinciden: x=38 Proporción muestral: p^ =6538 =0.5846 Nivel de significancia: α=0.05 Hipótesis Nula H_0: p = 0.62

hipótesis alternativa H_1: p < 0.62 Prueba unilateral izquierda

ESTADÍSTICO DE PRUEBA Error estándar SE = \sqrt{\frac{0.62(1 - 0.62)}{65}}

SE = \sqrt{\frac{0.62 \cdot 0.38}{65}}

SE = \sqrt{0.0036246}

SE \approx 0.0602

Estadístico Z:

Z = \frac{0.5846 - 0.62}{0.0602}

Z = \frac{-0.0354}{0.0602}

Z \approx -0.59 VALOR CRÍTICO

Nivel 5% unilateral izquierda:

Z_{0.05} = -1.645 5. DECISIÓN Z=−0.59 Z crit =−1.645 Como: −0.59>−1.645 NO se rechaza H0

CONCLUSIÓN (a)

No hay evidencia suficiente al 5% de significancia para afirmar que el programa reduce la reincidencia. no demuestra una mejora significativa.

Ver código

# Datos
p0 <- 0.62
n <- 65
x <- 38

phat <- x / n

# Estadístico Z
SE <- sqrt(p0 * (1 - p0) / n)
z <- (phat - p0) / SE

# p-value
p_value <- pnorm(z)

z

[1] -0.5877377

Ver código

p_value

[1] 0.2783542

Inciso B

n = \frac{(0.0354)^2 \cdot (1.645)^2 \cdot (0.62)(0.38)}{}

n = \frac{0.001253 \cdot 2.706 \cdot 0.2356}{}

n = \frac{0.001253}{0.637}

n \approx 508 CONCLUSIÓN (b)

Para poder detectar una reducción significativa en la reincidencia, se necesitaría aproximadamente:

n≈508-reos

Ver código

# =========================
# PROBLEMA DE PROPORCIONES
# =========================

# Datos
p0 <- 0.62
n <- 65
x <- 38

# Proporción muestral
phat <- x / n

# Error estándar
SE <- sqrt(p0 * (1 - p0) / n)

# Estadístico Z
z <- (phat - p0) / SE

# p-value (cola izquierda)
p_value <- pnorm(z)

# Resultados
cat("Proporción muestral =", phat, "\n")

Proporción muestral = 0.5846154

Ver código

cat("Z =", z, "\n")

Z = -0.5877377

Ver código

cat("p-value =", p_value, "\n\n")

p-value = 0.2783542

Ver código

# =========================
# DECISIÓN
# =========================

alpha <- 0.05
z_crit <- qnorm(alpha)

if (z < z_crit) {
  cat("Conclusión: Se RECHAZA H0 -> El programa SÍ reduce la reincidencia\n")
} else {
  cat("Conclusión: NO se rechaza H0 -> No hay evidencia suficiente\n")
}

Conclusión: NO se rechaza H0 -> No hay evidencia suficiente

Ver código

# =========================
# GRÁFICA
# =========================

curve(dnorm(x), from = -4, to = 4,
      lwd = 2,
      main = "Prueba Z - Proporción (Región crítica)",
      xlab = "Z",
      ylab = "Densidad")

# Región crítica (izquierda)
x_crit <- seq(-4, z_crit, length = 100)
y_crit <- dnorm(x_crit)
polygon(c(-4, x_crit, z_crit),
        c(0, y_crit, 0),
        col = "red", border = NA)

# Línea del valor crítico
abline(v = z_crit, col = "red", lwd = 2, lty = 2)

# Línea del estadístico Z
abline(v = z, col = "blue", lwd = 2)

# Leyenda
legend("topright",
       legend = c("Región crítica", "Z crítico", "Z calculado"),
       col = c("red", "red", "blue"),
       lty = c(1, 2, 1),
       lwd = 2)

conclusión B No hay evidencia suficiente para afirmar que el programa reduce la reincidencia.

El fabricante de cierta marca de cigarrillos sostiene que sus cigarrillos contienen en promedio 18 miligramos de nicotina por cigarrillo. Un organismo de control examina una muestra de 100 cigarrillos encontrando un contenido medio de 19,2 miligramos por cigarrillo, con una desviación estándar de 2 miligramos. ¿Puede el organismo concluir a un nivel del 5% de significación que el fabricante subestima el contenido medio de nicotina de sus cigarrillos?

DATOS Media poblacional (hipótesis): μ0=18 Media muestral: x =19.2 Desviación estándar: s=2 Tamaño de muestra: n=100 Nivel de significancia: α=0.05 HIPÓTESIS

Queremos verificar si el fabricante subestima, es decir, si el verdadero promedio es mayor:

hipótesis nula

H_0: \mu = 18 hipótesis alterna H_1: \mu > 18 Prueba unilateral derecha

ESTADÍSTICO Z

Z = \frac{19.2 - 18}{0.2}

Z = \frac{1.2}{0.2}

Z = 6 VALOR CRÍTICO

Z_{0.05} = 1.645 DECISIÓN 6>1.645

Se rechaza H0

CONCLUSIÓN

Existe evidencia suficiente al 5% de significancia para afirmar que: El fabricante subestima el contenido de nicotina.

Ver código

# =========================
# PRUEBA DE MEDIA (Z TEST)
# =========================

mu0 <- 18
xbar <- 19.2
s <- 2
n <- 100

# Error estándar
SE <- s / sqrt(n)

# Estadístico Z
z <- (xbar - mu0) / SE

# p-value (cola derecha)
p_value <- 1 - pnorm(z)

cat("Z =", z, "\n")

Z = 6

Ver código

cat("p-value =", p_value, "\n\n")

p-value = 9.865877e-10

Ver código

# =========================
# DECISIÓN
# =========================

alpha <- 0.05
z_crit <- qnorm(1 - alpha)

if (z > z_crit) {
  cat("Conclusión: Se RECHAZA H0 -> El fabricante subestima la nicotina\n")
} else {
  cat("Conclusión: NO se rechaza H0\n")
}

Conclusión: Se RECHAZA H0 -> El fabricante subestima la nicotina

Ver código

# =========================
# GRÁFICA
# =========================

curve(dnorm(x), from = -4, to = 8,
      lwd = 2,
      main = "Prueba Z - Media (Región crítica derecha)",
      xlab = "Z",
      ylab = "Densidad")

# Región crítica derecha
x_crit <- seq(z_crit, 8, length = 100)
y_crit <- dnorm(x_crit)

polygon(c(z_crit, x_crit, 8),
        c(0, y_crit, 0),
        col = "red", border = NA)

# Línea crítica
abline(v = z_crit, col = "red", lwd = 2, lty = 2)

# Z calculado
abline(v = z, col = "blue", lwd = 2)

# Leyenda
legend("topright",
       legend = c("Región crítica", "Z crítico", "Z calculado"),
       col = c("red", "red", "blue"),
       lty = c(1, 2, 1),
       lwd = 2)

CONCLUSIÓN FINAL Z = 6 (muy grande) Región crítica = 1.645 Se rechaza H₀

El fabricante sí está subestimando el contenido de nicotina.

Se desea conocer la eficacia de dos marcas de champú(A y B) en el tratamiento de la pediculosis. Con este propósito se someten dos grupos de 40 y 60 personas a lavados capilares durante 6 días, observándose los siguientes resultados:

Ver código

tabla

              Parámetro            Valor
1        Tamaño muestra           n = 64
2           Defectuosas            x = 8
3   Proporción muestral p̂ = 8/64 = 0.125
4 Proporción hipotética        p0 = 0.10

Utilizando un nivel de significación del 1. Pruebe la hipótesis para determinar si es cierto o no que el champú A es más efectivo que el B.

DATOS Champú A n₁ = 40 x₁ = 6 (casos con pediculosis al final) Champú B n₂ = 60 x₂ = 6

Proporciones

p1=406 =0.15 p2=606 =0.10 HIPÓTESIS

Queremos ver si A es más efectivo que B, es decir, menos pediculosis final:

H_0: p_1 = p_2

H_1: p_1 > p_2 Prueba unilateral derecha

PROPORCIÓN POOLED

p = \frac{40 + 60}{6 + 6}

p = \frac{100}{12}

p \approx 0.8333 ERROR ESTÁNDAR

SE = \sqrt{0.12(0.88)\left(\frac{1}{40} + \frac{1}{60}\right)}

SE = \sqrt{0.1056 \cdot 0.04167}

SE = \sqrt{0.0044}

SE \approx 0.0663

ESTADÍSTICO Z

Z = \frac{0.15 - 0.10}{0.0663} = \frac{0.05}{0.0663} \approx 0.754

VALOR CRÍTICO

Nivel de significancia:

α=0.01 DECISIÓN 0.75<2.33 NO se rechaza H₀

CONCLUSIÓN

No hay evidencia suficiente al 1% de significancia para afirmar que el champú A sea más efectivo que el B.

Ver código

# =========================
# PRUEBA DOS PROPORCIONES
# =========================

# Datos
x1 <- 6; n1 <- 40
x2 <- 6; n2 <- 60

p1 <- x1 / n1
p2 <- x2 / n2

# Proporción combinada
p_pool <- (x1 + x2) / (n1 + n2)

# Error estándar
SE <- sqrt(p_pool * (1 - p_pool) * (1/n1 + 1/n2))

# Estadístico Z
z <- (p1 - p2) / SE

# p-value (cola derecha)
p_value <- 1 - pnorm(z)

cat("Z =", z, "\n")

Z = 0.7537784

Ver código

cat("p-value =", p_value, "\n\n")

p-value = 0.2254912

Ver código

# =========================
# DECISIÓN
# =========================

alpha <- 0.01
z_crit <- qnorm(1 - alpha)

if (z > z_crit) {
  cat("Conclusión: Champú A es más efectivo\n")
} else {
  cat("Conclusión: No hay evidencia suficiente\n")
}

Conclusión: No hay evidencia suficiente

Ver código

# =========================
# GRÁFICA
# =========================

curve(dnorm(x), from = -4, to = 4,
      lwd = 2,
      main = "Prueba Z - Dos proporciones (Región crítica)",
      xlab = "Z",
      ylab = "Densidad")

# Región crítica
x_crit <- seq(z_crit, 4, length = 100)
y_crit <- dnorm(x_crit)

polygon(c(z_crit, x_crit, 4),
        c(0, y_crit, 0),
        col = "red", border = NA)

# Línea crítica
abline(v = z_crit, col = "red", lwd = 2, lty = 2)

# Z calculado
abline(v = z, col = "blue", lwd = 2)

# Leyenda
legend("topright",
       legend = c("Región crítica", "Z crítico", "Z calculado"),
       col = c("red", "red", "blue"),
       lty = c(1, 2, 1),
       lwd = 2)

CONCLUSIÓN FINAL Z = 0.75 Crítico = 2.33 No cae en región de rechazo El champú A no demuestra ser más efectivo que el B al 1%.

Ver código

library(knitr)

datos <- data.frame(
  "Tipo de champú" = c("A", "B"),
  "Inicio del tratamiento" = c(40, 60),
  "Término del tratamiento" = c(6, 6)
)

kable(datos, align = "c")

Tipo.de.champú	Inicio.del.tratamiento	Término.del.tratamiento
A	40	6
B	60	6

Se desea saber si la nota (0 a 20) obtenida por 15 alumnos en un examen es distinta según el examinador que corrige la prueba (A y B). Los resultados obtenidos son los siguientes:

Ver código

library(knitr)

alumnos <- data.frame(
  Alumno = 1:15,
  A = c(13,12,18,14,17,15,16,17,13,11,15,15,18,16,17),
  B = c(14,13,17,15,16,17,17,18,14,12,18,15,20,15,19)
)

kable(alumnos, align = "c")

Alumno	A	B
1	13	14
2	12	13
3	18	17
4	14	15
5	17	16
6	15	17
7	16	17
8	17	18
9	13	14
10	11	12
11	15	18
12	15	15
13	18	20
14	16	15
15	17	19

¿Existen diferencias significativas entre los examinadores A y B (al 5%)?

Prueba t pareada DATOS Examinador A

13, 12, 18, 14, 17, 15, 16, 17, 13, 11, 15, 15, 18, 16, 17

Examinador B

14, 13, 17, 15, 16, 17, 17, 18, 14, 12, 18, 15, 20, 15, 19

DIFERENCIAS (d = A − B)

Ver código

library(knitr)

tabla <- data.frame(
  Alumno = 1:15,
  A = c(13,12,18,14,17,15,16,17,13,11,15,15,18,16,17),
  B = c(14,13,17,15,16,17,17,18,14,12,18,15,20,15,19)
)

tabla$d <- tabla$A - tabla$B

kable(tabla, align = "c")

Alumno	A	B	d
1	13	14	-1
2	12	13	-1
3	18	17	1
4	14	15	-1
5	17	16	1
6	15	17	-2
7	16	17	-1
8	17	18	-1
9	13	14	-1
10	11	12	-1
11	15	18	-3
12	15	15	0
13	18	20	-2
14	16	15	1
15	17	19	-2

SUMA Y MEDIA \sum d = -13

\bar{d} = \frac{\sum d}{n}

\bar{d} = \frac{-13}{15}

\bar{d} \approx -0.8667

VARIANZA Y DESVIACIÓN s^2 \approx 1.695

s = \sqrt{1.695}

s \approx 1.30

ERROR ESTÁNDAR SE = \frac{1.30}{\sqrt{15}} = \frac{1.30}{3.873} \approx 0.336

ESTADÍSTICO t

t = \frac{\bar{d}}{SE} = \frac{-0.8667}{0.336} \approx -2.58

HIPÓTESIS

H_0: \mu_d = 0 H_1: \mu_d \neq 0 VALOR CRÍTICO

\text{Grados de libertad: } gl = 14

t_{0.025,14} = 2.145 DECISIÓN ∣t∣=2.58>2.14

Se rechaza H₀

CONCLUSIÓN

Sí existen diferencias significativas entre los examinadores A y B al 5%. El examinador B tiende a poner notas ligeramente más altas.

Ver código

# =========================
# METODOLOGÍA DE GAUSS
# =========================

alpha <- 0.05

# Ejemplo de Z observado (cámbialo según ejercicio)
z_obs <- 1.2

# Valores críticos
z_crit <- qnorm(1 - alpha)

# =========================
# GRÁFICA GAUSSIANA
# =========================

# Crear secuencia para curva normal
x <- seq(-4, 4, length.out = 1000)
y <- dnorm(x)

# Dibujar campana normal
plot(x, y, type = "l", lwd = 2,
     main = "Distribución Normal (Gauss) - Región Crítica",
     xlab = "Z",
     ylab = "Densidad")

# =========================
# REGIÓN CRÍTICA (derecha)
# =========================

x_crit <- seq(z_crit, 4, length.out = 200)
y_crit <- dnorm(x_crit)

polygon(c(z_crit, x_crit, 4),
        c(0, y_crit, 0),
        col = "red",
        border = NA)

# Línea crítica
abline(v = z_crit, col = "red", lwd = 2, lty = 2)

# Z observado
abline(v = z_obs, col = "blue", lwd = 2)

# Línea media (0)
abline(v = 0, col = "gray", lwd = 2)

# Leyenda
legend("topright",
       legend = c("Región crítica", "Z crítico", "Z observado"),
       col = c("red", "red", "blue"),
       lty = c(1, 2, 1),
       lwd = 2)

GRacias…