Integrantes:

• Michael Andres Ortiz Bernal
• Magda Sofia Carvajal Burgos
• Samuel Rodriguez Marañon
• Darwin Samir Padilla Viloria

Ejercicios capitulo 6

Ejercicio 6.5

Dada una distribución normal estándar, calcule el área bajo la curva que está:

  1. A la izquierda de z = -1.39
  2. A la derecha de z = 1.96
  3. Entre z = -2.16 y z = -0.65
  4. A la izquierda de z = 1.43
  5. A la derecha de z = -0.89
  6. Entre z = -0.48 y z = 1.74

Solución

z <- seq(-4,4,length=400)
df <- data.frame(z=z, dens=dnorm(z))


p_a <- pnorm(-1.39)
p_a
## [1] 0.08226444
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z <= -1.39), aes(z,dens), fill="skyblue") +
ggtitle("Área a la izquierda de z = -1.39")

p_b <- 1 - pnorm(1.96)
p_b
## [1] 0.0249979
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z >= 1.96), aes(z,dens), fill="skyblue") +
ggtitle("Área a la derecha de z = 1.96")

p_c <- pnorm(-0.65) - pnorm(-2.16)
p_c
## [1] 0.2424598
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z >= -2.16 & z <= -0.65), aes(z,dens), fill="skyblue") +
ggtitle("Área entre z = -2.16 y z = -0.65")

p_d <- pnorm(1.43)
p_d
## [1] 0.9236415
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z <= 1.43), aes(z,dens), fill="skyblue") +
ggtitle("Área a la izquierda de z = 1.43")

p_e <- 1 - pnorm(-0.89)
p_e
## [1] 0.8132671
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z >= -0.89), aes(z,dens), fill="skyblue") +
ggtitle("Área a la derecha de z = -0.89")

p_f <- pnorm(1.74) - pnorm(-0.48)
p_f
## [1] 0.6434568
ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z >= -0.48 & z <= 1.74), aes(z,dens), fill="skyblue") +
ggtitle("Área entre z = -0.48 y z = 1.74")

Ejercicio 6.7

Dada una distribucion normal estandar, calcule el valor de “K” tal que:

\[ P(Z<K)=0.2946 \\ P(Z<K)=0.0427 \\ P(-0.93<Z<X)=0.7235 \] Solución

k_a <- qnorm(0.2946)
k_a
## [1] -0.5399957
k_b <- qnorm(0.0427)
k_b
## [1] -1.720178
p_left_minus093 <- pnorm(-0.93)
p_total <- 0.7235 + p_left_minus093
k_c <- qnorm(p_total)
k_c
## [1] 1.279762
z <- seq(-4,4,length=400)
df <- data.frame(z=z, dens=dnorm(z))


ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z <= k_a), aes(z,dens), fill="skyblue") +
ggtitle(paste("Área P(Z < k) = 0.2946,  k =", round(k_a, 3)))

ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z <= k_b), aes(z,dens), fill="skyblue") +
ggtitle(paste("Área P(Z < k) = 0.0427,  k =", round(k_b, 3)))

ggplot(df, aes(z,dens)) +
geom_line() +
geom_area(data=df %>% filter(z >= -0.93 & z <= k_c), aes(z,dens), fill="skyblue") +
ggtitle(paste("Área entre -0.93 y k = 0.7235, k =", round(k_c, 3)))

Ejercicio 6.9

Dada la variable X normalmente distribuida con una media de 18 y una desviación estándar de 2.5, calcule:

  1. P(X < 15)

  2. El valor de k tal que P(X < k) = 0.2236

  3. El valor de k tal que P(X > k) = 0.1814

  4. P(17 < X < 21)

Solución

mu <- 18
sigma <- 2.5

p_a <- pnorm(15, mean = mu, sd = sigma)
p_a
## [1] 0.1150697
k_b <- qnorm(0.2236, mean = mu, sd = sigma)
k_b
## [1] 16.09977
k_c <- qnorm(1 - 0.1814, mean = mu, sd = sigma)
k_c
## [1] 20.27511
p_d <- pnorm(21, mean = mu, sd = sigma) - pnorm(17, mean = mu, sd = sigma)
p_d
## [1] 0.5403521
x <- seq(mu - 4*sigma, mu + 4*sigma, length=400)
df <- data.frame(x=x, dens=dnorm(x, mean=mu, sd=sigma))


ggplot(df, aes(x,dens)) +
geom_line() +
geom_area(data=df %>% filter(x <= 15), aes(x,dens), fill="skyblue") +
ggtitle(paste("Área P(X < 15) =", round(p_a, 4)))

ggplot(df, aes(x,dens)) +
geom_line() +
geom_area(data=df %>% filter(x <= k_b), aes(x,dens), fill="skyblue") +
ggtitle(paste("Área P(X < k) = 0.2236  →  k =", round(k_b, 3)))

ggplot(df, aes(x,dens)) +
geom_line() +
geom_area(data=df %>% filter(x >= k_c), aes(x,dens), fill="skyblue") +
ggtitle(paste("Área P(X > k) = 0.1814  →  k =", round(k_c, 3)))

ggplot(df, aes(x,dens)) +
geom_line() +
geom_area(data=df %>% filter(x >= 17 & x <= 21), aes(x,dens), fill="skyblue") +
ggtitle(paste("Área P(17 < X < 21) =", round(p_d, 4)))

Ejercicio 6.11

Una máquina expendedora de bebidas gaseosas se regula para que sirva un promedio de 200 mililitros por vaso. Si la cantidad de bebida se distribuye normalmente con una desviación estándar igual a 15 mililitros,

  1. ¿qué fracción de los vasos contendrá más de 224 mililitros?
  2. ¿cuál es la probabilidad de que un vaso contenga entre 191 y 209 mililitros?
  3. ¿cuántos vasos probablemente se derramarán si se utilizan vasos de 230 mililitros para las siguientes 1000 bebidas? d ) ¿por debajo de qué valor obtendremos el 25% más bajo en el llenado de las bebidas?
mu <- 200
sigma <- 15

# a) P(X > 224)
sol_a <- 1 - pnorm(224, mean = mu, sd = sigma)
cat("6.11 a) P(X > 224) =", sol_a, "\n")
## 6.11 a) P(X > 224) = 0.05479929
# b) P(191 < X < 209)
sol_b <- pnorm(209, mean = mu, sd = sigma) - pnorm(191, mean = mu, sd = sigma)
cat("6.11 b) P(191 < X < 209) =", sol_b, "\n")
## 6.11 b) P(191 < X < 209) = 0.4514938
# c) Derrames con vasos de 230 ml en 1000 vasos
sol_c <- 1 - pnorm(230, mean = mu, sd = sigma)
sol_c_1000 <- 1000 * sol_c
cat("6.11 c) Derrames esperados en 1000 vasos =", sol_c_1000, "\n")
## 6.11 c) Derrames esperados en 1000 vasos = 22.75013
# d) Valor por debajo del cual está el 25% más bajo
sol_d <- qnorm(0.25, mean = mu, sd = sigma)
cat("6.11 d) Percentil 25% =", sol_d, "\n")
## 6.11 d) Percentil 25% = 189.8827

Ejercicio 6.13

Un investigador informa que unos ratones a los que primero se les restringen drásticamente sus dietas y después se les enriquecen con vitaminas y proteínas vivirán un promedio de 40 meses. Si suponemos que la vida de tales ratones se distribuye normalmente, con una desviación estándar de 6.3 meses, calcule la probabilidad de que un ratón determinado viva

  1. más de 32 meses;
  2. menos de 28 meses;
  3. entre 37 y 4
mu_r <- 40
sigma_r <- 6.3

# a) P(X > 32)
sol_a <- 1 - pnorm(32, mean = mu_r, sd = sigma_r)
cat("6.13 a) P(X > 32) =", sol_a, "\n")
## 6.13 a) P(X > 32) = 0.8979294
# b) P(X < 28)
sol_b <- pnorm(28, mean = mu_r, sd = sigma_r)
cat("6.13 b) P(X < 28) =", sol_b, "\n")
## 6.13 b) P(X < 28) = 0.02840551
# c) P(37 < X < 49)
sol_c <- pnorm(49, mean = mu_r, sd = sigma_r) - pnorm(37, mean = mu_r, sd = sigma_r)
cat("6.13 c) P(37 < X < 49) =", sol_c, "\n")
## 6.13 c) P(37 < X < 49) = 0.6064669

