Sys.setlocale("LC_ALL", "es_ES.UTF-8")

## [1] "LC_COLLATE=es_ES.UTF-8;LC_CTYPE=es_ES.UTF-8;LC_MONETARY=es_ES.UTF-8;LC_NUMERIC=C;LC_TIME=es_ES.UTF-8"

El objetivo de esta actividad es la aplicación práctica de los conceptos explicados durante la semana 18 del máster.

Con el dataset “iris”

data(iris) 

data = iris

attach(data)

data %>%
  head(5) %>%
  kable() %>%
  kable_styling("striped", full_width = FALSE, position = "center", font_size = 16) %>%
  row_spec(0, monospace = TRUE, bold = TRUE, color = "navy", background = "grey") %>%
  row_spec(1:ncol(data), color = "black", background = "lightgrey")

Sepal.Length	Sepal.Width	Petal.Length	Petal.Width	Species
5.1	3.5	1.4	0.2	setosa
4.9	3.0	1.4	0.2	setosa
4.7	3.2	1.3	0.2	setosa
4.6	3.1	1.5	0.2	setosa
5.0	3.6	1.4	0.2	setosa

dim(data)

## [1] 150   5

Calcular y añadir explicaciones y gráficos a los cálculos:

Inspección de los datos

ggpairs(iris,
        aes(color = Species),
        title = "Iris") +
  theme(plot.title = element_text(size = 10, face = "bold"))

Se seleccionan las variables numéricas para poder hacer la correlación correctamente, para que no se incluyan las categorías

variables_numericas_df = data %>%
  select(where(is.numeric)) %>%
  names()

variables_numericas_df

## [1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"

data_setosa = iris %>% filter(Species=="setosa") %>% select(variables_numericas_df)
head(data_setosa)

##   Sepal.Length Sepal.Width Petal.Length Petal.Width
## 1          5.1         3.5          1.4         0.2
## 2          4.9         3.0          1.4         0.2
## 3          4.7         3.2          1.3         0.2
## 4          4.6         3.1          1.5         0.2
## 5          5.0         3.6          1.4         0.2
## 6          5.4         3.9          1.7         0.4

# data_setosa = iris %>% filter(Species=="setosa") %>% select(c(1:4))
# data_setosa

Estandarización: Dividiendo la media por la desviación con la función scale(). Esto se hace como una opción de normalización, por que cuando se hace una correlación, las variables numéricas tienen que estar normalizadas para que no tengan más peso unas que otras.

data_setosa = scale(data_setosa)
head(data_setosa)

##      Sepal.Length Sepal.Width Petal.Length Petal.Width
## [1,]   0.26667447   0.1899414   -0.3570112  -0.4364923
## [2,]  -0.30071802  -1.1290958   -0.3570112  -0.4364923
## [3,]  -0.86811050  -0.6014810   -0.9328358  -0.4364923
## [4,]  -1.15180675  -0.8652884    0.2188133  -0.4364923
## [5,]  -0.01702177   0.4537488   -0.3570112  -0.4364923
## [6,]   1.11776320   1.2451711    1.3704625   1.4613004

round(apply(data_setosa, 2, mean),2)

## Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
##            0            0            0            0

round(apply(data_setosa, 2, sd),2)

## Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
##            1            1            1            1

Matriz de covarianzas

Respuesta:

cov(data_setosa)

##              Sepal.Length Sepal.Width Petal.Length Petal.Width
## Sepal.Length    1.0000000   0.7425467    0.2671758   0.2780984
## Sepal.Width     0.7425467   1.0000000    0.1777000   0.2327520
## Petal.Length    0.2671758   0.1777000    1.0000000   0.3316300
## Petal.Width     0.2780984   0.2327520    0.3316300   1.0000000

Volver al inicio

Matriz de correlaciones

Respuesta:

cor(data_setosa)

##              Sepal.Length Sepal.Width Petal.Length Petal.Width
## Sepal.Length    1.0000000   0.7425467    0.2671758   0.2780984
## Sepal.Width     0.7425467   1.0000000    0.1777000   0.2327520
## Petal.Length    0.2671758   0.1777000    1.0000000   0.3316300
## Petal.Width     0.2780984   0.2327520    0.3316300   1.0000000

La matriz de covarianza y la matriz de correlación son iguales por que los datos se estandarizaron, la matriz de covarianza de una matriz de datos estandarizados es la matriz de correlaciones (con Pearson) cuando los datos no son normales, no se usa una correlación de Pearson, se usa Spaerman

matriz_cor <- cor(data_setosa, method = "spearman")

corrplot(matriz_cor, type="upper")

corr.test(data_setosa, method = "spearman")

## Call:corr.test(x = data_setosa, method = "spearman")
## Correlation matrix 
##              Sepal.Length Sepal.Width Petal.Length Petal.Width
## Sepal.Length         1.00        0.76         0.28        0.30
## Sepal.Width          0.76        1.00         0.18        0.29
## Petal.Length         0.28        0.18         1.00        0.27
## Petal.Width          0.30        0.29         0.27        1.00
## Sample Size 
## [1] 50
## Probability values (Entries above the diagonal are adjusted for multiple tests.) 
##              Sepal.Length Sepal.Width Petal.Length Petal.Width
## Sepal.Length         0.00        0.00         0.17        0.17
## Sepal.Width          0.00        0.00         0.21        0.17
## Petal.Length         0.05        0.21         0.00        0.17
## Petal.Width          0.03        0.04         0.06        0.00
## 
##  To see confidence intervals of the correlations, print with the short=FALSE option

Volver al inicio

Un muestreo aleatorio con reposición

Respuesta:

set.seed(123)
filas <- sample(1:150, 10, replace = TRUE)
filas

##  [1]  14  50 118  43  14 118  90  91  91  92

muestra_con_resposcicion <- iris[filas, ]
muestra_con_resposcicion

##       Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
## 14             4.3         3.0          1.1         0.1     setosa
## 50             5.0         3.3          1.4         0.2     setosa
## 118            7.7         3.8          6.7         2.2  virginica
## 43             4.4         3.2          1.3         0.2     setosa
## 14.1           4.3         3.0          1.1         0.1     setosa
## 118.1          7.7         3.8          6.7         2.2  virginica
## 90             5.5         2.5          4.0         1.3 versicolor
## 91             5.5         2.6          4.4         1.2 versicolor
## 91.1           5.5         2.6          4.4         1.2 versicolor
## 92             6.1         3.0          4.6         1.4 versicolor

Volver al inicio

Un muestreo aleatorio sin reposición

Respuesta:

set.seed(1234)
filas <- sample(1:150, 10, replace = FALSE)
filas

##  [1]  28  80 101 111 137 133 144 132  98 103

muestra_sin_resposcicion <- iris[filas, ]
muestra_sin_resposcicion

##     Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
## 28           5.2         3.5          1.5         0.2     setosa
## 80           5.7         2.6          3.5         1.0 versicolor
## 101          6.3         3.3          6.0         2.5  virginica
## 111          6.5         3.2          5.1         2.0  virginica
## 137          6.3         3.4          5.6         2.4  virginica
## 133          6.4         2.8          5.6         2.2  virginica
## 144          6.8         3.2          5.9         2.3  virginica
## 132          7.9         3.8          6.4         2.0  virginica
## 98           6.2         2.9          4.3         1.3 versicolor
## 103          7.1         3.0          5.9         2.1  virginica

Volver al inicio

Un muestreo aleatorio sistemático

Respuesta:

set.seed(1)
primera_fila <- sample(1:150, 1)
primera_fila

## [1] 68

incremento <- floor(150/10)
filas <- seq(from = primera_fila,
             by = incremento,
             length.out = 10)

filas

##  [1]  68  83  98 113 128 143 158 173 188 203

filas_transf <- filas %% 150
filas_transf

##  [1]  68  83  98 113 128 143   8  23  38  53

muestra_sistematica <- iris[filas_transf, ]
muestra_sistematica

##     Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
## 68           5.8         2.7          4.1         1.0 versicolor
## 83           5.8         2.7          3.9         1.2 versicolor
## 98           6.2         2.9          4.3         1.3 versicolor
## 113          6.8         3.0          5.5         2.1  virginica
## 128          6.1         3.0          4.9         1.8  virginica
## 143          5.8         2.7          5.1         1.9  virginica
## 8            5.0         3.4          1.5         0.2     setosa
## 23           4.6         3.6          1.0         0.2     setosa
## 38           4.9         3.6          1.4         0.1     setosa
## 53           6.9         3.1          4.9         1.5 versicolor

Volver al inicio

Generar 10.000 muestras de tamaño 40 con reposición de las longitudes del pétalo (Petal.Length). Hallar los valores medios de cada muestra. Comparar la media y la desviación típica de dichos valores medios y con los valores exactos dados por las propiedades de la media muestral

Respuesta:

Muestreo Aleatorio estratificado: muestra de 4 flores de cada estrato(Especies) con reposición

set.seed(123)
# filas_setosa = sample(1:50, 4, replace = TRUE)
# filas_setosa
# iris[filas_setosa, ]

# primera_fila <- sample(1:150, 1)

filas_setosa <- sample(which(iris$Species == "setosa"), 4, replace = TRUE)
filas_setosa

## [1] 31 15 14  3

iris[filas_setosa, ]

##    Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 31          4.8         3.1          1.6         0.2  setosa
## 15          5.8         4.0          1.2         0.2  setosa
## 14          4.3         3.0          1.1         0.1  setosa
## 3           4.7         3.2          1.3         0.2  setosa

filas_versicolor <- sample(which(iris$Species == "versicolor"), 4, replace = TRUE)
filas_versicolor

## [1]  92 100  93  87

iris[filas_versicolor, ]

##     Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
## 92           6.1         3.0          4.6         1.4 versicolor
## 100          5.7         2.8          4.1         1.3 versicolor
## 93           5.8         2.6          4.0         1.2 versicolor
## 87           6.7         3.1          4.7         1.5 versicolor

filas_virginica <- sample(which(iris$Species == "virginica"), 4, replace = TRUE)
filas_virginica

## [1] 114 125 126 127

iris[filas_virginica, ]

##     Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
## 114          5.7         2.5          5.0         2.0 virginica
## 125          6.7         3.3          5.7         2.1 virginica
## 126          7.2         3.2          6.0         1.8 virginica
## 127          6.2         2.8          4.8         1.8 virginica

muestra_estratificada_con_reposicion = rbind(iris[filas_virginica, ],
                                              iris[filas_versicolor, ],
                                              iris[filas_setosa, ])
muestra_estratificada_con_reposicion

##     Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
## 114          5.7         2.5          5.0         2.0  virginica
## 125          6.7         3.3          5.7         2.1  virginica
## 126          7.2         3.2          6.0         1.8  virginica
## 127          6.2         2.8          4.8         1.8  virginica
## 92           6.1         3.0          4.6         1.4 versicolor
## 100          5.7         2.8          4.1         1.3 versicolor
## 93           5.8         2.6          4.0         1.2 versicolor
## 87           6.7         3.1          4.7         1.5 versicolor
## 31           4.8         3.1          1.6         0.2     setosa
## 15           5.8         4.0          1.2         0.2     setosa
## 14           4.3         3.0          1.1         0.1     setosa
## 3            4.7         3.2          1.3         0.2     setosa

Ejemplo de Media Muestral
Se sacan 10.000 ,uestras aleatorias para las que se quiere saber la longitud del petalo, cada muestra es de n=40 con reposision

set.seed(123)

media_cada_muestra <- replicate(10000,
                                mean(sample(iris$Petal.Length,
                                            40,
                                            replace = TRUE)))

head(media_cada_muestra, 5) %>% kable() %>% kable_styling()

x
3.8950
3.7075
3.4325
3.4850
4.2400

length(media_cada_muestra)

## [1] 10000

mean(media_cada_muestra)

## [1] 3.761938

sd(media_cada_muestra)

## [1] 0.2726602

mean(iris$Petal.Length)

## [1] 3.758

sd(iris$Petal.Length) / sqrt(40)

## [1] 0.2791182

Representación Gráfica

hist(media_cada_muestra,
     freq = F,
     main = "Histograma de las medias de 10.000 muestras\n de tamaño 40 de las longitudes de los petalos",
     xlab = "Valores medios de las longitudes de los petalos",
     ylab = "Densidad",
     ylim = c(0, 1.5))

lines(density(media_cada_muestra),
      lty = 2,
      lwd = 2,
      col = "red")

x <- sort(iris$Petal.Length)

lines(x,
      dnorm(x, mean(Petal.Length),
            sd(Petal.Length)/sqrt(40)),
      lty = 2,
      lwd = 2,
      col = "blue")
 
legend("topright",
       legend = c("densidad", "normal"),
       lty = c(2,3),
       lwd = c(2,2),
       col = c("red","blue"))

Volver al inicio

Dada una muestra de 60 flores, estimar la proporción de flores de la especie setosa y estimar la desviación estándar de dicha proporción

Respuesta:

Ejemplo de proporción muestral Se sacan 10.000 muestras, cada muestreo el aleatorio con N=60 con reposición -Estimar proporción de flores con especie Setosa -Estimar la desviación estándar de dicha porcionero

set.seed(123)

filas <- sample(1:150, 60, replace = TRUE)
muestra_con_resposcicion <- iris[filas, ]
head(muestra_con_resposcicion)

##       Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
## 14             4.3         3.0          1.1         0.1    setosa
## 50             5.0         3.3          1.4         0.2    setosa
## 118            7.7         3.8          6.7         2.2 virginica
## 43             4.4         3.2          1.3         0.2    setosa
## 14.1           4.3         3.0          1.1         0.1    setosa
## 118.1          7.7         3.8          6.7         2.2 virginica

table(muestra_con_resposcicion$Species == "setosa")

## 
## FALSE  TRUE 
##    39    21

proporcion_setosa = table(muestra_con_resposcicion$Species == "setosa")[2]/length(muestra_con_resposcicion$Species)
proporcion_setosa

## TRUE 
## 0.35

# Para replicarlo 10.000
proporcion_muestral = replicate(10000,
                                table(sample(iris$Species, 60, replace = TRUE) == "setosa")[2]/length(muestra_con_resposcicion$Species))

sd(proporcion_muestral)

## [1] 0.05997709

Representación Gráfica

hist(proporcion_muestral,
     freq = F,
     main = "Histograma de las proporciones muestrales de 10.000 muestras\n de tamaño 60",
     xlab = "Proporciones Muestrales",
     ylab = "Densidad",
     ylim = c(0, 6.5))

lines(density(proporcion_muestral),
      lty = 2,
      lwd = 2,
      col = "red")

x <- seq(from = 0,
         to = 1,
         by = 0.01)

lines(x,
      dnorm(x, 
            1/3,
            sqrt((1/3)*(2/3)/60)),
      lty = 2,
      lwd = 2,
      col = "blue")
 
legend("topright",
       legend = c("densidad", "normal"),
       lty = c(2,3),
       lwd = c(2,2),
       col = c("red","blue"))

Volver al inicio