Intrucciones generales:

La fecha de entrega es el 8 de mayo
La tarea debe ser entregada en formato .Rmd
Utilice secciones de código (“chunks”) separados para cada ejercicio y subtítulos para cada sección
El código debe estar meticulosamente documentado con comentarios junto a las lineas de código (usando #)
Las funciones deben ser aplicables a datos similares (no solo a los del ejemplo)

La función querxc() en el paquete warbleR permite buscar y descargar registros de señales acústicas de aves (e.g. cantos de aves) en la base de datos en linea Xeno-Canto. Estos registros tienen gran cantidad de metadatos, incluyendo el género, especie, subespecie, fecha, hora, y coordenadas geográficas entre otras. Estos datos los vamos a usar para ver la variación en los patrones estacionales de actividad de las especies del género Turdus (al que pertenece el yigüirro Turdus grayi). Turdus es un grupo de distribución cosmopolita que se caracteriza por ser vocalmente muy activo, y por tanto esta ampliamente representado en Xeno-Canto.

Primero debemos instalar y cargar el paquete warbleR:

install.packages("warbleR")

library(warbleR)

Con querxc() podemos hacer búsquedas de familias, géneros o especies (también búsquedas por sitios, grabadores, países, etc, pero estas son mas complejas). En nuestro caso vamos a bajar los metadatos para las grabaciones del género Turdus de la siguiente forma (necesita conexión a internet!):

turdus <- querxc("Turdus", download = FALSE)

Podemos ver los nombres de las columnas para darnos una idea de lo que contienen los metadatos:

##  [1] "Recording_ID"      "Genus"             "Specific_epithet" 
##  [4] "Subspecies"        "English_name"      "Recordist"        
##  [7] "Country"           "Locality"          "Latitude"         
## [10] "Longitude"         "Vocalization_type" "Audio_file"       
## [13] "License"           "Url"               "Quality"          
## [16] "Time"              "Date"

Por supuesto también podemos usar head() para ver las primeras filas:

head(turdus)

##   Recording_ID  Genus Specific_epithet     Subspecies         English_name
## 1       199449 Turdus     litsitsirupa   litsitsirupa Groundscraper Thrush
## 2       347146 Turdus     litsitsirupa                Groundscraper Thrush
## 3       300630 Turdus     litsitsirupa       simensis Groundscraper Thrush
## 4       300628 Turdus     litsitsirupa       simensis Groundscraper Thrush
## 5       298557 Turdus     litsitsirupa litsitsirupa ? Groundscraper Thrush
## 6       292929 Turdus     litsitsirupa                Groundscraper Thrush
##         Recordist      Country
## 1   Niall Perrins South Africa
## 2   Peter Boesman      Namibia
## 3   Peter Boesman     Ethiopia
## 4   Peter Boesman     Ethiopia
## 5   Frank Lambert       Malawi
## 6 Faansie Peacock South Africa
##                                                          Locality
## 1                                    Mabusa, Nkangala, Mpumalanga
## 2                                               Omaruru area west
## 3                                               Debre Birhan area
## 4                                              Debre Libanos area
## 5 Dzalanyama Forest Reserve, southern access road, Central Region
## 6             Eweni, Champagne Castle, Drakensberg, KwaZulu-Natal
##     Latitude Longitude Vocalization_type
## 1   -25.3617   29.0884              call
## 2 -21.447504 15.887621     song and call
## 3   9.670645 39.533701              song
## 4   9.711656 38.857939              song
## 5   -14.2649   33.5459      alarm?, call
## 6   -29.0476   29.4229              song
##                                  Audio_file
## 1 http://www.xeno-canto.org/199449/download
## 2 http://www.xeno-canto.org/347146/download
## 3 http://www.xeno-canto.org/300630/download
## 4 http://www.xeno-canto.org/300628/download
## 5 http://www.xeno-canto.org/298557/download
## 6 http://www.xeno-canto.org/292929/download
##                                             License
## 1 http://creativecommons.org/licenses/by-nc-sa/4.0/
## 2 http://creativecommons.org/licenses/by-nc-nd/4.0/
## 3 http://creativecommons.org/licenses/by-nc-nd/4.0/
## 4 http://creativecommons.org/licenses/by-nc-nd/4.0/
## 5 http://creativecommons.org/licenses/by-nc-nd/4.0/
## 6 http://creativecommons.org/licenses/by-nc-sa/4.0/
##                                Url  Quality  Time       Date
## 1 http://www.xeno-canto.org/199449 no score 08:00 2014-10-19
## 2 http://www.xeno-canto.org/347146        A  8:30 2016-11-11
## 3 http://www.xeno-canto.org/300630        A 15:00 2015-12-02
## 4 http://www.xeno-canto.org/300628        A 10:00 2015-12-01
## 5 http://www.xeno-canto.org/298557        A 11:09 2015-11-26
## 6 http://www.xeno-canto.org/292929        A 05:30 2015-11-21

Ejercicio 1:

Con la función grep() podemos generar vectores con los indices (la posición en el vector) que nos indican si un texto (i.e. palabra) esta presente en cada uno de los elementos de un vector no-numérico. Por ejemplo este código nos dice si “ab” esta en cada elemento del vector v1:

v1  <- c("acd", "abc", "accb", "abb", "aab", "bc")

grep("ab", v1)

## [1] 2 4 5

Utilice esta función para eliminar los registros que no tengan la palabra “song” del juego de datos turdus.

SOLUCIÓN:

turdus <- turdus[grep("song", turdus$Vocalization_type),]

¿Cómo puede hacer que la función no tome en cuenta si las letras están en mayúscula o minúscula (osea que tome “Song”, “song” y “SONG” como lo mismo)? (pista: Fíjese en la descripción de los argumentos en la documentación de la función).

SOLUCIÓN:

Usando el argumento ‘ignore.case’ de la funcion grep() como verdadero (TRUE).

Elimine nuevamente los registros del juego de datos pero esta vez ignorando mayúsculas/minúsculas.

SOLUCIÓN:

turdus <- turdus[grep("song", turdus$Vocalization_type, ignore.case = TRUE),]

Ejercicio 2:

Podemos darnos una idea de la distribución geográfica de los datos con un histograma de la longitud. Primero debemos convertir la columna Longitude a numérica:

# convertir logitude a numerico
turdus$Longitude <- as.numeric(as.character(turdus$Longitude))

# hacer histograma 
hist(turdus$Longitude, main = NULL, col = terrain.colors(20, alpha = 0.5)[2], xlab = "Longitud", ylab = "Frecuencia")

#poner linea roja entre viejo y nuevo mundo
abline(v = -25, col = "red", lty = 3, lwd = 2)

En ese gráfico podemos ver como se separan las grabaciones del Viejo y Nuevo Mundo. Podemos suponer que menos de -25 de Longitud es el Nuevo Mundo. Podemos confirmarlo viendo los paises que quedan por debajo de ese umbral:

unique(droplevels(turdus$Country[turdus$Longitude < - 25]))

##  [1] Venezuela          Colombia           <NA>              
##  [4] Brazil             Argentina          Guyana            
##  [7] Ecuador            Peru               Portugal          
## [10] Canada             Bolivia            Costa Rica        
## [13] Honduras           Mexico             Guatemala         
## [16] El Salvador        Uruguay            Paraguay          
## [19] Chile              United Kingdom     Suriname          
## [22] Panama             Nicaragua          French Guiana     
## [25] United States      Belize             Trinidad & Tobago 
## [28] Dominican Republic Jamaica            Bahamas           
## [31] Puerto Rico        Cuba               France            
## 32 Levels: Venezuela Colombia Brazil Argentina Guyana Ecuador ... Puerto Rico

El Reino Unido sale por la colonia que tiene en las Malvinas:

turdus$Locality[turdus$Country == "United Kingdom" & turdus$Longitude < -25]

## [1] The Rookery, Saunder Island, Falkland Islands
## 3209 Levels: Mabusa, Nkangala, Mpumalanga ... Tristan da Cunha

Lo importante aqui es que podemos usar la longitud para determinar si las especies son del Nuevo o Viejo Mundo.

De igual forma podemos usar la columna de “Latitude” para ver la distribución latitudinal de las especies.

Cree una función que determine el rango de distribución latitudinal de cada especie. La función debe devolver un juego de datos (data frame) con 4 columnas: el nombre de la especie, el limite de rango Sur y el limite de rango Norte y el punto medio de la distribución.

SOLUCIÓN con for loop:

dist.alt1 <- function(X, mundo1 = NULL) {
  
  # dividir los datos por epiteto (usar droplevels para quitar niveles 'ocultos')
  sp.dt <- split(X, droplevels(X$Specific_epithet))

# crear vectores nulos para el for loop  
especie <- punto.medio <- lim.Norte <- lim.Sur <- NULL

 # loop sobre cada epiteto especifico
 for(x in 1:length(sp.dt))
    {
  # guardar especie
   especie[x] <- paste(sp.dt[[x]]$Genus[1], sp.dt[[x]]$Specific_epithet[1])

  # limite SUR
  lim.Sur[x] <- min(sp.dt[[x]]$Latitude, na.rm = TRUE)
  
  # limite NORTE
  lim.Norte[x] <- max(sp.dt[[x]]$Latitude, na.rm = TRUE)
  
  #Punto Medio
  punto.medio[x] <- mean(c(lim.Norte[x], lim.Sur[x]))
    }
  
    #poner vectores juntos en un data frame (pueden usar cbind() tambien)
   df <- data.frame(especie, lim.Norte, lim.Sur, punto.medio)
 
  return(df)   
}

# hacer
turdus$Latitude <- as.numeric(as.character(turdus$Latitude))

# correr funcion
dstr.turdus1 <- dist.alt1(turdus, mundo = T)

head(dstr.turdus1)

##               especie lim.Norte  lim.Sur punto.medio
## 1 Turdus litsitsirupa  9.711656 -29.0476   -9.667972
## 2     Turdus flavipes 11.270000 -29.6134   -9.171700
## 3      Turdus leucops  9.604800 -13.1000   -1.747600
## 4       Turdus pelios 13.395100  -0.3530    6.521050
## 5  Turdus tephronotus  4.529450  -2.9524    0.788525
## 6    Turdus libonyana -8.992000 -29.8582  -19.425100

SOLUCIÓN con lapply y do.call:

#crear funcion
dist.alt2 <- function(X) {
  
 # correr un loop sobre cada epiteto especifico
 res <- lapply(unique(X$Specific_epithet), function(z)
    {
   #hacer un subconjunto para cada especie
   sp.dt <- X[X$Specific_epithet == z, ]

  # limite SUR (minimo)
   lim.Sur <- min(sp.dt$Latitude, na.rm = TRUE)
  
  # limite NORTE (minimo)
  lim.Norte <- max(sp.dt$Latitude, na.rm = TRUE)
  
  #Punto medio
  punto.medio <- mean(c(lim.Sur, lim.Norte))
   
  df <- data.frame(especie = paste("Turdus", z), lim.Norte, lim.Sur, punto.medio)
   })
 
res <- do.call(rbind, res)
 
return(res)   
}

# correr funcion
dstr.turdus2 <- dist.alt2(turdus)

# ver primeros 6 filas
head(dstr.turdus2)

##               especie lim.Norte  lim.Sur punto.medio
## 1 Turdus litsitsirupa  9.711656 -29.0476   -9.667972
## 2     Turdus flavipes 11.270000 -29.6134   -9.171700
## 3      Turdus leucops  9.604800 -13.1000   -1.747600
## 4       Turdus pelios 13.395100  -0.3530    6.521050
## 5  Turdus tephronotus  4.529450  -2.9524    0.788525
## 6    Turdus libonyana -8.992000 -29.8582  -19.425100

SOLUCIÓN con tapply:

#crear funcion
dist.alt3 <- function(X) {
  
  # limite SUR (minimo)
   lim.Sur <- tapply(X$Latitude, X$Specific_epithet, min, na.rm = TRUE)
  
  
  # limite NORTE (minimo)
  lim.Norte <- tapply(X$Latitude, X$Specific_epithet, max, na.rm = TRUE)
  
  
  #Punto medio
  punto.medio <- (lim.Norte + lim.Sur)/2
   
  df <- data.frame(especie = paste("Turdus", names(lim.Sur)), lim.Norte, lim.Sur, punto.medio)
  
  rownames(df) <- 1:nrow(df)
  
return(df)   
}

# correr funcion
dstr.turdus3 <- dist.alt3(turdus)

Modifique la función para que incluya una columna que indique si las especies son del Viejo o Nuevo Mundo.

Pistas:

la función debe tener un loop adentro (for(), tapply() o lapply())
la función debe generar internamente un sub-juego de datos para cada especie.

SOLUCIÓN con lapply:

dist.alt4 <- function(X) {
  
    # correr loop lapply sobre cada especie
   res <- lapply(unique(X$Specific_epithet), function(z)
    {
    # extraer datos de 1 especie
    sp.dt <- X[X$Specific_epithet == z, ]
   
    #cacular limites
   lim.Sur <- min(sp.dt$Latitude, na.rm = TRUE)
  lim.Norte <- max(sp.dt$Latitude, na.rm = TRUE)
  punto.medio <- mean(c(lim.Norte, lim.Sur))

  if(mean(sp.dt$Longitude, na.rm = TRUE) > -25) mundo <- "Viejo Mundo" else mundo <- "Nuevo Mundo"

  df <- data.frame(especie = paste(X$Genus[1], z), lim.Norte, lim.Sur, punto.medio, mundo)
   })
df <- do.call(rbind, res)
 
return(df)   
}


dstr.turdus4 <- dist.alt4(turdus)

head(dstr.turdus4)

##               especie lim.Norte  lim.Sur punto.medio       mundo
## 1 Turdus litsitsirupa  9.711656 -29.0476   -9.667972 Viejo Mundo
## 2     Turdus flavipes 11.270000 -29.6134   -9.171700 Nuevo Mundo
## 3      Turdus leucops  9.604800 -13.1000   -1.747600 Nuevo Mundo
## 4       Turdus pelios 13.395100  -0.3530    6.521050 Viejo Mundo
## 5  Turdus tephronotus  4.529450  -2.9524    0.788525 Viejo Mundo
## 6    Turdus libonyana -8.992000 -29.8582  -19.425100 Viejo Mundo

SOLUCIÓN con for loop:

dist.alt5 <- function(X) {
  
  sp.dt <- split(X, droplevels(X$Specific_epithet))

mundo <- especie <- punto.medio <- lim.Norte <- lim.Sur <- NULL

 for(x in 1:length(sp.dt))
    {
  especie[x] <- paste(sp.dt[[x]]$Genus[1], sp.dt[[x]]$Specific_epithet[1])
   lim.Sur[x] <- min(sp.dt[[x]]$Latitude, na.rm = TRUE)
  lim.Norte[x] <- max(sp.dt[[x]]$Latitude, na.rm = TRUE)
  punto.medio[x] <- mean(c(lim.Norte[x], lim.Sur[x]))
  
  if(mean(sp.dt[[x]]$Longitude, na.rm = TRUE) > -25) mundo[x] <- "Viejo Mundo" else mundo[x] <- "Nuevo Mundo"
    }
  
   df <- data.frame(especie, lim.Norte, lim.Sur, punto.medio, mundo)
 
  return(df)   
}

dist.turdus5 <- dist.alt5(turdus)

head(dist.turdus5)

##               especie lim.Norte  lim.Sur punto.medio       mundo
## 1 Turdus litsitsirupa  9.711656 -29.0476   -9.667972 Viejo Mundo
## 2     Turdus flavipes 11.270000 -29.6134   -9.171700 Nuevo Mundo
## 3      Turdus leucops  9.604800 -13.1000   -1.747600 Nuevo Mundo
## 4       Turdus pelios 13.395100  -0.3530    6.521050 Viejo Mundo
## 5  Turdus tephronotus  4.529450  -2.9524    0.788525 Viejo Mundo
## 6    Turdus libonyana -8.992000 -29.8582  -19.425100 Viejo Mundo

SOLUCIÓN con tapply:

#crear funcion
dist.alt6 <- function(X) {
  
  # limite SUR (minimo)
   lim.Sur <- tapply(X$Latitude, X$Specific_epithet, min, na.rm = TRUE)
  
  # limite NORTE (minimo)
  lim.Norte <- tapply(X$Latitude, X$Specific_epithet, max, na.rm = TRUE)

  #Punto medio
  punto.medio <- (lim.Norte + lim.Sur)/2
  
  # determinar mundo
  mundo <- tapply(X$Longitude, X$Specific_epithet, function(x) {
  if(mean(x, na.rm = TRUE) > -25) return("Viejo Mundo") else  return("Nuevo Mundo")
  })
  
   # poner juntos en data frame
  df <- data.frame(especie = paste("Turdus", names(lim.Sur)), lim.Norte, lim.Sur, punto.medio, mundo)
  
  # cambiar nombre de filas
  rownames(df) <- 1:nrow(df)
  
return(df)   
}

# correr funcion
dstr.turdus6 <- dist.alt6(turdus)

head(dstr.turdus6)

##               especie lim.Norte  lim.Sur punto.medio       mundo
## 1 Turdus litsitsirupa  9.711656 -29.0476   -9.667972 Viejo Mundo
## 2     Turdus flavipes 11.270000 -29.6134   -9.171700 Nuevo Mundo
## 3      Turdus leucops  9.604800 -13.1000   -1.747600 Nuevo Mundo
## 4       Turdus pelios 13.395100  -0.3530    6.521050 Viejo Mundo
## 5  Turdus tephronotus  4.529450  -2.9524    0.788525 Viejo Mundo
## 6    Turdus libonyana -8.992000 -29.8582  -19.425100 Viejo Mundo

Opcional) Añada un argumento lógico que permita controlar si el resultado de la función contiene solo especies del Viejo Mundo, del Nuevo Mundo o ambos (Esto no es parte de la tarea y no vale puntos extra).

