Skip to content

Instantly share code, notes, and snippets.

@johnbaums
Last active July 9, 2019 05:26
Show Gist options
  • Save johnbaums/866a146dd70cbf476ddefdb1e080e346 to your computer and use it in GitHub Desktop.
Save johnbaums/866a146dd70cbf476ddefdb1e080e346 to your computer and use it in GitHub Desktop.
Download species sighting data using the BIONET API (https://data.bionet.nsw.gov.au/)
get_bionet <- function(x, username, password, outdir, prefix='bionet_',
filetype='csv', matchtype='startswith',
return_data=FALSE, quiet=FALSE, verbose=FALSE) {
# x: a vector of species names
# username, password (optional): credentials for BIONET service
# outdir: output directory (must exist)
# prefix: csv/rds files will be saved in outdir following the pattern
# outdir/prefix_Genus_species_yyyymmddHHMMSS.csv/rds
# filetype: must be one of csv or rds
# matchtype: must be one of 'startswith', 'contains', or 'equals'.
# Records will be returned where scientificName starts with,
# contains, or equals the search string, respectively. Using
# starts with can be useful when subspecies are desired, but
# may also return unwanted taxa (e.g. hybrids).
# return_data: should occurrence data be returned to R? Consider memory requirements
# quiet: should progress messages be suppressed?
# verbose: should GET request messages be shown?
#
# Returns a list of tibbles containing all fields and records returned by the
# query.
require(httr)
require(dplyr)
x <- setdiff(unique(x), NA)
stopifnot(dir.exists(outdir))
filetype <- match.arg(filetype, c('csv', 'rds'))
matchtype <- match.arg(matchtype, c('startswith', 'contains', 'equals'))
auth <- !missing(username) & !missing(password)
if(!auth & !quiet) {
message('No credentials supplied - retrieving public data')
} else {
message('Using supplied credentials')
}
url <- 'https://data.bionet.nsw.gov.au'
service <- 'biosvcapp/odata/SpeciesSightings_CoreData/'
occ <- lapply(x, function(species, username, password) {
if(!quiet) message(' - ', species)
s <- switch(matchtype,
startswith="startswith(toupper(scientificName), '%s')",
contains="contains(toupper(scientificName), '%s')",
equals="toupper(scientificName) eq '%s'")
q <- list("$filter"=sprintf(s, toupper(species)))
if(auth) {
r <- GET(url, path=service, query=q, config=list(
authenticate(username, password, "basic"),
if(verbose) verbose() else NULL))
} else {
r <- GET(url, path=service, query=q,
config=if(verbose) list(verbose()) else NULL)
}
stop_for_status(r)
value <- content(r)$value
dat <- lapply(value, function(x) {
Filter(Negate(is.null), x)
}) %>% bind_rows
f <- sprintf('%s/%s%s_%s.%s', outdir, prefix, gsub(' +', '_', species),
format(Sys.time(), '%Y%m%d%H%M%S'), filetype)
if(filetype=='csv') write.csv(dat, f, row.names=FALSE)
if(filetype=='rds') saveRDS(dat, f)
if(isTRUE(return_data)) dat else NULL
}, username=username, password=password)
if(isTRUE(return_data)) {
occ <- setNames(occ, x)
return(occ)
} else {
return(invisible(NULL))
}
}
@johnbaums
Copy link
Author

johnbaums commented Jul 9, 2019

Example

library(sp)
library(httr)
library(dplyr)
occ <- get_bionet('Ninox strenua', outdir=tempdir(), return_data=TRUE)
coordinates(occ$`Ninox strenua`) <- ~decimalLongitude+decimalLatitude
plot(subset(countries110, name=='Australia'))
points(occ$`Ninox strenua`, pch='.', col=2)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment