Se convocaron a estudiantes de enfermería y al público en general para registrarse y apoyar como voluntario en los puestos de vacunación contra covid. Si 7 de cada 10 voluntarios son estudiantes de enfermería:
Calcule la probabilidad de que se necesiten 40 voluntarios registrados para completar 20 estudiantes de enfermería.
Como se necesitan completar 20 éxitos de estudiantes de enfermería con probabilidad 7/10=0.7, se necesitan otros 20 fracasos antes de obtener los éxitos para completar a 40 voluntarios, por lo que \(X\sim BinNeg.-(r=20,p=0.7)\) y la probabilidad \(P[X=20]=\binom{20+20-1}{20}p^{20}(1-p)^{20}\) es igual a:
dnbinom(20,20,7/10)
## [1] 0.001917572
Calcule la probabilidad de que se necesiten 30 voluntarios registrados para completar 20 estudiantes de enfermería.
Para este caso se necesitan 10 fracasos para completar a 30 voluntarios con los 20 éxitos de estudiantes de enfermería. Entonces la probabilidad \(P[X=10]=\binom{20+10-1}{10}(p)^{20}(1-p)^{10}\) es igual a:
dnbinom(10,20,7/10)
## [1] 0.09437447
Grafique la función de probabilidad (o densidad) utilizada
library(tidyverse)
data <- tibble(fracasos = 0:20, p = dnbinom(x = fracasos, size = 20, prob = 0.7))
ggplot(data,aes(x=fracasos,y=p)) +
geom_point(colour="blue") +
geom_point(data=data[c(11,21), ], aes(x=fracasos, y=p),
colour="red", size=5) +
ggtitle("Distribución de fracasos de estudiantes")
Los precios nacionales por arrendamiento de tanques con oxígeno medicinal con capacidad para 10,000 litros de oxígeno, tan demandados durante la contingencia sanitaria por covid, tienen una media de MX$1177 y una desviación estándar de MX$972. Si se elige una muestra de 40 tanques:
Aproxime la probabilidad de que la media muestral de sus precios se encuentre entre MX$1000 y MX$1200 pesos.
Por el T.L.C. \(\bar{X} \sim N.-(\mu=1177,\sigma^2=972^2/40)\), por lo que tenemos que la probabilidad es:
pnorm(1200,1177,972/sqrt(40))-pnorm(1000,1177,972/sqrt(40))
## [1] 0.4347582
Grafique la función de probabilidad (o densidad) utilizada.
library(tidyverse)
ggplot(data = tibble(precio = c(600,1700)),
mapping = aes(x = precio)) +
stat_function(fun = ~ dnorm(.,1177,972/sqrt(40)),
geom = "area",
fill = "lightblue",
xlim = c(1000, 1200)) +
stat_function(fun = ~ dnorm(.,1177,972/sqrt(40)),
size = 1.5) +
scale_y_continuous(expand = expansion(mult = c(0, 0.01))) +
scale_x_continuous(breaks = c(900, 1177, 1400)) +
coord_cartesian(xlim = c(600,1700)) +
labs(x = "precio", y = "densidad") +
ggtitle("Distribución de tanques entre MX$1000 y MX$1200")
Ante la demanda ocasionada por la pandemia de covid, se realizó una investigación de los precios por recargas de oxígeno medicinal en cilindros con capacidad para 10,000 litros de oxígeno. Si el precio ofrecido por los proveedores nacionales sigue una distribución normal con media de MX$731 y desviación estándar de MX$175:
Calcule el porcentaje de tanques cuyo precio oscila entre MX$600 y MX$700.
(pnorm(700,731,175)-pnorm(600,731,175))*100
## [1] 20.26403
Calcule el porcentaje de tanques cuyo precio es de al menos MX$800.
pnorm(800,731,175,lower.tail = FALSE)*100
## [1] 34.66851
Grafique la función de probabilidad (o densidad) utilizada.
ggplot(data = tibble(precio = c(100,1400)),
mapping = aes(x = precio)) +
stat_function(fun = ~ dnorm(.,731,175),
geom = "area",
fill = "lightblue",
xlim = c(600, 700)) +
stat_function(fun = ~ dnorm(.,731,175),
size = 1.5) +
scale_y_continuous(expand = expansion(mult = c(0, 0.01))) +
scale_x_continuous(breaks = c(400, 731, 1000)) +
coord_cartesian(xlim = c(100,1400)) +
labs(x = "precio", y = "densidad") +
ggtitle("Distribución de tanques entre MX$600 y MX$700")
ggplot(data = tibble(precio = c(100,1400)),
mapping = aes(x = precio)) +
stat_function(fun = ~ dnorm(.,731,175),
geom = "area",
fill = "lightblue",
xlim = c(800, 1400)) +
stat_function(fun = ~ dnorm(.,731,175),
size = 1.5) +
scale_y_continuous(expand = expansion(mult = c(0, 0.01))) +
scale_x_continuous(breaks = c(400, 731, 1000)) +
coord_cartesian(xlim = c(100,1400)) +
labs(x = "precio", y = "densidad") +
ggtitle("Distribución de tanques de al menos MX$800")
El primer filtro en un puesto de vacunación contra covid, consiste en preguntar a las personas si han presentado en la última semana alguno de los síntomas asociados a la enfermedad como tos y fiebre. Si alguna persona ha presentado al menos uno de estos síntomas, se le invita a pasar a responder un cuestionario más detallado con profesionales de la salud para decidir si es conveniente vacunarlo o no. Si de registros previos se sabe que el 97% de las personas que acuden a vacunarse no han presentado síntomas en la última semana:
Calcule la probabilidad de que se necesiten encuestar a 100 personas para encontrar a la primera que pasará a responder el cuestionario detallado.
Como se quiere encontrar la probabilidad de encuestar a 100 personas para encontrar el primer éxito, se necesitan 99 fracasos y \(X\sim Geo.- p=0.3\). Entonces \(P[X=99]=p(1-p)^{99}\) es
dgeom(99,0.03)
## [1] 0.001470696
Calcule la probabilidad de que la 50° persona sea la primera que pasará a responder el cuestionario detallado.
Como se quiere encontrar la probabilidad de encuestar a 50 personas y que las primeras 49 sean fracasos, entonces \(P[X=49]=p(1-p)^{49}\) es
dgeom(49,0.03)
## [1] 0.00674429
Calcule la probabilidad de que la primera persona encuestada sea la primera que pasará a responder el cuestionario detallado.
En este caso, no se espera ningún fracaso, por lo que \(P[X=0]=p(1-p)^{0}\), que es equivalente a la probabilidad de que la personas haya presentado síntomas en la última semana, y es:
dgeom(0,0.03)
## [1] 0.03
Grafique la función de probabilidad (o densidad) utilizada.
data <- tibble(fracasos = 0:101, p = dgeom(x = fracasos, prob = 0.03))
ggplot(data,aes(x=fracasos,y=p)) +
geom_point(colour="blue") +
geom_point(data=data[c(1,50,100), ], aes(x=fracasos, y=p),
colour="red", size=5) +
ggtitle("Distribución de fracasos para responder cuestionario")
Durante el proceso de vacunación contra covid, se aplicaron en cierto centro de salud 100 vacunas de la marca Moderna, y 200 de la marca Pfizer. Si de las 300 personas vacunadas se selecciona una muestra de 15, y se les contacta por teléfono para dar seguimiento e investigar las posibles reacciones provocadas por la vacuna:
Calcule la probabilidad de que todas personas seleccionadas en la muestra hayan sido vacunadas con la vacuna Moderna.
Como se elige una muestra de tamaño 15 sin reemplazo de entre N+M vacunas, donde N son de tipo Moderna y M del tipo Pfizer, tenemos que \(X\sim Hip.-(N=100,M=200,n=15)\), por lo que la probabilidad \(P[X=15]=\frac{{N\choose15}{M\choose0}}{N+M\choose15}\) (donde \(X\) es el número de vacunas de tipo Moderna), es igual a:
dhyper(15,100,200,15)
## [1] 3.295299e-08
Calcule la probabilidad de que dos o más de las personas de la muestra hayan sido vacunadas con Moderna
phyper(1,100,200,15,lower.tail = FALSE)
## [1] 0.9827509
Calcule la probabilidad de que entre 7 y 10 personas hayan sido vacunadas con Pfizer
phyper(10,100,200,15)-phyper(6,100,200,15)
## [1] 0.1961087
Grafique la función de probabilidad (o densidad) utilizada.
data <- tibble(muestra = 0:15, p = dhyper(x = muestra,100,200,15))
ggplot(data,aes(x=muestra,y=p)) +
geom_point() +
geom_point(data=data[16, ], aes(x=muestra, y=p),
colour="red", size=8) +
geom_point(data=data[c(3:16), ], aes(x=muestra, y=p),
colour="blue", size=5) +
geom_point(data=data[c(8:11), ], aes(x=muestra, y=p),
colour="green", size=3) +
ggtitle("Distribución de vacunas por marca")
## R version 4.1.2 (2021-11-01)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.3 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/liblapack.so.3
##
## locale:
## [1] LC_CTYPE=es_MX.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=es_MX.UTF-8 LC_COLLATE=es_MX.UTF-8
## [5] LC_MONETARY=es_MX.UTF-8 LC_MESSAGES=es_MX.UTF-8
## [7] LC_PAPER=es_MX.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=es_MX.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
## [5] readr_2.1.2 tidyr_1.1.4 tibble_3.1.6 ggplot2_3.3.5
## [9] tidyverse_1.3.1 BiocStyle_2.22.0
##
## loaded via a namespace (and not attached):
## [1] Rcpp_1.0.7 lubridate_1.8.0 assertthat_0.2.1
## [4] digest_0.6.29 utf8_1.2.2 R6_2.5.1
## [7] cellranger_1.1.0 backports_1.4.1 reprex_2.0.1
## [10] evaluate_0.14 httr_1.4.2 highr_0.9
## [13] pillar_1.6.4 rlang_0.4.12 readxl_1.3.1
## [16] rstudioapi_0.13 jquerylib_0.1.4 magick_2.7.3
## [19] rmarkdown_2.11 labeling_0.4.2 munsell_0.5.0
## [22] broom_0.7.10 compiler_4.1.2 modelr_0.1.8
## [25] xfun_0.29 pkgconfig_2.0.3 htmltools_0.5.2
## [28] tidyselect_1.1.1 bookdown_0.24 fansi_0.5.0
## [31] crayon_1.4.2 tzdb_0.2.0 dbplyr_2.1.1
## [34] withr_2.4.3 grid_4.1.2 jsonlite_1.7.2
## [37] gtable_0.3.0 lifecycle_1.0.1 DBI_1.1.1
## [40] magrittr_2.0.1 scales_1.1.1 cli_3.1.0
## [43] stringi_1.7.6 farver_2.1.0 fs_1.5.0
## [46] xml2_1.3.2 bslib_0.3.1 ellipsis_0.3.2
## [49] generics_0.1.1 vctrs_0.3.8 tools_4.1.2
## [52] glue_1.6.0 hms_1.1.1 fastmap_1.1.0
## [55] yaml_2.2.1 colorspace_2.0-2 BiocManager_1.30.16
## [58] rvest_1.0.2 knitr_1.37 haven_2.4.3
## [61] sass_0.4.0