SOLUCIÓN con lapply:

# argumento logico 'mundo' q devuelve viejo mundo si es TRUE, nuevo si FALSE,  y ambos si NULL

dist.alt7 <- function(X, mundo = NULL) {
  
    # correr loop lapply sobre cada especie
   res <- lapply(unique(X$Specific_epithet), function(z)
    {
    # extraer datos de 1 especie
    sp.dt <- X[X$Specific_epithet == z, ]
   
    #cacular limites
   lim.Sur <- min(sp.dt$Latitude, na.rm = TRUE)
  lim.Norte <- max(sp.dt$Latitude, na.rm = TRUE)
  punto.medio <- mean(c(lim.Norte, lim.Sur))

  # note que cambien mundo a mnd para no sobreescribir el argumento 'mundo'
  if(mean(sp.dt$Longitude, na.rm = TRUE) > -25) mnd <- "Viejo Mundo" else mnd <- "Nuevo Mundo"

  df <- data.frame(especie = z, lim.Norte, lim.Sur, punto.medio, mundo = mnd)
   })
df <- do.call(rbind, res)

# sacar subconjunto de datos en base a argumento mundo 
if(!is.null(mundo))
  {
  if(mundo) df <- df[df$mundo =="Viejo Mundo", ] else df <- df[df$mundo =="Nuevo Mundo", ] 
}

return(df)   
}

