Actividad 2 y 3 : Probabilidad e Inferencia Estadística

Ejercicio 1

En un sistema de producción de hortalizas se detectan tres plagas. El 25% de las plantas tiene la enfermedad A, el 20% B y el 30% C. El 12% la A y B, el 10% la A y C, el 11% B y C y el 5% tiene las tres enfermedades. Obtener:

  • El diagrama de Venn para representar el enunciado.
  • La probabilidad de que una planta posea alguna de las enfermedades (PAE). (Rta: 0.47)
  • La probabilidad de que una planta posea la enfermedad A pero no la B. (PA_B) (Rta: 0.13)
  • La probabilidad de que una planta posea la enfermedad B y C pero no la A. (PBC_A) (Rta: 0.06)

Diagrama

library(VennDiagram)
draw.triple.venn(area1 = 0.25, area2 = 0.20, area3 = 0.30, n12 = 0.12, n23 = 0.11, n13 = 0.10, n123 = 0.05, category = c("A", "B", "C"), lty = "blank", 
    fill = c("skyblue", "pink1", "mediumorchid"))

## (polygon[GRID.polygon.1], polygon[GRID.polygon.2], polygon[GRID.polygon.3], polygon[GRID.polygon.4], polygon[GRID.polygon.5], polygon[GRID.polygon.6], text[GRID.text.7], text[GRID.text.8], text[GRID.text.9], text[GRID.text.10], text[GRID.text.11], text[GRID.text.12], text[GRID.text.13], text[GRID.text.14], text[GRID.text.15], text[GRID.text.16])
  • PAE

\[ P(A\cup B \cup C) = P(A)+P(B)+P(C)-P(A\cap B)-P(A\cap C) - P(B\cap C)+P(A\cap B \cap C)\\ = 0.25+0.20+0.30-0.12-0.10-0.11+0.05= 0.47 \]

Resultado_PAE = (0.25+0.20+0.30 -0.12-0.10-0.11 + 0.05)
Resultado_PAE
## [1] 0.47
  • PA-B

\[ P(A-B) = P(A) - P(A\cap B) \\ = 0.25- 0.12=0.13\]

Resultado_PA_B = (0.25-0.12)
Resultado_PA_B
## [1] 0.13
  • PBC_A: Para resolver sumo las diferencias de las probabilidades de \(P(A-B)\) y \(P(A-C)\) y las resto la probabilidad \(P(B\cup C)\)

\[ P(A-B) = P(A) - P(A\cap B) \\ = 0.25- 0.12=0.13\]

\[ P(A-C) = P(A) - P(A\cap C) \\ = 0.25- 0.10= 0.15\]

\[ P(B \cup C) = P(B)+P(C) - P(B\cap C)- P(A \cap B \cap C) \\ = 0.20 + 0.30 - 0.11 -0.05= 0.340 \] - Sumatoria:

\[ P(B \cup C)- (P(A-B) - P(A-C)) \\ = 0.340 - 0.13 - 0.15 \\ = 0.06 \]

Resultado_PBC_A = (0.340-0.13-0.15)
Resultado_PBC_A
## [1] 0.06

Ejercicio 2

Se tiene un lote de 200 animales, de los cuales 88 requieren se vacunados y lo están, 28 necesitan la vacuna pero no lo están, 4 no necesitan la vacuna pero están vacunados, 80 no necesitan la vacuna y no están vacunados. Construya una tabla que represente el problema y determine las probabilidades para los siguientes eventos:

  • El animal requiere ser vacunado (Rta: 0.58)
  • El animal requiere ser vacunado pero no lo está (Rta: 0.14)
  • El animal está vacunado, sea que lo requiera o no. (Rta: 0.46)

Tabla:

Diagrama:

  • P(ARV)
Resultado_P_ARV = (88+28)/200
Resultado_P_ARV
## [1] 0.58
  • P(ARVN)
Resultado_P_ARVN = (28/200)
Resultado_P_ARVN
## [1] 0.14
  • P(AV)
Resultado_P_Av = (88+4)/200
Resultado_P_Av
## [1] 0.46

Ejercicio 3

