Taller 1 - Distribuciones de Probabilidad
Ana Rodriguez, Breiner Omen, Esteban Ochoa, Oscar Ramirez, Fabian Urbano
Punto 1
Datos del problema
- Proporción promedio de defectuosos del proceso: \(p = 0.05\)
- Tamaño de la muestra tomada cada hora: \(n = 18\) artículos
- Regla de decisión: el proceso se detiene si la muestra contiene más de un defectuoso, es decir, si \(X \ge 2\)
- Variable aleatoria: \(X\) = número de artículos defectuosos en la muestra de 18
Justificación del modelo: se cumplen los supuestos binomiales: número fijo de ensayos (\(n=18\)), cada artículo es defectuoso o no (dos resultados posibles), la probabilidad \(p=0.05\) es constante y los artículos se extraen de manera aleatoria e independiente. Por lo tanto:
\[X \sim \text{Bin}(n = 18,\ p = 0.05)\]
n <- 18
p <- 0.05
construir_tabla(
data.frame(
Parametro = c("n (tamaño de muestra)", "p (proporcion de defectuosos)", "Regla de paro"),
Valor = c(as.character(n), as.character(p), "X >= 2")
),
caption = "Parametros del muestreo por hora"
)| Parametro | Valor |
|---|---|
| n (tamaño de muestra) | 18 |
| p (proporcion de defectuosos) | 0.05 |
| Regla de paro | X >= 2 |
a) Probabilidad de que el proceso se detenga
Se detiene cuando hay más de un defectuoso, entonces se usa el complemento: \[P(X \ge 2) = 1 - P(X=0) - P(X=1)\]
p0 <- dbinom(0, size = n, prob = p)
p1 <- dbinom(1, size = n, prob = p)
pParo <- 1 - p0 - p1
construir_tabla(
data.frame(
Cantidad = c("P(X = 0)", "P(X = 1)", "P(X >= 2)"),
Valor = c(p0, p1, pParo)
),
caption = "Probabilidades bajo el esquema actual"
)| Cantidad | Valor |
|---|---|
| P(X = 0) | 0.3972 |
| P(X = 1) | 0.3763 |
| P(X >= 2) | 0.2265 |
defectuosos <- data.frame(
x = 0:10,
prob = dbinom(0:10, size = n, prob = p)
)
defectuosos$grupo <- ifelse(defectuosos$x >= 2, "X >= 2", "X < 2")
ggplot(defectuosos, aes(x = factor(x), y = prob, fill = grupo)) +
geom_col(width = 0.7, color = "white") +
geom_text(aes(label = percent(prob, accuracy = 0.1)),
vjust = -0.5, size = 3, color = color_foco) +
scale_fill_manual(values = c("X < 2" = color_ok, "X >= 2" = color_alarma)) +
scale_y_continuous(labels = percent_format(), expand = expansion(mult = c(0, 0.15))) +
labs(title = "Distribucion Bin(n = 18, p = 0.05)",
x = "Articulos defectuosos (X)", y = "Probabilidad", fill = NULL) +
tema_taller
Aun cuando el proceso esté funcionando normalmente, con su 5% habitual de defectos, existe un 22.65% de probabilidad de que el muestreo ordene detenerlo.
b) ¿Es adecuado el esquema de muestreo?
esperados <- n * p
sigma <- sqrt(n * p * (1 - p))
parosTurno <- 8 * pParo
construir_tabla(
data.frame(
Indicador = c("E(X) por muestra", "Desviacion estandar", "Paros esperados en un turno de 8 horas"),
Valor = c(esperados, sigma, parosTurno)
),
caption = "Comportamiento esperado del esquema actual"
)| Indicador | Valor |
|---|---|
| E(X) por muestra | 0.9000 |
| Desviacion estandar | 0.9247 |
| Paros esperados en un turno de 8 horas | 1.8118 |
ggplot(defectuosos, aes(x = x, y = prob)) +
geom_col(fill = color_foco, width = 0.6, alpha = 0.85) +
geom_vline(xintercept = esperados, color = color_foco, linetype = "dotted", linewidth = 1) +
geom_vline(xintercept = 2, color = color_alarma, linetype = "dashed", linewidth = 1) +
annotate("text", x = esperados, y = max(defectuosos$prob) * 1.05,
label = paste0("E(X) = ", round(esperados, 2)), color = color_foco, size = 3.3, hjust = -0.1) +
annotate("text", x = 2, y = max(defectuosos$prob) * 0.9,
label = "X = 2", color = color_alarma, size = 3.3, hjust = -0.1) +
scale_x_continuous(breaks = 0:10) +
scale_y_continuous(labels = percent_format()) +
labs(title = "Valor esperado y punto de corte",
x = "Articulos defectuosos (X)", y = "Probabilidad") +
tema_taller
El punto de corte (2 defectuosos) está apenas por encima del valor esperado (0.9), a poco más de una desviación estándar. La probabilidad de 0.2265 es un error tipo I, es decir, una falsa alarma: detener un proceso que en realidad opera dentro de su comportamiento normal. Con muestreo cada hora en un turno de 8 horas se esperan 1.81 paros injustificados por turno, aproximadamente uno cada 4.4 horas.
El esquema no es adecuado. Generaría demasiadas interrupciones innecesarias, con pérdida de producción, costos de arranque y desconfianza del personal en el sistema de control, sin que exista un deterioro real de la calidad. Un criterio de control razonable debería tener una tasa de falsas alarmas mucho menor, típicamente entre 1% y 5%.
c) Evaluación de dos alternativas
pParoOpcion1 <- 1 - pbinom(2, size = 18, prob = p)
pParoOpcion2 <- 1 - pbinom(1, size = 17, prob = p)
pDeterioro <- 0.10
potenciaActual <- 1 - pbinom(1, size = 18, prob = pDeterioro)
potenciaOpcion1 <- 1 - pbinom(2, size = 18, prob = pDeterioro)
potenciaOpcion2 <- 1 - pbinom(1, size = 17, prob = pDeterioro)esquemas <- data.frame(
Esquema = c("Actual", "Opcion 1", "Opcion 2"),
n = c(18, 18, 17),
Regla = c("X >= 2", "X >= 3", "X >= 2"),
Falsa_alarma = c(pParo, pParoOpcion1, pParoOpcion2),
Potencia = c(potenciaActual, potenciaOpcion1, potenciaOpcion2)
)
construir_tabla(esquemas, caption = "Comparacion de los esquemas de muestreo") %>%
column_spec(4, bold = TRUE, color = "white",
background = degradado(esquemas$Falsa_alarma)) %>%
column_spec(5, bold = TRUE, color = "white",
background = degradado(esquemas$Potencia, inicio = color_alarma, fin = color_ok))| Esquema | n | Regla | Falsa_alarma | Potencia |
|---|---|---|---|---|
| Actual | 18 | X >= 2 | 0.2265 | 0.5497 |
| Opcion 1 | 18 | X >= 3 | 0.0581 | 0.2662 |
| Opcion 2 | 17 | X >= 2 | 0.2078 | 0.5182 |
esquemasLargo <- pivot_longer(
esquemas,
cols = c(Falsa_alarma, Potencia),
names_to = "metrica", values_to = "valor"
)
esquemasLargo$metrica <- factor(
esquemasLargo$metrica,
levels = c("Falsa_alarma", "Potencia"),
labels = c("p = 0.05", "p = 0.10")
)
ggplot(esquemasLargo, aes(x = Esquema, y = valor, fill = Esquema)) +
geom_col(width = 0.6) +
geom_text(aes(label = percent(valor, accuracy = 0.1)), vjust = -0.5, size = 3.3) +
facet_wrap(~ metrica) +
scale_fill_manual(values = c("Actual" = color_alarma, "Opcion 1" = color_ok, "Opcion 2" = color_secundario)) +
scale_y_continuous(labels = percent_format(), expand = expansion(mult = c(0, 0.15))) +
labs(title = "Probabilidad de paro segun el esquema",
x = NULL, y = NULL, fill = NULL) +
tema_taller +
theme(legend.position = "none", strip.text = element_text(face = "bold", color = color_foco))
Discusión: la Opción 2, reducir la muestra a 17, prácticamente no resuelve nada: la falsa alarma baja solo 1.87 puntos porcentuales (de 22.65% a 20.78%), sigue interrumpiendo el proceso una de cada cinco horas y además reduce la información disponible, empeorando levemente la capacidad de detectar un deterioro (de 55.0% a 51.8%). Es la peor alternativa, porque se pierde sensibilidad sin ganar estabilidad.
La Opción 1, exigir más de 2 defectuosos, sí produce un cambio sustancial: las falsas alarmas caen de 22.65% a 5.81%, nivel ya compatible con un criterio de control estadístico. El costo es que la potencia para detectar un aumento del defecto al 10% baja de 54.97% a 26.62%: el esquema se vuelve más tolerante y tardará más ciclos en reaccionar ante un deterioro genuino.
Recomendación: entre las dos alternativas, la Opción 1 es claramente preferible, porque ataca el problema de fondo, que es tener el punto de corte demasiado cerca del valor esperado de 0.9 defectuosos. Sin embargo, la solución técnicamente más sólida sería aumentar el tamaño de muestra en lugar de reducirlo y fijar el límite de control a partir de él: con muestras más grandes se logra simultáneamente una baja tasa de falsas alarmas y una alta potencia de detección, justamente lo que la Opción 2 sacrifica.
Punto 2
Datos del problema
- \(X\) = número de componentes que fallan antes de cumplir 100 horas de operación
- \(X\) sigue una distribución de Poisson con promedio \(\lambda = 8\) fallas cada 100 horas
- Al ser Poisson un proceso escalable en el tiempo, la tasa por hora es \(\lambda/100\), y se reajusta según el intervalo de interés (25 o 50 horas)
Justificación del modelo: el número de fallas en un intervalo de tiempo continuo, con una tasa promedio constante y ocurrencias independientes entre sí, es el escenario clásico que modela la distribución de Poisson. Por eso \(X \sim \text{Poisson}(\lambda)\), donde \(\lambda\) se reescala proporcionalmente a la duración del intervalo analizado.
lambda100 <- 8
tasaHora <- lambda100 / 100
lambda25 <- tasaHora * 25
lambda50 <- tasaHora * 50
construir_tabla(
data.frame(
Parametro = c("Lambda en 100 horas", "Tasa por hora", "Lambda en 25 horas", "Lambda en 50 horas"),
Valor = c(lambda100, tasaHora, lambda25, lambda50)
),
caption = "Ajuste de la tasa de fallas al intervalo"
)| Parametro | Valor |
|---|---|
| Lambda en 100 horas | 8.00 |
| Tasa por hora | 0.08 |
| Lambda en 25 horas | 2.00 |
| Lambda en 50 horas | 4.00 |
a) Probabilidad de que falle un componente en 25 horas
Se busca \(P(X = 1)\) para un intervalo de 25 horas:
\[P(X=1) = \frac{e^{-2} \cdot 2^{1}}{1!} \approx 0.2707\]
pUnaFalla <- dpois(1, lambda = lambda25)
construir_tabla(
data.frame(
Cantidad = c("Lambda (25 horas)", "P(X = 1)"),
Valor = c(lambda25, pUnaFalla)
),
caption = "Probabilidad de una falla en 25 horas"
)| Cantidad | Valor |
|---|---|
| Lambda (25 horas) | 2.0000 |
| P(X = 1) | 0.2707 |
Informe: el número de componentes que falla antes de cumplir 100 horas de operación sigue una distribución Poisson con un promedio de \(\lambda = 8\) fallas cada 100 horas. Como la distribución de Poisson es escalable en el tiempo, se ajustó el parámetro \(\lambda\) al intervalo de interés: a partir de la tasa base de 0.08 fallas por hora, se calculó que en 25 horas el promedio esperado de fallas es de \(\lambda = 2\). Con este valor se aplicó la función de probabilidad puntual de Poisson, dando como resultado que la probabilidad de que falle exactamente un componente en 25 horas es de aproximadamente 27.07%.
fallas25 <- data.frame(
x = 0:8,
prob = dpois(0:8, lambda = lambda25)
)
fallas25$grupo <- ifelse(fallas25$x == 1, "X = 1", "Resto")
ggplot(fallas25, aes(x = factor(x), y = prob, fill = grupo)) +
geom_col(width = 0.7, color = "white") +
geom_text(aes(label = percent(prob, accuracy = 0.1)),
vjust = -0.5, size = 3, color = color_foco) +
scale_fill_manual(values = c("X = 1" = color_foco, "Resto" = color_neutro)) +
scale_y_continuous(labels = percent_format(), expand = expansion(mult = c(0, 0.15))) +
labs(title = "Distribucion Poisson (lambda = 2)",
x = "Componentes fallados (X)", y = "Probabilidad", fill = NULL) +
tema_taller
En la gráfica se observa que la distribución presenta una forma asimétrica positiva, sesgada hacia la derecha. El valor de interés \(P(X=1) = 27.07\%\) es uno de los más probables, junto con \(X=2\). A partir de \(X=3\) las probabilidades caen notablemente, haciendo poco probable observar muchas fallas en este intervalo.
b) Probabilidad de que fallen no más de 2 componentes en 50 horas
Se busca \(P(X \le 2)\) para un intervalo de 50 horas:
\[P(X \le 2) = \sum_{x=0}^{2} \frac{e^{-4} \cdot 4^x}{x!} = 0.0183 + 0.0733 + 0.1465 = 0.2381\]
pHastaDos <- ppois(2, lambda = lambda50)
desglose <- data.frame(
x = as.character(0:2),
Probabilidad = dpois(0:2, lambda = lambda50)
)
desglose <- rbind(desglose, data.frame(x = "P(X <= 2)", Probabilidad = pHastaDos))
construir_tabla(desglose, caption = "Probabilidad acumulada de fallas en 50 horas")| x | Probabilidad |
|---|---|
| 0 | 0.0183 |
| 1 | 0.0733 |
| 2 | 0.1465 |
| P(X <= 2) | 0.2381 |
Informe: se calcula la probabilidad de que fallen
como máximo 2 componentes en un periodo de 50 horas. Al adaptar el
promedio a ese tiempo, la mitad de las 100 horas originales, el promedio
pasa de \(\lambda=8\) a \(\lambda=4\). Como la pregunta pide que
fallen no más de 2 componentes (0, 1 o 2), se usa ppois,
que suma automáticamente esas tres posibilidades, en lugar de
dpois, que solo da la probabilidad de un valor exacto. El
resultado es una probabilidad del 23.81%.
fallas50 <- data.frame(
x = 0:12,
prob = dpois(0:12, lambda = lambda50)
)
fallas50$grupo <- ifelse(fallas50$x <= 2, "X <= 2", "X > 2")
ggplot(fallas50, aes(x = factor(x), y = prob, fill = grupo)) +
geom_col(width = 0.7, color = "white") +
geom_text(aes(label = percent(prob, accuracy = 0.1)),
vjust = -0.5, size = 2.9, color = color_foco) +
scale_fill_manual(values = c("X <= 2" = color_foco, "X > 2" = color_neutro)) +
scale_y_continuous(labels = percent_format(), expand = expansion(mult = c(0, 0.15))) +
labs(title = "Distribucion Poisson (lambda = 4)",
x = "Componentes fallados (X)", y = "Probabilidad", fill = NULL) +
tema_taller
La gráfica muestra una distribución con forma de campana asimétrica, debido al mayor valor de \(\lambda = 4\). Las barras resaltadas (\(X=0,1,2\)) suman \(P(X \le 2) = 23.81\%\) y se ubican en la cola izquierda, lo que evidencia que observar 2 o menos fallas en 50 horas es un evento minoritario, ya que la mayor parte de la probabilidad se acumula por encima de ese valor. A partir de \(X=6\) las probabilidades decaen progresivamente, siendo prácticamente despreciables para \(X \ge 9\), lo que indica que fallos muy numerosos en este intervalo también son poco frecuentes.
fallas25$intervalo <- "25 horas"
fallas50$intervalo <- "50 horas"
comparacion <- rbind(
fallas25[, c("x", "prob", "intervalo")],
fallas50[, c("x", "prob", "intervalo")]
)
ggplot(comparacion, aes(x = x, y = prob, fill = intervalo)) +
geom_col(position = "identity", alpha = 0.75, color = "white") +
scale_fill_manual(values = c("25 horas" = color_foco, "50 horas" = color_secundario)) +
scale_y_continuous(labels = percent_format()) +
scale_x_continuous(breaks = 0:12) +
labs(title = "Distribuciones Poisson para 25 y 50 horas",
x = "Componentes fallados (X)", y = "Probabilidad", fill = NULL) +
tema_taller
Este gráfico comparativo evidencia cómo, al ampliar la ventana de observación de 25 a 50 horas, la distribución se desplaza hacia la derecha y se vuelve más dispersa: con \(\lambda=2\) la moda está entre 1 y 2 fallas, mientras que con \(\lambda=4\) la moda se ubica en 4 fallas y la cola derecha se extiende considerablemente más.
Punto 3
Datos del problema
- Especificación nominal del llenado: \(350 \pm 5\) cc → límites de especificación: LIE = 345 cc, LSE = 355 cc
- Distribución del volumen de llenado en condiciones habituales: Normal con media \(\mu = 360\) cc y varianza \(= 25\text{ cc}^2\)
- Variable aleatoria: \(X\) = volumen de llenado de una botella
Justificación del modelo: se trata de una variable continua que, según el enunciado, sigue una distribución normal con parámetros conocidos (\(\mu = 360\), \(\sigma = 5\)). Por lo tanto:
\[X \sim N(\mu = 360,\ \sigma = 5)\]
mu <- 360
sigmaLlenado <- 5
lie <- 345
lse <- 355
construir_tabla(
data.frame(
Parametro = c("mu", "sigma", "LIE", "LSE"),
Valor = c(mu, sigmaLlenado, lie, lse)
),
caption = "Parametros del proceso de llenado"
)| Parametro | Valor |
|---|---|
| mu | 360 |
| sigma | 5 |
| LIE | 345 |
| LSE | 355 |
a) Porcentaje de botellas no conformes
Una botella es no conforme si su volumen cae fuera de [345, 355]: \[P(\text{no conforme}) = P(X < 345) + P(X > 355)\]
pBajo <- pnorm(lie, mean = mu, sd = sigmaLlenado)
pSobre <- 1 - pnorm(lse, mean = mu, sd = sigmaLlenado)
pNoConforme <- pBajo + pSobre
construir_tabla(
data.frame(
Region = c("P(X < 345)", "P(X > 355)", "Total no conforme"),
Probabilidad = c(pBajo, pSobre, pNoConforme)
),
caption = "Botellas fuera de especificacion", digits = 5
)| Region | Probabilidad |
|---|---|
| P(X < 345) | 0.00135 |
| P(X > 355) | 0.84134 |
| Total no conforme | 0.84269 |
El proceso está gravemente desajustado: como la media (360 cc) está corrida casi 2 desviaciones estándar por encima del nominal (350 cc), la gran mayoría de las botellas (84.27%) resulta no conforme, pero no por defecto de llenado, sino principalmente por sobrellenado (84.13% supera el límite superior de 355 cc). Solo un 0.135% queda por debajo del límite inferior. Esto indica un problema de centrado del proceso, la media debería estar en 350 cc y no en 360 cc, más que un problema de variabilidad.
b) Reserva esperada por reclamaciones
Aquí solo interesan las botellas por debajo del límite inferior (345 cc), pues son las únicas que generan el bono de 10.000 pesos.
lote <- 10000
bono <- 10000
botellasBajo <- lote * pBajo
reserva <- botellasBajo * bono
construir_tabla(
data.frame(
Concepto = c("Tamaño del lote (unidades)",
"Botellas esperadas por debajo de 345 cc",
"Costo por reclamacion (pesos)",
"Reserva por lote (pesos)"),
Valor = c(lote, round(botellasBajo, 2), bono, reserva)
),
caption = "Reserva esperada por reclamaciones", digits = 2
)| Concepto | Valor |
|---|---|
| Tamaño del lote (unidades) | 10,000.0 |
| Botellas esperadas por debajo de 345 cc | 13.5 |
| Costo por reclamacion (pesos) | 10,000.0 |
| Reserva por lote (pesos) | 134,989.8 |
En promedio, la empresa debería reservar 135.000 pesos por cada lote de 10.000 unidades producidas para cubrir los bonos por reclamaciones asociados a botellas con volumen inferior a la especificación. Este monto es mucho menor que el problema real del proceso: como el 84.13% de las botellas está sobrellenando por encima de 355 cc, el costo dominante para la empresa no son las reclamaciones de clientes, sino el desperdicio de producto por exceso de llenado, lo cual sugiere que la prioridad debería ser recentrar el proceso en 350 cc en lugar de enfocarse solo en el riesgo de reclamación.
volumen <- seq(mu - 5*sigmaLlenado, mu + 5*sigmaLlenado, length.out = 400)
curvaLlenado <- data.frame(x = volumen, y = dnorm(volumen, mu, sigmaLlenado))
colaBaja <- subset(curvaLlenado, x <= lie)
colaAlta <- subset(curvaLlenado, x >= lse)
ggplot(curvaLlenado, aes(x, y)) +
geom_line(color = color_foco, linewidth = 1) +
geom_area(data = colaBaja, aes(x, y), fill = color_alarma, alpha = 0.6) +
geom_area(data = colaAlta, aes(x, y), fill = color_secundario, alpha = 0.6) +
geom_vline(xintercept = c(lie, lse), linetype = "dashed", color = color_foco) +
geom_vline(xintercept = mu, linetype = "dotted", color = color_foco) +
annotate("text", x = lie, y = max(curvaLlenado$y)*0.9,
label = percent(pBajo, accuracy = 0.001),
angle = 90, vjust = -0.5, size = 3, color = color_alarma) +
annotate("text", x = lse, y = max(curvaLlenado$y)*0.9,
label = percent(pSobre, accuracy = 0.01),
angle = 90, vjust = -0.5, size = 3, color = "#b3641a") +
labs(title = "Volumen de llenado y limites de especificacion",
subtitle = "N(mu = 360, sigma = 5) | LIE = 345 cc, LSE = 355 cc",
x = "Volumen (cc)", y = "Densidad") +
tema_taller
El gráfico deja ver con claridad por qué el proceso está desajustado: el área naranja bajo la curva, que representa las botellas con volumen superior a 355 cc, es visualmente enorme (84.13% del total) porque la media del proceso, la línea punteada en 360 cc, quedó desplazada hacia la derecha del límite superior de especificación en lugar de estar centrada en el nominal de 350 cc. En contraste, la cola inferior (P(X<345) = 0.135%) es casi imperceptible, lo que confirma que el riesgo real no es entregar botellas con poco contenido, sino desperdiciar producto llenando de más. Esto refuerza que la acción correctiva prioritaria es recentrar el proceso, no solo controlar el costo de las reclamaciones.
Punto 4
Datos del problema
- El peso de los artículos producidos alcanzó como máximo 5.71 gramos el 92.22% de las veces: \(P(X \le 5.71) = 0.9222\)
- El peso también alcanzó como máximo 4.02 gramos el 2.5% de las veces: \(P(X \le 4.02) = 0.025\)
- Variable aleatoria: \(X\) = peso del artículo producido (en gramos)
- Se supone que \(X\) tiene un comportamiento aproximadamente normal
Justificación del modelo: el enunciado nos dice explícitamente que el peso se comporta de forma aproximadamente normal, y lo que se nos da son dos percentiles de esa distribución. Como no conocemos ni \(\mu\) ni \(\sigma\), necesitamos dos ecuaciones, una por cada percentil dado, para poder despejar ambos parámetros, usando la relación de estandarización:
\[x = \mu + z\sigma \quad \Longleftrightarrow \quad z = \frac{x - \mu}{\sigma}\]
peso1 <- 5.71; acumulada1 <- 0.9222
peso2 <- 4.02; acumulada2 <- 0.025
construir_tabla(
data.frame(
Percentil = c("P(X <= 5.71)", "P(X <= 4.02)"),
Peso = c(peso1, peso2),
Probabilidad = c(acumulada1, acumulada2)
),
caption = "Percentiles observados del peso"
)| Percentil | Peso | Probabilidad |
|---|---|---|
| P(X <= 5.71) | 5.71 | 0.9222 |
| P(X <= 4.02) | 4.02 | 0.0250 |
a) Media y desviación estándar
Para cada percentil dado, buscamos el valor \(z\) de la normal estándar que le corresponde:
- \(P(Z \le z_1) = 0.9222 \Rightarrow z_1 = 1.42\)
- \(P(Z \le z_2) = 0.025 \Rightarrow z_2 = -1.96\)
Sistema de ecuaciones: \[5.71 = \mu + 1.42\,\sigma \qquad (1)\] \[4.02 = \mu - 1.96\,\sigma \qquad (2)\]
Resolviendo por eliminación: \[1.69 = 3.38\,\sigma \quad \Rightarrow \quad \sigma = 0.5 \text{ g} \qquad\qquad \mu = 4.02 + 1.96(0.5) = 5.0 \text{ g}\]
z1 <- qnorm(acumulada1)
z2 <- qnorm(acumulada2)
coeficientes <- matrix(c(1, z1, 1, z2), nrow = 2, byrow = TRUE)
terminos <- c(peso1, peso2)
solucion <- solve(coeficientes, terminos)
media <- solucion[1]
desviacion <- solucion[2]
construir_tabla(
data.frame(Parametro = c("z1", "z2", "mu", "sigma"),
Valor = c(z1, z2, media, desviacion)),
caption = "Parametros estimados del peso"
)| Parametro | Valor |
|---|---|
| z1 | 1.42 |
| z2 | -1.96 |
| mu | 5.00 |
| sigma | 0.50 |
El resultado que se obtiene en R confirma lo calculado a mano: \(\mu = 5\) g y \(\sigma = 0.5\) g.
pesos <- seq(media - 4*desviacion, media + 4*desviacion, length.out = 400)
curvaPeso <- data.frame(x = pesos, y = dnorm(pesos, media, desviacion))
marcas <- data.frame(
x = c(peso1, peso2),
y = c(dnorm(peso1, media, desviacion), dnorm(peso2, media, desviacion)),
label = c("0.9222", "0.025")
)
ggplot(curvaPeso, aes(x, y)) +
geom_line(color = color_foco, linewidth = 1) +
geom_area(data = subset(curvaPeso, x <= peso1), fill = color_foco, alpha = 0.15) +
geom_vline(xintercept = c(peso2, peso1), linetype = "dashed", color = color_alarma) +
geom_vline(xintercept = media, linetype = "dotted", color = color_foco) +
geom_text(data = marcas, aes(x, y, label = label),
vjust = -1, size = 3.2, color = color_alarma) +
labs(title = "Normal ajustada (mu = 5, sigma = 0.5)",
x = "Peso (g)", y = "Densidad") +
tema_taller
b) Probabilidad de que el peso esté entre 4.5 g y 5.5 g
\[P(4.5 < X < 5.5) = P(-1 < Z < 1) = \Phi(1) - \Phi(-1) = 0.8413 - 0.1587 = 0.6826\]
pInferior <- pnorm(4.5, mean = media, sd = desviacion)
pSuperior <- pnorm(5.5, mean = media, sd = desviacion)
pIntervalo <- pSuperior - pInferior
construir_tabla(
data.frame(Cantidad = c("P(X < 4.5)", "P(X < 5.5)", "P(4.5 < X < 5.5)"),
Valor = c(pInferior, pSuperior, pIntervalo)),
caption = "Probabilidad del peso entre 4.5 g y 5.5 g"
)| Cantidad | Valor |
|---|---|
| P(X < 4.5) | 0.1587 |
| P(X < 5.5) | 0.8414 |
| P(4.5 < X < 5.5) | 0.6827 |
Esto nos dice que aproximadamente el 68.26% de los artículos pesan entre 4.5 y 5.5 gramos. Tiene sentido, porque ese rango corresponde exactamente a \(\mu \pm 1\sigma\), donde se concentra la mayor parte de los valores en una distribución normal.
areaCentral <- subset(curvaPeso, x >= 4.5 & x <= 5.5)
ggplot(curvaPeso, aes(x, y)) +
geom_line(color = color_foco, linewidth = 1) +
geom_area(data = areaCentral, aes(x, y), fill = color_ok, alpha = 0.45) +
geom_vline(xintercept = c(4.5, 5.5), linetype = "dashed", color = color_ok) +
geom_vline(xintercept = media, linetype = "dotted", color = color_foco) +
annotate("text", x = media, y = max(curvaPeso$y) * 1.05,
label = percent(pIntervalo, accuracy = 0.01),
size = 3.5, color = color_ok, fontface = "bold") +
labs(title = "Peso entre 4.5 g y 5.5 g",
x = "Peso (g)", y = "Densidad") +
tema_taller
Teniendo el hecho de que el 68.26% de la producción caiga dentro de un solo desvío estándar del promedio, se nos confirma que el proceso, tal como fue observado por el ingeniero en ese momento, se comporta de manera consistente con una normal centrada en 5 g. Esto le da al ingeniero un punto de partida claro para fijar límites de control, por ejemplo a \(\mu \pm 3\sigma\), es decir entre 3.5 g y 6.5 g, y poder empezar a monitorear si el proceso se mantiene estable o se desvía con el tiempo.