#solo viejo mundo
dstr.turdus7 <- dist.alt7(turdus,  mundo = TRUE)

head(dstr.turdus7)

##          especie  lim.Norte  lim.Sur punto.medio       mundo
## 1   litsitsirupa   9.711656 -29.0476   -9.667972 Viejo Mundo
## 4         pelios  13.395100  -0.3530    6.521050 Viejo Mundo
## 5    tephronotus   4.529450  -2.9524    0.788525 Viejo Mundo
## 6      libonyana  -8.992000 -29.8582  -19.425100 Viejo Mundo
## 7 olivaceofuscus   0.288500   0.1121    0.200300 Viejo Mundo
## 8      olivaceus -33.294500 -33.9880  -33.641250 Viejo Mundo

#solo nuevo mundo
dstr.turdus7.2 <- dist.alt7(turdus,  mundo = FALSE)

head(dstr.turdus7.2)

##       especie lim.Norte  lim.Sur punto.medio       mundo
## 2    flavipes   11.2700 -29.6134     -9.1717 Nuevo Mundo
## 3     leucops    9.6048 -13.1000     -1.7476 Nuevo Mundo
## 39   fuscater    8.8589 -14.6833     -2.9122 Nuevo Mundo
## 40  chiguanco   -3.4100 -32.2130    -17.8115 Nuevo Mundo
## 41 nigrescens    9.5778   9.5400      9.5589 Nuevo Mundo
## 42 infuscatus   19.6595  14.0285     16.8440 Nuevo Mundo