Ejercicio 6.15

Un abogado viaja todos los dias de su casa en los suburbios a su oficina en el centro de la ciudad. El tiempo promedio para su viaje solo de ida es de 24 minutos, con una desviacion estandar de 3.8 minutos. Si se supone que la distribuicion de los tiempos de viaje esta distribuida normalmente.

  1. ¿Cual es la probabilidad de un viaje tome al menos 1/2 hora?
mu <- 24
sigma <- 3.8


probabili_h <- pnorm(30, mean = mu, sd = sigma, lower.tail = FALSE)

probabili_h
## [1] 0.05717406
  1. Si la oficina abre a las 9:00 A.M. y el sale diario de su casa a las 8:45 A.M., ¿que porcentaje de las ventas llegara tarde al trabajo?
mu <- 24
sigma <- 3.8


probabili_t  <- pnorm(15, mean = mu, sd = sigma)

probabili_t
## [1] 0.008932096
  1. Si sale de su casa a las 8:35 A.M. y el cafe se sirve en la oficina de 8:50 A.M. a 9:00 A.M., ¿cual es la probabilidad de que se pierda el cafe?
mu <- 24
sigma <- 3.8


probabili_c <- pnorm(25, mu, sigma) - pnorm(15, mu, sigma)

probabili_c
## [1] 0.5948535
  1. Calcule la duracion mayor en la que se encuentra el 15% de los viajes mas lentos.
mu <- 24
sigma <- 3.8


probabili_d <- qnorm(0.85, mean = mu, sd = sigma)

probabili_d
## [1] 27.93845
  1. Calcule la probabilidad de que 2 de los siguientes 3 viajes tomen al menos 1/2 hora.
mu <- 24
sigma <- 3.8


probabili_3 <- pnorm(30, mu, sigma, lower.tail = FALSE)

probabili_v <- dbinom(2, size = 3, prob = probabili_3)

probabili_v
## [1] 0.009245937

Ejercicio 6.17

La vida promadio de cierto tipo de motor pequeño es de 10 años, con una desviacion estandar de 2 año. El fabricante reemplaza gratis todos los motores que fallen dentro del periodo de garantia. Si estudviera dispuesto a reemplazar solo el 3% de los motores que fallan, ¿cuanto tiempo de garantia deberia ofrecer? Suponga que la duracion de un motor sigue una distribucion normal.

mu <- 10
sigma <- 2


tiempo <- qnorm(0.03, mean = mu, sd = sigma)

tiempo
## [1] 6.238413

Ejercicio 6.19

Una empresa paga a sus empleados un salario promedio de $15.90 por hora, con una desviación estándar de $1.50. Si los salarios se distribuyen aproximadamente de forma normal y se redondean al centavo más cercano,

  1. ¿qué porcentaje de los trabajadores recibe salarios de entre $13.75 y $16.22 por hora?

  2. ¿el 5% de los salarios más altos por hora de los empleados es mayor a qué cantidad?

Solución

media_salario <- 15.90
desviacion_salario <- 1.50

prob_entre_13.75_16.22 <- pnorm(16.225, media_salario, desviacion_salario) - 
                          pnorm(13.745, media_salario, desviacion_salario)

salario_percentil_95 <- qnorm(0.95, media_salario, desviacion_salario)


valores_salario <- seq(10, 22, 0.01)
datos_salario <- data.frame(salario = valores_salario, 
                           densidad = dnorm(valores_salario, media_salario, desviacion_salario))


area_entre <- subset(datos_salario, salario >= 13.745 & salario <= 16.225)

grafica_entre <- ggplot(datos_salario, aes(x = salario, y = densidad)) +
  geom_line(col = "#4876FF") +
  geom_area(data = area_entre, aes(x = salario, y = densidad), 
            fill = "#4876FF", alpha = 0.5) +
  labs(title = "Salarios entre $13.75 y $16.22 por hora",
       x = "Salario por hora ($)", y = "Densidad") +
  theme_bw() +
  theme(
    plot.title = element_text(hjust = 0.5)  
  )


area_superior <- subset(datos_salario, salario >= salario_percentil_95)