Si se extrae al azar un estudiante encuestado, ¿Cuál es la probabilidad de que el estudiante tenga un promedio académico entre 3.7 y 3.9?

  • Observación de los datos:
library(readxl)
library(tidyverse)
datos <- read_excel("encuesta_depurada.xlsx")
datos
## # A tibble: 30 x 10
##    promedio_academico color_favorito horas_estudiar horas_dormir redes_sociales
##                 <dbl> <chr>                   <dbl>        <dbl>          <dbl>
##  1               3.53 Verde                      30            7              4
##  2               3.8  Amarillo                   12            6              9
##  3               4.02 Rojo                       45            6              3
##  4               4.39 Negro                      60            6              2
##  5               3.99 Azul                       50            8              9
##  6               3.8  Vino tinto                 25            2              5
##  7               3.83 Rosado                     28            2              2
##  8               3.8  Negro                      40            6              4
##  9               3.8  Negro                      40            6              4
## 10               3.88 Azul                       36            7              5
## # ... with 20 more rows, and 5 more variables: redsocial_favorita <chr>,
## #   bachiller_universidad <chr>, lectura <chr>, horas_internet <dbl>,
## #   trabajo <chr>
  • Promedios ordenados:
sort(datos$promedio_academico, decreasing = FALSE)
##  [1] 3.30 3.30 3.30 3.37 3.37 3.50 3.50 3.50 3.50 3.53 3.60 3.70 3.70 3.71 3.74
## [16] 3.75 3.80 3.80 3.80 3.80 3.80 3.80 3.83 3.84 3.88 3.89 3.96 3.99 4.02 4.39
  • media y varianza:
media_datos <- mean(datos$promedio_academico)
media_datos
## [1] 3.699
varianza_datos <- sd(datos$promedio_academico)
varianza_datos
## [1] 0.2488643
  • Resuelvo para distribución continua a través de distribución normal:
p_menor <- pnorm(q = 3.7, mean = 3.699, sd = 0.25)
p_mayor <- pnorm(q = 3.9, mean = 3.699, sd =0.25 )
p_menor
## [1] 0.5015958
p_mayor
## [1] 0.7893015
  • Probabilidad:
(p_mayor -p_menor)
## [1] 0.2877057

la probabilidad de que el estudiante tenga un promedio académico entre 3.7 y 3.9 es de 0.29

Ejercicio 4

Con una de las muestras que obtuvo con el experimento de los granos defectuosos, responda con un nivel de significancia del 5% al siguiente juego de hipótesis:

\[ H_0: p= 0.06 \\ H_1: p \neq 0.06\]

Inferencia sobre la proporción:

  • Observación de los datos:
library(readxl)
library(tidyverse)
datos_lentejas <- read_excel("Muestreo_Lentejas.xlsx")
datos_lentejas
## # A tibble: 15 x 4
##    Muestra `N° Desperfectos` `Tamaño de la Muestra` proporcion
##      <dbl>             <dbl>                  <dbl>      <dbl>
##  1       1                 0                     68     0     
##  2       2                 1                     50     0.02  
##  3       3                 1                     67     0.0149
##  4       4                 3                     68     0.0441
##  5       5                 2                     69     0.0290
##  6       6                 1                     81     0.0123
##  7       7                 2                     86     0.0233
##  8       8                 0                     70     0     
##  9       9                 2                     63     0.0317
## 10      10                 3                     65     0.0462
## 11      11                 2                     78     0.0256
## 12      12                 0                     71     0     
## 13      13                 2                     72     0.0278
## 14      14                 0                     55     0     
## 15      15                 2                     69     0.0290
  • Media de la proporción:
mean(datos_lentejas$proporcion)
## [1] 0.02026228
  • Normalidad de la variable proporción:
library(ggpubr)
ggqqplot(data = datos_lentejas$proporcion)

La variable se distribuye de forma normal.

  • Con muestra número 5:
prop.test(
  x = 2,
  n = 69,
  p = 0.06,
  alternative = "two.sided",
  conf.level = 0.95
)
## 
##  1-sample proportions test with continuity correction
## 
## data:  2 out of 69, null probability 0.06
## X-squared = 0.69113, df = 1, p-value = 0.4058
## alternative hypothesis: true p is not equal to 0.06
## 95 percent confidence interval:
##  0.005036403 0.110083328
## sample estimates:
##          p 
## 0.02898551