#ambos
dstr.turdus7.3 <- dist.alt7(turdus,  mundo = NULL)

head(dstr.turdus7.3)

##        especie lim.Norte  lim.Sur punto.medio       mundo
## 1 litsitsirupa  9.711656 -29.0476   -9.667972 Viejo Mundo
## 2     flavipes 11.270000 -29.6134   -9.171700 Nuevo Mundo
## 3      leucops  9.604800 -13.1000   -1.747600 Nuevo Mundo
## 4       pelios 13.395100  -0.3530    6.521050 Viejo Mundo
## 5  tephronotus  4.529450  -2.9524    0.788525 Viejo Mundo
## 6    libonyana -8.992000 -29.8582  -19.425100 Viejo Mundo

Tarea 2

Programación y métodos estadísticos avanzados en R

Marcelo Araya-Salas, PhD & Mario Espinoza, PhD B-0606/SP-8231 UCR Escuela de Biología, Universidad de Costa Rica

10-05-2017

Ejercicio 1:

SOLUCIÓN:

SOLUCIÓN:

SOLUCIÓN:

Ejercicio 2:

SOLUCIÓN con for loop:

SOLUCIÓN con lapply y do.call:

SOLUCIÓN con tapply:

SOLUCIÓN con lapply:

SOLUCIÓN con for loop:

SOLUCIÓN con tapply:

SOLUCIÓN con lapply: