Nothing
globi_api_url <- "api.globalbioticinteractions.org"
# Get GloBI Options
# @param opts list containing options
# @return list with options including default for missing options
add_missing_options <- function(opts, host = globi_api_url) {
defaults <- list(host = host, port = 443)
opts <- c(opts, defaults)
opts[unique(names(opts))]
}
# Get GloBI URL
#
# @param suffix additional information passed to api
# @param opts list of options to configure GloBI API
# @return url address used to call api
get_globi_url <- function(suffix, opts = list()) {
opts <- add_missing_options(opts)
paste("https://", opts$host, ":", opts$port, suffix, sep = "")
}
# Check If Web API resolvable
#
# @return true if api is available, false otherwise
has_api <- function() {
!is.null(curl::nslookup(globi_api_url, error = FALSE))
}
# Read csv URL
# @param url points to csv resource
read_csv_online <- function(url, ...) {
if (has_api()) {
res <- suppressWarnings(suppressMessages(as.data.frame(readr::read_csv(url))))
# Drop rows with all NAs
res <- res[rowSums(is.na(res)) != ncol(res), ]
return(res)
}
stop(paste("GloBI data services are not available at [", globi_api_url, "]. Are you connected to the internet?", sep = ""))
}
#' Get Species Interaction from GloBI
#'
#' @param taxon canonical scientific name of source taxon (e.g. Homo sapiens)
#' @param interaction.type the preferred interaction type (e.g. preysOn)
#' @param ... list of options to configure GloBI API
#' @return species interactions between source and target taxa
#' @family interactions
#' @export
#' @examples \donttest{
#' get_interactions("Homo sapiens", "preysOn")
#' get_interactions("Insecta", "parasiteOf")
#' }
get_interactions <- function(taxon = "Homo sapiens", interaction.type = "preysOn", ...) {
get_interactions_by_taxa (sourcetaxon = taxon, interactiontype = interaction.type, ...)
}
#' Get Species Interactions by Interaction Type from GloBI
#'
#' @param interactiontype the requested interaction type (e.g. preysOn)
#' @param ... list of options to configure GloBI API
#' @return species interactions given provided interaction type(s)
#' @family interactions
#' @export
#' @examples \donttest{
#' get_interactions_by_type(interactiontype = c("eats", "eatenBy"))
#' get_interactions_by_type(interactiontype = "parasiteOf")
#' }
get_interactions_by_type <- function(interactiontype = c("interactsWith"), ...) {
get_interactions_by_taxa (sourcetaxon = NULL, interactiontype = interactiontype, ...)
}
#' Get a List of Prey for given Predator Taxon
#'
#' @param taxon scientific name of predator taxon. Can be any taxonomic rank (e.g. Homo sapiens, Animalia)
#' @param ... list of named options to configure GloBI API
#' @return list of recorded predator-prey interactions that involve the desired predator taxon
#' @export
#' @family interactions
#' @examples \donttest{
#' get_prey_of("Homo sapiens")
#' get_prey_of("Primates")
#'}
get_prey_of <- function(taxon = "Homo sapiens", ...) {
get_interactions(taxon, ...)
}
#' Get a List of Predators of a Given Prey Taxon
#'
#' @param taxon scientific name of prey taxon. Can be any taxonomic rank (e.g. Rattus rattus, Decapoda)
#' @param ... list of named options to configure the GloBI API
#' @return list of recorded prey-predator interactions that involve the desired prey taxon.
#' @export
#' @family interactions
#' @examples \donttest{
#' get_predators_of("Rattus rattus")
#' get_predators_of("Primates")
#' }
get_predators_of <- function(taxon = "Rattus rattus", ...) {
get_interactions(taxon, "preyedUponBy", ...)
}
create_bbox_param <- function(bbox) {
if (is.null(bbox)){
"bbox="
} else {
if (is.numeric(bbox) & length(bbox)==4){
if (max (abs (bbox)) < 181 & bbox[1] <= bbox[3] & bbox[2] <= bbox[4]){
paste ("bbox=",bbox[1],",",
bbox[2],",", bbox[3],",", bbox[4], "&", sep="")
} else {
stop ("Coordinates entered incorrectly")
}} else {
stop ("Coordinates entered incorrectly")
}
}
}
#' @title Return interactions involving specific taxa
#'
#' @description Returns interactions involving specific taxa. Secondary (target)
#' taxa and spatial boundaries may also be set
#'
#' @import RCurl
#' @param sourcetaxon Taxa of interest (consumer, predator, parasite); may be
#' specified as "Genus species" or higher level (e.g., Genus, Family, Class).
#' @param targettaxon Taxa of interest (prey, host); may be specified as "Genus
#' species" or higher level (e.g., Genus, Family, Class)
#' @param interactiontype Interaction types of interest (prey, host); may be
#' specified as listed by get_interaction_types()
#' @param accordingto Data source of interest
#' @param showfield Data fields of interest (e. g. source_taxon_external_id, source_taxon_name);
#' may be specified as listed by get_data_fields()
#' @param otherkeys list of key-value pairs to query any field not covered by other parameters;
#' keys may be specified as listed by get_data_fields()
#' @param bbox Coordinates in EPSG:4326 decimal degrees defining "left, bottom,
#' right, top" of bounding box
#' @param returnobservations if true, all individual observations are returned,
#' else only distinct relationships
#' @param opts list of named options to configure GloBI API
#' @param read_csv function used to find csv associated to query url, defaulting to online query method
#' @return Returns data frame of interactions
#' @keywords database
#' @export
#' @note For data sources in which type of interactions were not specified, the interaction is labeled "interacts_with"
#' @family interactions
#' @examples \donttest{
#' get_interactions_by_taxa(sourcetaxon = "Rattus")
#' get_interactions_by_taxa(sourcetaxon = "Aves", targettaxon = "Rattus")
#' get_interactions_by_taxa(sourcetaxon = "Rattus rattus",
#' bbox = c(-67.87,12.79,-57.08,23.32))
#' }
get_interactions_by_taxa <- function(sourcetaxon, targettaxon = NULL, interactiontype = NULL, accordingto = NULL,
showfield = c("source_taxon_external_id","source_taxon_name","source_taxon_path","source_specimen_life_stage","interaction_type","target_taxon_external_id","target_taxon_name","target_taxon_path","target_specimen_life_stage","latitude","longitude","study_citation","study_external_id","study_source_citation"),
otherkeys = NULL, bbox = NULL, returnobservations = FALSE, opts = list(), read_csv = read_csv_online){
if(length(interactiontype)>0){
interactiontypes <- as.vector(get_interaction_types(read_csv = read_csv)[,1])
if(length(intersect(interactiontypes, interactiontype)) == 0){
stop ("Unsupported interaction type(s)")
} else {
if(length(intersect(interactiontypes, interactiontype)) < length(interactiontype)){
warning (
paste("Unsupported interaction type(s):", setdiff(interactiontype, interactiontypes))
)
interactiontype <- intersect(interactiontypes, interactiontype)
}
}
}
requesturlbase <- get_globi_url("/interaction?")
if (!is.logical(returnobservations)) {
warning ("Incorrect entry for 'returnobservations', using default value")
returnobservations <- F
}
includeobservations <- paste ("includeObservations=", ifelse(returnobservations, "t", "f"), sep = "")
requestsequence <- (function(
keyvaluelist = append(
list(
"sourceTaxon" = sourcetaxon,
"targetTaxon" = targettaxon,
"interactionType" = interactiontype,
"accordingTo" = accordingto,
"field" = showfield
), otherkeys)
){
paste(
stats::na.omit(
sapply(1:length(keyvaluelist), function(i){
if(length(keyvaluelist[[i]])>0){
paste(paste(names(keyvaluelist)[i], "=", RCurl::curlEscape(keyvaluelist[[i]]), sep = ""), collapse = "&")
} else {
NA
}
})
), collapse = "&")
})()
requesturl <- paste(requesturlbase, requestsequence, create_bbox_param(bbox), includeobservations, "type=csv", sep="&")
result <- read_csv(requesturl)
if(nrow(result) == 1024 & !"limit" %in% names(otherkeys)){
warning("Default results limit reached. Consider increasing limit parameter and/or using pagination to retrieve all results. See rglobi vignette section on pagination for help modifying limit/skip parameters.")
}
return(result)
}
#' @title Return all interactions in specified area
#'
#' @description Returns all interactions in data base in area specified in
#' arguments
#'
#' @param bbox Coordinates in EPSG:4326 decimal degrees defining "left, bottom,
#' right, top" of bounding box
#' @param ... list of named options to configure GloBI API
#' @return Returns data frame of interactions
#' @keywords database
#' @export
#' @family areas
#' @examples \donttest{
#' get_interactions_in_area(bbox = c(-67.87, 12.79, -57.08, 23.32))
#' }
get_interactions_in_area <- function(bbox, ...){
if (is.null(bbox)) {
stop("no coordinates provided")
} else {
get_interactions_by_taxa (sourcetaxon = NULL, bbox = bbox, ...)
}
}
#' @title Find locations at which interactions were observed
#'
#' @description Returns all locations (latitude,longitude) of interactions in data
#' base or area specified in arguments
#'
#' @param bbox Coordinates in EPSG:4326 decimal degrees defining "left, bottom,
#' right, top" of bounding box
#' @param ... list of named options to configure GloBI API
#' @param read_csv function used to find csv associated to query url, defaulting to online query method
#' @return Returns data frame of coordinates
#' @keywords database
#' @export
#' @family areas
#' @examples \donttest{
#' get_interaction_areas ()
#' get_interaction_areas (bbox=c(-67.87,12.79,-57.08,23.32))
#' }
get_interaction_areas <- function(bbox = NULL, read_csv = read_csv_online, ...){
requesturl <- read_csv (get_globi_url("/locations?type=csv", ...))
names (requesturl) <- c ("Latitude", "Longitude")
requesturl$Latitude <- as.numeric (requesturl$Latitude)
requesturl$Longitude <- as.numeric (requesturl$Longitude)
if (!is.null(bbox)){
if (is.numeric (bbox) & length (bbox)==4){
if (max(abs(bbox))<181 & bbox[1]<=bbox[3] & bbox[2]<=bbox[4]){
requesturl <- requesturl[requesturl$Latitude>=bbox[2] &
requesturl$Latitude<=bbox[4] & requesturl$Longitude>=bbox[1] &
requesturl$Longitude<=bbox[3], ]
return(requesturl)
}
} else {
stop("Coordinates entered incorrectly")
}
} else {requesturl}
}
#' @title List interactions identified in GloBI database
#'
#' @description Returns data frame with supported interaction types
#'
#' @param opts list of named options to configure GloBI API
#' @param read_csv function used to find csv associated to query url, defaulting to online query method
#' @return Returns data frame of supported interaction types
#' @keywords database
#' @export
#' @family interactions
#' @examples \donttest{
#' get_interaction_types()
#' }
get_interaction_types <- function(opts = list(), read_csv = read_csv_online) {
read_csv(get_globi_url("/interactionTypes.csv?type=csv", opts = opts))
}
#' @title List data fields identified in GloBI database
#'
#' @description Returns data frame with supported data fields
#'
#' @param opts list of named options to configure GloBI API
#' @param read_csv function used to find csv associated to query url, defaulting to online query method
#' @return Returns data frame of supported data fields
#' @keywords database
#' @export
#' @family data
#' @examples \donttest{
#' get_data_fields()
#' }
get_data_fields <- function(opts = list(), read_csv = read_csv_online) {
read_csv(get_globi_url("/interactionFields.csv?type=csv", opts = opts))
}
# Generate Diet Matrices using https://github.com/ropensci/rglobi
#
# To install:
# (a) install devtools using install.packages('devtools')
# (b) install rglobi using devtools::install_github('rglobi', 'ropensci')
# (c) load the contents of this gist into R using devtools::source_url('https://gist.githubusercontent.com/jhpoelen/81b4eced3963633b96cb/raw/dietMatrix.R')
#
# Examples
#
# Create a diet matrix for humans (Homo sapiens) and old world rat (Rattus rattus) using prey categories Aves and Mammalia:
# CreateDietMatrix(c('Homo sapiens', 'Rattus rattus'), c('Aves', 'Mammalia'))
#
# Example 1. Create a diet matrix of first 25 predator species taxa using Haydens Diet Category list (see defaults in GetPreyCategories()):
#
# diet.matrix <- CreateDietMatrix(GetPredatorTaxa(limit=25))
#
#
# Example 2. Same as example 1. except that port [1234] is used to query. This can be used to run queries again something
# other (e.g. Dark GloBI) than the default, open, GloBI instance. Note that port [1234] will have to be replaced with a
# valid port value in order for it to work.
#
# opts <- list(port=1234)
# predator.taxa <- GetPredatorTaxa(limit=25, opts=opts)
# diet.matrix <- CreateDietMatrix(predator.taxa, opts = opts)
#
# Result is a data frame with predator taxon name and food categories as columns and predator taxon occurrences as rows.
#
ReportProgress <- function() {
message('.', appendLF=FALSE)
}
rel_type_interaction_type <- function(interaction.type) {
list(preysOn = 'ATE|PREYS_UPON',
parasiteOf = 'PARASITE_OF',
pollinates = 'POLLINATES')[[interaction.type]]
}
# Retrieves diet items of given predator and classifies them by matching the prey categories against
# both taxon hierarchy of prey and the name that was originally used to describe the prey.
unique_target_taxa_of_source_taxon <- function(source.taxon.name, target.taxon.names, interaction.type, opts = list(), read_csv = read_csv_online) {
result <- get_interactions_by_taxa(sourcetaxon = source.taxon.name, interactiontype = interaction.type, targettaxon = target.taxon.names, opts = opts, read_csv = read_csv)
ReportProgress()
all.taxa.paths <- Reduce(function(accum, path) paste(accum, path), paste('{',result$target_taxon_path,'}', sep=''))
has.prey.category <- lapply(target.taxon.names, function(prey.category) {
match <- grep(prey.category, all.taxa.paths, perl=TRUE)
ifelse(length(match) > 0, 1, 0)
})
df <- data.frame(t(c(source.taxon.name, has.prey.category)))
names(df) <- c('source.taxon.name', target.taxon.names)
df
}
#' Get Interaction Matrix. Constructs an interaction matrix indicating whether source taxa (rows) or target taxa (columns) are known to interact with given type.
#'
#' @param source.taxon.names list of source taxon names (e.g. list('Mammalia', 'Aves', 'Ariopsis felis'))
#' @param target.taxon.names list of target taxon names
#' @param interaction.type the preferred interaction type (e.g. preysOn)
#' @param opts list of options to configure GloBI API
#' @param read_csv function used to find csv associated to query url, defaulting to online query method
#' @return matrix representing species interactions between source and target taxa
#' @family interactions
#' @export
#' @examples \donttest{
#' get_interaction_matrix("Homo sapiens", "Mammalia", "interactsWith")
#' }
get_interaction_matrix <- function(source.taxon.names = list('Homo sapiens'), target.taxon.names = list('Mammalia'), interaction.type = 'eats', opts = list(), read_csv = read_csv_online) {
Reduce(function(accum, source.taxon.name) rbind(accum, unique_target_taxa_of_source_taxon(source.taxon.name, target.taxon.names, interaction.type, opts = opts, read_csv = read_csv)), source.taxon.names, init=data.frame())
}
interaction_id_for_type <- function(interaction.type) {
list(preysOn = 'RO_0002439', parasiteOf = 'RO_0002444', pollinates = 'RO_0002455')[[interaction.type]]
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.