grafica_superior <- ggplot(datos_salario, aes(x = salario, y = densidad)) +
  geom_line(col = "#1874CD") +
  geom_area(data = area_superior, aes(x = salario, y = densidad), 
            fill = "#1874CD", alpha = 0.5) +
  geom_vline(xintercept = salario_percentil_95, linetype = "dashed", col = "red") +
  labs(title = "5% de Salarios Más Altos",
       x = "Salario por hora ($)", 
       y = "Densidad") +
  theme_bw() +
  theme(
    plot.title = element_text(hjust = 0.5)  
  )


grafica_entre

grafica_superior

resultados_salario <- data.frame(
  Inciso = c("a", "b"),
  Descripción = c("Porcentaje entre $13.75 y $16.22", 
                  "Límite del 5% más alto"),
  Resultado = c(paste(round(prob_entre_13.75_16.22 * 100, 2), "%"), 
                paste("$", round(salario_percentil_95, 2)))
)


tabla_salario <- flextable(resultados_salario)
tabla_salario <- bg(tabla_salario, j = 3, bg = "#E6F2FF")
tabla_salario

Inciso

Descripción

Resultado

a

Porcentaje entre $13.75 y $16.22

51.04 %

b

Límite del 5% más alto

$ 18.37

## a) Porcentaje entre $13.75 y $16.22 = 51.04 %

aproximadamente el 51.04% de los empleados gana entre $13.75 y $16.22 por hora.

## b) El 5% de salarios más altos es mayor a: $ 18.37

el 5% de los salarios por hora más altos son mayores que aproximadamente $18.37/hora. Dicho de otra forma: si tomas a todos los empleados ordenados por salario, el salario que separa el 95% inferior del 5% superior es cerca de $18.37/hora.

Ejercicio 6.21

La resistencia a la tensión de cierto componente de metal se distribuye normalmente con una media de 10,000 kilogramos por centímetro cuadrado y una desviación estándar de 100 kilogramos por centímetro cuadrado. Las mediciones se redondean a los 50 kilogramos por centímetro cuadrado más cercanos.

  1. ¿Qué proporción de estos componentes excede a 10,150 kilogramos por centímetro cuadrado de resistencia a la tensión?

  2. Si las especifi caciones requieren que todos los componentes tengan una resistencia a la tensión de entre 9800 y 10,200 kilogramos por centímetro cuadrado, ¿qué proporción de piezas esperaría que se descartara?

Solución

media_resistencia <- 10000
desviacion_resistencia <- 100


prob_excede_10150 <- pnorm(10150, media_resistencia, desviacion_resistencia, lower.tail = FALSE)



prob_entre_9800_10200 <- pnorm(10200, media_resistencia, desviacion_resistencia) - 
                         pnorm(9800, media_resistencia, desviacion_resistencia)
prob_descartada <- 1 - prob_entre_9800_10200


valores_resistencia <- seq(9700, 10300, 1)
datos_resistencia <- data.frame(resistencia = valores_resistencia, 
                               densidad = dnorm(valores_resistencia, media_resistencia, desviacion_resistencia))


area_excede_10150 <- subset(datos_resistencia, resistencia >= 10150)

grafica_excede <- ggplot(datos_resistencia, aes(x = resistencia, y = densidad)) +
  geom_line(col = "#4876FF") +
  geom_area(data = area_excede_10150, aes(x = resistencia, y = densidad), 
            fill = "#4876FF", alpha = 0.5) +
  labs(title = "Componentes que exceden 10,150 kg/cm²",
       x = "Resistencia (kg/cm²)", y = "Densidad") +
  theme_bw() +
  theme(
    plot.title = element_text(hjust = 0.5)  
  )


area_aceptada <- subset(datos_resistencia, resistencia >= 9800 & resistencia <= 10200)
area_descartada_baja <- subset(datos_resistencia, resistencia < 9800)
area_descartada_alta <- subset(datos_resistencia, resistencia > 10200)

grafica_descartes <- ggplot(datos_resistencia, aes(x = resistencia, y = densidad)) +
  geom_line(col = "#1874CD") +
  geom_area(data = area_aceptada, aes(x = resistencia, y = densidad), 
            fill = "#1874CD", alpha = 0.5) +
  geom_area(data = area_descartada_baja, aes(x = resistencia, y = densidad), 
            fill = "red", alpha = 0.3) +
  geom_area(data = area_descartada_alta, aes(x = resistencia, y = densidad), 
            fill = "red", alpha = 0.3) +
  labs(title = "Componentes dentro y fuera de especificaciones",
       subtitle = "Azul: Aceptados | Rojo: Descartados",
       x = "Resistencia (kg/cm²)", y = "Densidad") +
  theme_bw() +
  theme(
    plot.title = element_text(hjust = 0.5)  
  )