Conclusión: Como el valor p (0.4058) es mayor que el nivel de significancia (0.05). No existe evidencia para rechazar la hipotesis nula, es decir, que la proporción de granos defectuosos es igual al 6% (0.06).

Ejercicio 5

Ejercicio de clase: realizar simulación para el teorema del límite central con alguna de las distribuciones de probabilidad que abordamos en clase. No debe utilizar ninguna de las que se usaron como ejemplos (distribución normal y distribución binomial).

  • Simulación TLC:

  • EL promedio de granos de cacao afectados es de 0.1 ( es decir, que en promedio, de cada 100 granos, 10 no pasan al proceso de industrialización).

    número de granos cosechados: 6000 lambda: 0.1

set.seed(369)
poblacion_poisson <- rpois(n = 6000, lambda = 0.1 )
  • Extracción de muestra de tamaño 50, 100 veces.
set.seed(369)
muestras_poisson <- tibble(repeticion = 1:100) %>% 
  mutate(muestra = map(.x = repeticion, .f = ~sample(
    x = poblacion_poisson,
    size = 50,
    replace = TRUE
  )),
  promedio = map_dbl(.x = muestra, .f = mean))

muestras_poisson
## # A tibble: 100 x 3
##    repeticion muestra    promedio
##         <int> <list>        <dbl>
##  1          1 <int [50]>     0.06
##  2          2 <int [50]>     0.12
##  3          3 <int [50]>     0.08
##  4          4 <int [50]>     0.1 
##  5          5 <int [50]>     0.14
##  6          6 <int [50]>     0.12
##  7          7 <int [50]>     0.02
##  8          8 <int [50]>     0.06
##  9          9 <int [50]>     0.1 
## 10         10 <int [50]>     0.06
## # ... with 90 more rows
  • promedio de promedios muestrales:
mean(muestras_poisson$promedio)
## [1] 0.0872
  • Gráfica:
muestras_poisson %>% 
  ggplot(mapping = aes(x = promedio)) +
  geom_density() +
  geom_vline(xintercept = 0.0872, color = "red")

Conclusión: Efectivamente, las medias muestrales de la variable se aproximan a una distribución normal. Y se cumple la teoría del límite central de las medias muestrales trabajando con la distribución de poisson.

Ejercicio 6.

Con la base de datos Evaluaciones Agropecuarias Municipales – EVA. 2019 - 2020, para el cultivo de Mango, contraste el siguiente juego de hipótesis para la variable rendimiento (t/ha):

  • Asumiremos un nivel de significancia \((\alpha)\) del \(0.05\)
  • Con un nivel de confianza del \(0.95\)

\[H_0: \frac{\sigma_{(2019)}}{\sigma_{(2020)}}=1 \\ H_1: \frac{\sigma_{(2019)}}{\sigma_{(2020)}}\neq 1 \]

library(tidyverse)
library(janitor)
datos_mango <- read_csv("Evaluaciones_Agropecuarias_Municipales___EVA._2019_-_2020.csv") %>% 
  clean_names() %>% 
  filter(cultivo == "Mango") %>% 
  rename(year = ano) %>% 
  mutate(year = as.factor(year))  

datos_mango
## # A tibble: 478 x 16
##    codigo_del_depar~ departamento  codigo_del_munic~ municipio grupo_cultivo_se~
##                <dbl> <chr>                     <dbl> <chr>     <chr>            
##  1                 5 Antioquia                  5002 Abejorral Frutales         
##  2                54 Norte de San~             54003 Ábrego    Frutales         
##  3                13 Bolívar                   13006 Achí      Frutales         
##  4                25 Cundinamarca              25001 Agua de ~ Frutales         
##  5                20 Cesar                     20011 Aguachica Frutales         
##  6                20 Cesar                     20013 Agustín ~ Frutales         
##  7                41 Huila                     41016 Aipe      Frutales         
##  8                41 Huila                     41020 Algeciras Frutales         
##  9                41 Huila                     41026 Altamira  Frutales         
## 10                73 Tolima                    73030 Ambalema  Frutales         
## # ... with 468 more rows, and 11 more variables:
## #   subgrupo_cultivo_segun_especie <chr>, cultivo <chr>, year <fct>,
## #   periodo <chr>, area_sembrada_ha <dbl>, area_cosechada_ha <dbl>,
## #   produccion_t <dbl>, rendimiento_t_ha <dbl>, ciclo_del_cultivo <chr>,
## #   estado_fisico_de_la_produccion <chr>, nombre_cientifico <chr>
  • Prueba de Normalidad de la variable rendimiento_t_ha:
