Respuestas a la tarea 2
Introducción a la programación y estadística en R
Universidad de Costa Rica
Universidad de Costa Rica
Marcelo Araya-Salas, PhD
Intrucciones generales:
- El código debe seguir las reglas de estilo señaladas en la presentación “Importar y dar formato a datos” (2.5 pts)
- En los ejercicios se muestran lineas de código con ejemplos de como debería comportarse las funciones. Utilice los mismos ejemplos para demostrar las funciones que usted crea como respuesta a los ejercicios. Toda función o modificación debe ser acompañada de una llamada a la función creada que demuestre su comportamiento.
Ejercicio 1
- Cree una función que tome un vector numérico, duplique sus valores y los ordene de forma ascendente (pista:
sort()) (5 pts).
funcion_1a <- function(x) {
# duplicar
x <- c(x, x)
# ordenar
x <- sort(x, na.last = TRUE)
return(x)
}Ejemplo:
# crear vector
v1 <- c(1, 4, 18, 7)
funcion_1a(v1)## [1] 1 1 4 4 7 7 18 18- Añada un argumento a la función anterior que permita al usuario remover los
NAs (5 pts).
funcion_1a <- function(x, na.rm = TRUE) {
# remover nas
if (na.rm)
x <- na.omit(x)
# duplicar
x <- c(x, x)
# ordenar
x <- sort(x, na.last = TRUE)
return(x)
}Ejemplo:
# crear vector
v1 <- c(1, 4, 18, 7, NA)
# sin remover NAs
funcion_1a(v1, na.rm = FALSE)## [1] 1 1 4 4 7 7 18 18 NA NA# removiendo NAs
funcion_1a(v1, na.rm = TRUE)## [1] 1 1 4 4 7 7 18 18- Cree una función que tome un vector y lo añada a un cuadro de datos (‘data.frame’). Si el vector es mas largo que el número de filas la función debe “recortar” el vector para que coincida con el número de filas del cuadro de datos. Si el vector es mas corto, rellene los valores faltantes con
NAs (pista:rep()) (10 pts).
funcion_1c <- function(X, y) {
# recortar
if (length(y) > nrow(X))
y <- y[1:nrow(X)]
# alargar
if (length(y) < nrow(X))
y <- c(y, rep(NA, nrow(X) - length(y)))
# anadir al vector
X$y <- y
return(X)
}Ejemplo:
# mas largo
funcion_1c(X = BOD, y = 10:1)## Time demand y
## 1 1 8.3 10
## 2 2 10.3 9
## 3 3 19.0 8
## 4 4 16.0 7
## 5 5 15.6 6
## 6 7 19.8 5# mas corto
funcion_1c(X = BOD, y = 4:1)## Time demand y
## 1 1 8.3 4
## 2 2 10.3 3
## 3 3 19.0 2
## 4 4 16.0 1
## 5 5 15.6 NA
## 6 7 19.8 NA- Añada un argumento a la función anterior que permita al usuario definir el nombre de la nueva variable. Debe tener el nombre ‘y’ de forma predeterminada (5 pts).
funcion_1c <- function(X, y, nombre = "y") {
# recortar
if (length(y) > nrow(X))
y <- y[1:nrow(X)]
# alargar
if (length(y) < nrow(X))
y <- c(y, rep(NA, nrow(X) - length(y)))
# anadir al vector
X$y <- y
# dar nombre
names(X)[ncol(X)] <- nombre
return(X)
}Ejemplo:
# cambiar nombre
funcion_1c(X = BOD, y = 4:1, nombre = "nueva_columna")## Time demand nueva_columna
## 1 1 8.3 4
## 2 2 10.3 3
## 3 3 19.0 2
## 4 4 16.0 1
## 5 5 15.6 NA
## 6 7 19.8 NA- Modifique la función anterior de forma que pueda añadir 2 vectores a un cuadro de datos. El proceso para ajustar el largo del vector debe ser el mismo que se usa para el primer vector. Ademas, debe permitir al usuario definir los nombres de los 2 vectores a añadir (10 pts).
funcion_1e <- function(X, y, z, nombre = c("y", "z")) {
## V1 recortar
if (length(y) > nrow(X))
y <- y[1:nrow(X)]
# alargar
if (length(y) < nrow(X))
y <- c(y, rep(NA, nrow(X) - length(y)))
# anadir al vector
X$y <- y
# dar nombre
names(X)[ncol(X)] <- nombre[1]
## V2 recortar
if (length(z) > nrow(X))
z <- z[1:nrow(X)]
# alargar
if (length(z) < nrow(X))
z <- c(z, rep(NA, nrow(X) - length(z)))
# anadir al vector
X$z <- z
# dar nombre
names(X)[ncol(X)] <- nombre[2]
return(X)
}Ejemplo:
# dos vectores
funcion_1e(X = BOD, y = 4:1, z = 100:110)## Time demand y z
## 1 1 8.3 4 100
## 2 2 10.3 3 101
## 3 3 19.0 2 102
## 4 4 16.0 1 103
## 5 5 15.6 NA 104
## 6 7 19.8 NA 105# cambiando nombres
funcion_1e(X = BOD, y = 4:1, z = 100:110, nombre = c("columna_nueva_1", "columna_nueva_2"))## Time demand columna_nueva_1 columna_nueva_2
## 1 1 8.3 4 100
## 2 2 10.3 3 101
## 3 3 19.0 2 102
## 4 4 16.0 1 103
## 5 5 15.6 NA 104
## 6 7 19.8 NA 105Ejercicio 2
El siguiente bucle while (visto en clase) crea dos vectores aleatorios y evalúa su correlación, si esta es mayor que 0.5 el bucle se detiene:
# definir valor inicial
corr_coef <- 0
# crear vector vacio
cc_vector <- NULL
while (corr_coef < 0.5) {
# generar la variable 1
v1 <- rnorm(n = 20, mean = 100, sd = 20)
# generar la variable 2
v2 <- rnorm(n = 20, mean = 100, sd = 20)
# correr la correlacion
corr_coef <- cor(v1, v2)
# guardar resultado usando append
cc_vector <- append(cc_vector, corr_coef)
}
library(ggplot2)
cc_df <- data.frame(y = cc_vector, x = 1:length(cc_vector))
# graficar resultado
ggplot(data = cc_df, aes(x, y)) + geom_hline(yintercept = 0.5, col = "red", lwd = 1) +
geom_line() + labs(x = "Iteraciones", y = "Correlación \n de pearson (r)") +
theme_classic(base_size = 25) + theme(plot.background = element_rect(fill = "#D9EDF7"))
Haga que el bucle
whilegenere internamente una tercera variable aleatoria (similar a las 2 variables que el bucle ya crea) y calcule la correlación entre esta tercer variable y la primer variable. El bucle debe detenerse cuando se cumplen 2 condiciones (10 pts):- la correlación entre la variable 1 y la variable 2 es mayor a 0.3
- la correlación entre la variable 1 y la variable 3 es mayor a 0.3
# definir valor inicial
corr_coef_1 <- corr_coef_2 <- 0
# crear vector vacio
cc_vector_1 <- cc_vector_2 <- NULL
while (corr_coef_1 < 0.3 | corr_coef_2 < 0.3) {
# generar la variable 1
v1 <- rnorm(n = 20, mean = 100, sd = 20)
# generar la variable 2
v2 <- rnorm(n = 20, mean = 100, sd = 20)
# generar la variable 3
v3 <- rnorm(n = 20, mean = 100, sd = 20)
# correr la correlacion
corr_coef_1 <- cor(v1, v2)
corr_coef_2 <- cor(v2, v3)
# guardar resultados usando append
cc_vector_1 <- append(cc_vector_1, corr_coef_1)
cc_vector_2 <- append(cc_vector_2, corr_coef_2)
}Ejemplo:
cc_df <- data.frame(vectores = rep(c("1v2", "1v3"),
each = length(cc_vector_1)),
iteracion = rep(1:length(cc_vector_1), 2),
r = c(cc_vector_1, cc_vector_2))
# graficar resultado
ggplot(data = cc_df, aes(x = iteracion, y = r, color = vectores)) +
geom_line() +
geom_hline(yintercept = 0.3, col = "red", lwd = 1) +
labs(x = "Iteraciones", y = "Correlación \n de pearson (r)") +
theme_classic(base_size = 25) +
theme(plot.background = element_rect(fill = "#D9EDF7"))
- para usar el codigo anterior para graficar sus resultados debe llamar a los vectores que guardan los resultados ‘cc_vector_1’ y ‘cc_vector_2’
- Convierta el bucle anterior a un bucle
repeat(5 pts)
repeat {
# generar la variable 1
v1 <- rnorm(n = 20, mean = 100, sd = 20)
# generar la variable 2
v2 <- rnorm(n = 20, mean = 100, sd = 20)
# generar la variable 3
v3 <- rnorm(n = 20, mean = 100, sd = 20)
# correr la correlacion
corr_coef_1 <- cor(v1, v2)
corr_coef_2 <- cor(v2, v3)
# guardar resultados usando append
cc_vector_1 <- append(cc_vector_1, corr_coef_1)
cc_vector_2 <- append(cc_vector_2, corr_coef_2)
if (corr_coef_1 > 0.3 & corr_coef_2 > 0.3)
break
}Ejemplo:
cc_df <- data.frame(vectores = rep(c("1v2", "1v3"),
each = length(cc_vector_1)),
iteracion = rep(1:length(cc_vector_1), 2),
r = c(cc_vector_1, cc_vector_2))
# graficar resultado
ggplot(data = cc_df, aes(x = iteracion, y = r, color = vectores)) +
geom_line() +
geom_hline(yintercept = 0.3, col = "red", lwd = 1) +
labs(x = "Iteraciones", y = "Correlación \n de pearson (r)") +
theme_classic(base_size = 25) +
theme(plot.background = element_rect(fill = "#D9EDF7"))
El juego de datos turdus (en el archivo Metadatos grabaciones turdus oct-2021.csv que se encuentra en mediación virtual) contiene los metadatos de grabaciones acústicas de varias especies del genero Turdus (al que pertenece el yigüirro T. grayi):
Podemos usar head() para ver las primeras filas:
head(turdus)| Recording_ID | Genus | Specific_epithet | Country | Latitude | Longitude | Vocalization_type | Date |
|---|---|---|---|---|---|---|---|
| 375139 | Turdus | philomelos | Switzerland | 46.8934 | 8.6139 | song | 2017-03-14 |
| 297839 | Turdus | merula | Germany | 51.3845 | 6.9903 | song | 2015-06-07 |
| 494874 | Turdus | philomelos | Russian Federation | 56.0939 | 47.2600 | song | 2018-05-11 |
| 168128 | Turdus | grayi | Nicaragua | 13.2370 | -86.0546 | call | 2014-02-17 |
| 289584 | Turdus | merula | Germany | 48.3062 | 10.9337 | alarm call | 2015-11-03 |
| 293503 | Turdus | rufiventris | Brazil | -31.7655 | -52.2293 | male, song | 2015-10-07 |
Note que el nombre de las especies se encuentra dividido en las columnas Genus y Specific_epithet y es la segunda de estas columnas la que se debe utilizar para referirse a diferentes especies.
Ejercicio 3
- Cree un bucle
for()que calcule el promedio de la distribución latitudinal para cada especie. Los datos deben ser guardados en un vector y este debe tener como nombres los epíteto especificos (10 pts).
med_lat <- NULL
for (i in unique(turdus$Specific_epithet)) {
# sacar latitud promedio para especie i
med_lat_i <- mean(turdus$Latitude[turdus$Specific_epithet == i], na.rm = TRUE)
# anadir a resultados
med_lat <- append(med_lat, med_lat_i)
}
names(med_lat) <- unique(turdus$Specific_epithet)
med_lat## philomelos merula grayi rufiventris pilaris
## 50.5359391 49.1397507 14.6903898 -25.9783180 53.6625491
## iliacus viscivorus fuscater albicollis ignobilis
## 54.7493830 49.8631145 1.1696073 -13.7744138 -0.5028342
## torquatus rufopalliatus leucomelas migratorius flavipes
## 48.9099588 22.9700583 -10.1987442 42.0200877 -13.4998453
## amaurochalinus
## -24.2870532- Cree un bucle
for()que calcule promedio de de la distribución longitudinal para cada especie, similar al ejercicio anterior (5 pts).
## philomelos merula grayi rufiventris pilaris
## 9.408154 6.701079 -88.946921 -51.033784 15.277555
## iliacus viscivorus fuscater albicollis ignobilis
## 12.764630 12.013785 -75.722762 -55.970380 -73.140242
## torquatus rufopalliatus leucomelas migratorius flavipes
## 6.662806 -104.171615 -54.807061 -101.226153 -53.369644
## amaurochalinus
## -53.173086- Cree un cuadro de datos (‘data.frame’) conteniendo los resultados de los 2 bucles anteriores, incluyendo una columna con los epítetos específicos (2.5 pts). Debe producir el siguiente resultado:
df <- data.frame(especie = unique(turdus$Specific_epithet), med_lat, med_lon, row.names = NULL)
df| especie | med_lat | med_lon |
|---|---|---|
| philomelos | 50.5359391 | 9.408154 |
| merula | 49.1397507 | 6.701079 |
| grayi | 14.6903898 | -88.946921 |
| rufiventris | -25.9783180 | -51.033784 |
| pilaris | 53.6625491 | 15.277555 |
| iliacus | 54.7493830 | 12.764630 |
| viscivorus | 49.8631145 | 12.013785 |
| fuscater | 1.1696073 | -75.722762 |
| albicollis | -13.7744138 | -55.970380 |
| ignobilis | -0.5028342 | -73.140242 |
| torquatus | 48.9099588 | 6.662806 |
| rufopalliatus | 22.9700583 | -104.171615 |
| leucomelas | -10.1987442 | -54.807061 |
| migratorius | 42.0200877 | -101.226153 |
| flavipes | -13.4998453 | -53.369644 |
| amaurochalinus | -24.2870532 | -53.173086 |
- Utilice la función
tapply()para realizar los mismos cálculos de los ejercicios 3a y 3b (5 pts).
med_lat <- tapply(turdus$Latitude, turdus$Specific_epithet, mean)
med_lon <- tapply(turdus$Longitude, turdus$Specific_epithet, mean)- Cree una función que, para una especie, calcule el promedio latitudinal y longitudinal (10 pts). Pruebe la función sobre los datos generados a continuación:
albicollis <- turdus[turdus$Specific_epithet == "albicollis", ]funcion_3e <- function(X) data.frame(eptiteto = X$Specific_epithet[1], latitud = mean(X$Latitude,
na.rm = TRUE), longitud = mean(X$Longitude, na.rm = TRUE))
funcion_3e(X = albicollis)## eptiteto latitud longitud
## 1 albicollis -13.77441 -55.97038- Use un bucle
lapply()que aplique la función creada en 3e a cada una de las especies en la base de datosturdus(10 pts). Los primeros dos elementos de la lista que devuelvelapply()se deben ver como estos:
lapply(turdus$Specific_epithet[1:2], function(x) funcion_3e(X = turdus[turdus$Specific_epithet ==
x, ]))## [[1]]
## eptiteto latitud longitud
## 1 philomelos 50.53594 9.408154
##
## [[2]]
## eptiteto latitud longitud
## 1 merula 49.13975 6.701079- Use un bucle
sapply()para calcular el número de observaciones para cada especie (10 pts).
sapply(unique(turdus$Specific_epithet), function(x) sum(turdus$Specific_epithet ==
x))## philomelos merula grayi rufiventris pilaris
## 3768 5346 304 392 1081
## iliacus viscivorus fuscater albicollis ignobilis
## 1567 910 234 206 136
## torquatus rufopalliatus leucomelas migratorius flavipes
## 577 162 329 691 203
## amaurochalinus
## 147Información de la sesión
## R version 4.1.1 (2021-08-10)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.9.0
## LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.9.0
##
## locale:
## [1] LC_CTYPE=es_ES.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=es_CR.UTF-8 LC_COLLATE=es_ES.UTF-8
## [5] LC_MONETARY=es_CR.UTF-8 LC_MESSAGES=es_ES.UTF-8
## [7] LC_PAPER=es_CR.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=es_CR.UTF-8 LC_IDENTIFICATION=C
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] ggplot2_3.3.5 kableExtra_1.3.4 knitr_1.34
##
## loaded via a namespace (and not attached):
## [1] highr_0.9 bslib_0.2.5.1 compiler_4.1.1 pillar_1.6.2
## [5] formatR_1.11 jquerylib_0.1.4 tools_4.1.1 digest_0.6.27
## [9] jsonlite_1.7.2 evaluate_0.14 lifecycle_1.0.0 tibble_3.1.3
## [13] gtable_0.3.0 viridisLite_0.4.0 pkgconfig_2.0.3 rlang_0.4.11
## [17] DBI_1.1.1 rstudioapi_0.13 yaml_2.2.1 xfun_0.26
## [21] fastmap_1.1.0 withr_2.4.2 dplyr_1.0.7 httr_1.4.2
## [25] stringr_1.4.0 xml2_1.3.2 generics_0.1.0 vctrs_0.3.8
## [29] sass_0.4.0 systemfonts_1.0.2 tidyselect_1.1.1 webshot_0.5.2
## [33] grid_4.1.1 svglite_2.0.0 glue_1.4.2 R6_2.5.1
## [37] fansi_0.5.0 rmarkdown_2.10 farver_2.1.0 purrr_0.3.4
## [41] magrittr_2.0.1 scales_1.1.1 htmltools_0.5.2 ellipsis_0.3.2
## [45] assertthat_0.2.1 rvest_1.0.1 colorspace_2.0-2 labeling_0.4.2
## [49] utf8_1.2.2 stringi_1.7.4 munsell_0.5.0 crayon_1.4.1