grafica_excede

grafica_descartes

resultados_resistencia <- data.frame(
  Inciso = c("a", "b"),
  Descripción = c("Proporción > 10,150 kg/cm²", 
                  "Proporción descartada"),
  Resultado = c(paste(round(prob_excede_10150 * 100, 2), "%"), 
                paste(round(prob_descartada * 100, 2), "%"))
)


tabla_resultados <- flextable(resultados_resistencia)
tabla_resultados <- bg(tabla_resultados, j = 3, bg = "#E6F2FF")
tabla_resultados

Inciso

Descripción

Resultado

a

Proporción > 10,150 kg/cm²

6.68 %

b

Proporción descartada

4.55 %

## a) Proporción que excede 10,150 kg/cm² = 0.0668
##    Equivale a: 6.68 %

aproximadamente el 6.68%n de los componentes tienen resistencia verdadera mayor a 10,150 kg/cm².

## b) Proporción descartada = 0.0455
##    Equivale a: 4.55 %

si aplicas la especificación sobre la resistencia real, esperarías descartar alrededor del 4.55% de las piezas (2.275% por debajo de 9,800 y 2.275% por encima de 10,200).

Ejercicio 6.23

El coeficiente intelectual (CI) de 600 aspirantes a cierta universidad se distribuye aproximadamente de forma normal con una media de 115 y una desviación estándar de 12. Si la universidad requiere un CI de al menos 95, ¿cuántos de estos estudiantes serán rechazados con base en éste sin importar sus otras califi caciones? Tome en cuenta que el CI de los aspirantes se redondea al entero más cercano.

Solución

media_ci <- 115
desviacion_ci <- 12
total_aspirantes <- 600

prob_rechazado <- pnorm(94.5, media_ci, desviacion_ci)

estudiantes_rechazados <- total_aspirantes * prob_rechazado

valores_ci <- seq(70, 160, 0.1)
datos_ci <- data.frame(ci = valores_ci, 
                      densidad = dnorm(valores_ci, media_ci, desviacion_ci))


area_rechazados <- subset(datos_ci, ci <= 94.5)
area_aceptados <- subset(datos_ci, ci > 94.5)

grafica_ci <- ggplot(datos_ci, aes(x = ci, y = densidad)) +
  geom_line(col = "#4876FF") +
  geom_area(data = area_rechazados, aes(x = ci, y = densidad), 
            fill = "red", alpha = 0.5) +
  geom_area(data = area_aceptados, aes(x = ci, y = densidad), 
            fill = "#1874CD", alpha = 0.3) +
  geom_vline(xintercept = 94.5, linetype = "dashed", col = "black") +
  labs(title = "Distribución del Coeficiente Intelectual",
       subtitle = "Rojo: Rechazados (CI < 95) | Azul: Aceptados",
       x = "Coeficiente Intelectual", 
       y = "Densidad") +
  theme_bw() +
  theme(
    plot.title = element_text(hjust = 0.5)  
  )


grafica_ci

resultados_ci <- data.frame(
  Concepto = c("Media del CI", "Desviación estándar", "Total aspirantes", 
               "Probabilidad de rechazo", "Estudiantes rechazados"),
  Valor = c(media_ci, desviacion_ci, total_aspirantes,
            paste(round(prob_rechazado * 100, 2), "%"),
            round(estudiantes_rechazados))
)


tabla_ci <- flextable(resultados_ci)
tabla_ci <- bg(tabla_ci, j = 2, bg = "#E6F2FF")
tabla_ci

Concepto

Valor

Media del CI

115

Desviación estándar

12

Total aspirantes

600

Probabilidad de rechazo

4.38 %

Estudiantes rechazados

26

## Probabilidad de CI < 95 = 0.0438
## Número de estudiantes rechazados = 26

Al rededor de 26 aspirantes serán rechazados por no alcanzar el CI mínimo de 95, considerando el redondeo al entero más cercano.