library(ggpubr)
ggqqplot(data = datos_mango$rendimiento_t_ha)

Nota: La variable rendimiento_t_ha. No se distribuye de forma Normal. Trabajaremos con la prueba de leveene.

library(car)
leveneTest(datos_mango$rendimiento_t_ha ~ datos_mango$year)
## Levene's Test for Homogeneity of Variance (center = median)
##        Df F value Pr(>F)
## group   1  0.5664 0.4521
##       476

Conclusión:

Como el valor P (0.4521) es mayor que el nivel de significancia \((\alpha= 0.05)\) lo anterior indica que la variable rendimiento_t_ha, para los años de 2019 y 2020, no tuvo una varinza significativa (Homocedástico). Por lo tanto, No se existe evidenca suficiente para rechazar la hipótesis nula.

Ejercicio 7.

Con los datos del ejercicio 6 concluya con un nivel de significancia del 10% al siguiente juego de hipótesis para la variable rendimiento (t/ha):

  • La variable rendimiento_t_ha que no posee distribución normal, se realizará el ejercicio por motivos de práctica académica.

  • Nivel de significancia \(\alpha = 0.1\) con nivel de confianza del \(0.9\)

  • Se determinó la Homocedasticidad de la variable. (Varianzas relativamente iguales).

Reiteramos la no normalidad de la variable redimiento_t_ha para los años 2019 y 2020. Podemos observar, igualmente, la similitud de la gráficas lo que ratifica la despreciable varianza.

Normalidad

Rendimiento_Mango2019 <- datos_mango %>% filter(year == "2019")
Rendimiento_Mango2020 <- datos_mango %>% filter(year == "2020")

ggqqplot(Rendimiento_Mango2019$rendimiento_t_ha)

ggqqplot(Rendimiento_Mango2020$rendimiento_t_ha)

\[ H_0: = \mu_{2019}= \mu_{2020} \\ H_1: = \mu_{2019} < \mu_{2020}\]

t.test(datos_mango$rendimiento_t_ha ~ datos_mango$year, 
       alternative = "two.sided",
       conf.level= 0.90,
       var.equal = TRUE )
## 
##  Two Sample t-test
## 
## data:  datos_mango$rendimiento_t_ha by datos_mango$year
## t = 0.44492, df = 476, p-value = 0.6566
## alternative hypothesis: true difference in means between group 2019 and group 2020 is not equal to 0
## 90 percent confidence interval:
##  -0.7293061  1.2686961
## sample estimates:
## mean in group 2019 mean in group 2020 
##           9.876624           9.606929

Conclusión:

  • Como el valor p (0.6566) es mayor que el nivel de significancia (0.1) No existe evidencia para rechazar la hipótesis nula, es decir, que el promedio del rendimiento de toneladas de mango por hectárea del año 2019 no es diferente al promedio del año 2020.

  • Como el intervalo de confianza contiene al cero, entonces existe evidencia aceptar la hipótesis nula. Además, con el intervalo de confianza con pequeñas variaciones a la derecha e izquierda del cero, quiere decir que en promedio habrá momentos en los que el rendimiento del año 2019 será mayor y en otros casos menor. Conclusión similar para el año 2020.

Ejercicio 8

Con la base de datos Soils, para la variable pH, concluya respecto al siguiente juego de hipótesis:

\[H_0:\mu=4.87 \\ H_1:\mu\neq 4.87\]

library(car)
Soils
##    Group    Contour Depth Gp Block   pH     N Dens   P    Ca    Mg    K    Na
## 1      1        Top  0-10 T0     1 5.40 0.188 0.92 215 16.35  7.65 0.72  1.14
## 2      1        Top  0-10 T0     2 5.65 0.165 1.04 208 12.25  5.15 0.71  0.94
## 3      1        Top  0-10 T0     3 5.14 0.260 0.95 300 13.02  5.68 0.68  0.60
## 4      1        Top  0-10 T0     4 5.14 0.169 1.10 248 11.92  7.88 1.09  1.01
## 5      2        Top 10-30 T1     1 5.14 0.164 1.12 174 14.17  8.12 0.70  2.17
## 6      2        Top 10-30 T1     2 5.10 0.094 1.22 129  8.55  6.92 0.81  2.67
## 7      2        Top 10-30 T1     3 4.70 0.100 1.52 117  8.74  8.16 0.39  3.32
## 8      2        Top 10-30 T1     4 4.46 0.112 1.47 170  9.49  9.16 0.70  3.76
## 9      3        Top 30-60 T3     1 4.37 0.112 1.07 121  8.85 10.35 0.74  5.74
## 10     3        Top 30-60 T3     2 4.39 0.058 1.54 115  4.73  6.91 0.77  5.85
## 11     3        Top 30-60 T3     3 4.17 0.078 1.26 112  6.29  7.95 0.26  5.30
## 12     3        Top 30-60 T3     4 3.89 0.070 1.42 117  6.61  9.76 0.41  8.30
## 13     4        Top 60-90 T6     1 3.88 0.077 1.25 127  6.41 10.96 0.56  9.67
## 14     4        Top 60-90 T6     2 4.07 0.046 1.54  91  3.82  6.61 0.50  7.67
## 15     4        Top 60-90 T6     3 3.88 0.055 1.53  91  4.98  8.00 0.23  8.78
## 16     4        Top 60-90 T6     4 3.74 0.053 1.40  79  5.86 10.14 0.41 11.04
## 17     5      Slope  0-10 S0     1 5.11 0.247 0.94 261 13.25  7.55 0.61  1.86
## 18     5      Slope  0-10 S0     2 5.46 0.298 0.96 300 12.30  7.50 0.68  2.00
## 19     5      Slope  0-10 S0     3 5.61 0.145 1.10 242  9.66  6.76 0.63  1.01
## 20     5      Slope  0-10 S0     4 5.85 0.186 1.20 229 13.78  7.12 0.62  3.09
## 21     6      Slope 10-30 S1     1 4.57 0.102 1.37 156  8.58  9.92 0.63  3.67
## 22     6      Slope 10-30 S1     2 5.11 0.097 1.30 139  8.58  8.69 0.42  4.70
## 23     6      Slope 10-30 S1     3 4.78 0.122 1.30 214  8.22  7.75 0.32  3.07
## 24     6      Slope 10-30 S1     4 6.67 0.083 1.42 132 12.68  9.56 0.55  8.30
## 25     7      Slope 30-60 S3     1 3.96 0.059 1.53  98  4.80 10.00 0.36  6.52
## 26     7      Slope 30-60 S3     2 4.00 0.050 1.50 115  5.06  8.91 0.28  7.91
## 27     7      Slope 30-60 S3     3 4.12 0.086 1.55 148  6.16  7.58 0.16  6.39
## 28     7      Slope 30-60 S3     4 4.99 0.048 1.46  97  7.49  9.38 0.40  9.70
## 29     8      Slope 60-90 S6     1 3.80 0.049 1.48 108  3.82  8.80 0.24  9.57
## 30     8      Slope 60-90 S6     2 3.96 0.036 1.28 103  4.78  7.29 0.24  9.67
## 31     8      Slope 60-90 S6     3 3.93 0.048 1.42 109  4.93  7.47 0.14  9.65
## 32     8      Slope 60-90 S6     4 4.02 0.039 1.51 100  5.66  8.84 0.37 10.54
## 33     9 Depression  0-10 D0     1 5.24 0.194 1.00 445 12.27  6.27 0.72  1.02
## 34     9 Depression  0-10 D0     2 5.20 0.256 0.78 380 11.39  7.55 0.78  1.63
## 35     9 Depression  0-10 D0     3 5.30 0.136 1.00 259  9.96  8.08 0.45  1.97
## 36     9 Depression  0-10 D0     4 5.67 0.127 1.13 248  9.12  7.04 0.55  1.43
## 37    10 Depression 10-30 D1     1 4.46 0.087 1.24 276  7.24  9.40 0.43  4.17
## 38    10 Depression 10-30 D1     2 4.91 0.092 1.47 158  7.37 10.57 0.59  5.07
## 39    10 Depression 10-30 D1     3 4.79 0.047 1.46 121  6.99  9.91 0.30  5.15
## 40    10 Depression 10-30 D1     4 5.36 0.095 1.26 195  8.59  8.66 0.48  4.17
## 41    11 Depression 30-60 D3     1 3.94 0.054 1.60 148  4.85  9.62 0.18  7.20
## 42    11 Depression 30-60 D3     2 4.52 0.051 1.53 115  6.34  9.78 0.34  8.52
## 43    11 Depression 30-60 D3     3 4.35 0.032 1.55  82  5.99  9.73 0.22  7.02
## 44    11 Depression 30-60 D3     4 4.64 0.065 1.46 152  4.43 10.54 0.22  7.61
## 45    12 Depression 60-90 D6     1 3.82 0.038 1.40 105  4.65  9.85 0.18 10.15
## 46    12 Depression 60-90 D6     2 4.24 0.035 1.47 100  4.56  8.95 0.33 10.51
## 47    12 Depression 60-90 D6     3 4.22 0.030 1.56  97  5.29  8.37 0.14  8.27
## 48    12 Depression 60-90 D6     4 4.41 0.058 1.58 130  4.58  9.46 0.14  9.28
##    Conduc
## 1    1.09
## 2    1.35
## 3    1.41
## 4    1.64
## 5    1.85
## 6    3.18
## 7    4.16
## 8    5.14
## 9    5.73
## 10   6.45
## 11   8.37
## 12   9.21
## 13  10.64
## 14  10.07
## 15  11.26
## 16  12.15
## 17   2.61
## 18   1.98
## 19   0.76
## 20   2.85
## 21   3.24
## 22   4.63
## 23   3.67
## 24   8.10
## 25   7.72
## 26   9.78
## 27   9.07
## 28   9.13
## 29  11.57
## 30  11.42
## 31  13.32
## 32  11.57
## 33   0.75
## 34   2.20
## 35   2.27
## 36   0.67
## 37   5.08
## 38   6.37
## 39   6.82
## 40   3.65
## 41  10.14
## 42   9.74
## 43   8.60
## 44   9.09
## 45  12.26
## 46  11.29
## 47   9.51
## 48  12.69

Se tiene que:

  • Nivel de significancia (\(\alpha = 0.05\))
  • Nivel de Confianza: \(0.95\)
  • Promedio de referencia = \(4.87\)

Normalidad de la Varable pH.

  • Gráfica
library(ggpubr)
ggqqplot(Soils$pH)

- Juego de hipótesis.

con nivel de significancia del 0.01

\[H_0: X \sim N(\mu, \sigma) \\ H_1: X \nsim N(\mu, \sigma)\]

shapiro.test(x = Soils$pH)
## 
##  Shapiro-Wilk normality test
## 
## data:  Soils$pH
## W = 0.93978, p-value = 0.01591

**como el valor p (0.010591) es mayor que el nivel de significancia (0.01) no existe evidencia para rechazar la hipótesis nula, es decir, que la variable aleatoria pH se distribuye de forma normal.

Entonces

Soils_organized <- t.test(x = Soils$pH,
       alternative = "two.sided",
       conf.level = 0.95,
       mu = 4.87)


library(broom)
Soils_organized %>% tidy()
## # A tibble: 1 x 8
##   estimate statistic p.value parameter conf.low conf.high method     alternative
##      <dbl>     <dbl>   <dbl>     <dbl>    <dbl>     <dbl> <chr>      <chr>      
## 1     4.67     -2.07  0.0441        47     4.47      4.86 One Sampl~ two.sided

Conclusión: como el valor p (0.04408447) es menor que el nivel de significancia (0.05) existe evidencia para rechazar la hipótesis nula.