Skip to content

Commit

Permalink
bump 99 ver, fixes to name_usage tests, fix #174
Browse files Browse the repository at this point in the history
  • Loading branch information
sckott committed Jul 31, 2015
1 parent 7c3ee3b commit 6caaf2f
Show file tree
Hide file tree
Showing 4 changed files with 191 additions and 42 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ Description: A programmatic interface to the Web Service methods
taxonomic names, retrieving information on data providers,
getting species occurrence records, and getting counts of
occurrence records.
Version: 0.8.8.9000
Version: 0.8.8.9300
License: MIT + file LICENSE
Authors@R: c(person("Scott", "Chamberlain", role = c("aut", "cre"),
email = "myrmecocystus@gmail.com"),
Expand Down
59 changes: 32 additions & 27 deletions R/name_usage.r
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@
#' Note that \code{data="verbatim"} hasn't been working.
#'
#' Options for the data parameter are: 'all', 'verbatim', 'name', 'parents', 'children',
#' 'related', 'synonyms', 'descriptions','distributions', 'images',
#' 'related', 'synonyms', 'descriptions','distributions', 'media',
#' 'references', 'speciesProfiles', 'vernacularNames', 'typeSpecimens', 'root'
#'
#' This function used to be vectorized with respect to the \code{data} parameter,
Expand All @@ -40,7 +40,7 @@
#' name_usage()
#'
#' # References for a name usage
#' name_usage(key=3119195, data='references')
#' name_usage(key=2435099, data='references')
#'
#' # Species profiles, descriptions
#' name_usage(key=3119195, data='speciesProfiles')
Expand All @@ -66,64 +66,69 @@
#' }

name_usage <- function(key=NULL, name=NULL, data='all', language=NULL, datasetKey=NULL, uuid=NULL,
sourceId=NULL, rank=NULL, shortname=NULL, start=NULL, limit=100, return='all', ...)
{
sourceId=NULL, rank=NULL, shortname=NULL, start=NULL, limit=100, return='all', ...) {

calls <- names(sapply(match.call(), deparse))[-1]
calls_vec <- c("sourceId") %in% calls
if(any(calls_vec))
if (any(calls_vec)) {
stop("Parameters not currently accepted: \n sourceId")
}

args <- rgbif_compact(list(language=language, name=name, datasetKey=datasetKey,
rank=rank, offset=start, limit=limit, sourceId=sourceId))
args <- rgbif_compact(list(language = language, name = name, datasetKey = datasetKey,
rank = rank, offset = start, limit = limit, sourceId = sourceId))
data <- match.arg(data,
choices=c('all', 'verbatim', 'name', 'parents', 'children',
choices = c('all', 'verbatim', 'name', 'parents', 'children',
'related', 'synonyms', 'descriptions',
'distributions', 'images', 'references', 'speciesProfiles',
'vernacularNames', 'typeSpecimens', 'root'), several.ok=FALSE)
# if(length(data)==1) getdata(data) else lapply(data, getdata)
'distributions', 'media', 'references', 'speciesProfiles',
'vernacularNames', 'typeSpecimens', 'root'), several.ok = FALSE)
out <- getdata(data, key, uuid, shortname, args, ...)
# select output
return <- match.arg(return, c('meta','data','all'))
switch(return,
meta = get_meta(out),
data = name_usage_parse(out),
all = list(meta=get_meta(out), data=name_usage_parse(out))
all = list(meta = get_meta(out), data = name_usage_parse(out, data))
)
}

get_meta <- function(x){
if(has_meta(x)) data.frame(x[c('offset','limit','endOfRecords')], stringsAsFactors = FALSE) else NA
get_meta <- function(x) {
if (has_meta(x)) data.frame(x[c('offset','limit','endOfRecords')], stringsAsFactors = FALSE) else NA
}

has_meta <- function(x) any(c('offset','limit','endOfRecords') %in% names(x))

getdata <- function(x, key, uuid, shortname, args, ...){
if(!x == 'all' && is.null(key))
stop('You must specify a key if data does not equal "all"')
if (!x == 'all' && is.null(key)) {
stop('You must specify a key if data does not equal "all"', call. = FALSE)
}

if(x == 'all' && is.null(key)){
if (x == 'all' && is.null(key)) {
url <- paste0(gbif_base(), '/species')
} else
{
if(x=='all' && !is.null(key)){
} else {
if (x == 'all' && !is.null(key)) {
url <- sprintf('%s/species/%s', gbif_base(), key)
} else
if(x %in% c('verbatim', 'name', 'parents', 'children',
if (x %in% c('verbatim', 'name', 'parents', 'children',
'related', 'synonyms', 'descriptions',
'distributions', 'images', 'references', 'speciesProfiles',
'vernacularNames', 'typeSpecimens')){
'distributions', 'media', 'references', 'speciesProfiles',
'vernacularNames', 'typeSpecimens')) {
url <- sprintf('%s/species/%s/%s', gbif_base(), key, x)
} else
if(x == 'root'){
if (x == 'root') {
url <- sprintf('%s/species/root/%s/%s', gbif_base(), uuid, shortname)
}
}
gbif_GET(url, args, FALSE, ...)
}

name_usage_parse <- function(x){
if(has_meta(x)){
do.call(rbind_fill, lapply(x$results, nameusageparser))
name_usage_parse <- function(x, y) {
many <- c("parents", "related")
if (has_meta(x) || y %in% many) {
if (y %in% many) {
do.call(rbind_fill, lapply(x, nameusageparser))
} else {
do.call(rbind_fill, lapply(x$results, nameusageparser))
}
} else {
nameusageparser(x)
}
Expand Down
4 changes: 2 additions & 2 deletions man/name_usage.Rd
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@ endpoint that allows name searches (see examples below).
Note that \code{data="verbatim"} hasn't been working.

Options for the data parameter are: 'all', 'verbatim', 'name', 'parents', 'children',
'related', 'synonyms', 'descriptions','distributions', 'images',
'related', 'synonyms', 'descriptions','distributions', 'media',
'references', 'speciesProfiles', 'vernacularNames', 'typeSpecimens', 'root'

This function used to be vectorized with respect to the \code{data} parameter,
Expand All @@ -87,7 +87,7 @@ name_usage(name='Puma', rank="GENUS")
name_usage()

# References for a name usage
name_usage(key=3119195, data='references')
name_usage(key=2435099, data='references')

# Species profiles, descriptions
name_usage(key=3119195, data='speciesProfiles')
Expand Down
168 changes: 156 additions & 12 deletions tests/testthat/test-name_usage.r
Original file line number Diff line number Diff line change
@@ -1,36 +1,180 @@
context("name_usage")

test_that("name_usage returns the correct class", {
test_that("name_usage works", {
skip_on_cran()

tt <- name_usage(key=1)
uu <- name_usage(key=3119195, data='references')
tt <- name_usage(key = 1)
uu <- name_usage(key = 5231190, data = 'references')

expect_is(tt, "list")
expect_is(tt$data$key, "integer")
expect_is(tt$data$kingdom, "character")

expect_is(uu, "list")
expect_is(uu$data, "data.frame")
expect_is(uu$data$sourceTaxonKey, "integer")
expect_is(uu$data$citation, "character")

# name_usage returns the correct value
expect_equal(tt$data$kingdom, "Animalia")
expect_match(uu$data$citation[1], "Allan Herbarium 2007: New Zealand Plant Names Database Concepts - Asterales.")


# name_usage returns the correct dimensions
expect_equal(length(tt), 2)
expect_equal(NCOL(tt$data), 20)
expect_equal(NROW(tt$data), 1)

expect_equal(length(uu), 2)
expect_equal(NCOL(uu$meta), 3)
expect_equal(NCOL(uu$data), 2)
expect_equal(NCOL(uu$data), 3)
})

test_that("name_usage name route works", {
skip_on_cran()
rte1 <- name_usage(key = 5231190, data = 'name')
rte1a <- name_usage(key = 5127291, data = 'name')
expect_is(rte1, "list")
expect_is(rte1a, "list")
expect_null(rte1$meta)
expect_null(rte1a$meta)
expect_is(rte1$data, "data.frame")
expect_is(rte1a$data, "data.frame")
})

test_that("name_usage parents route works", {
skip_on_cran()
rte2 <- name_usage(key = 5231190, data = 'parents')
rte2a <- name_usage(key = 5135783, data = 'parents')
expect_is(rte2, "list")
expect_is(rte2a, "list")
expect_null(rte2$meta)
expect_null(rte2a$meta)
expect_is(rte2$data, "data.frame")
expect_is(rte2a$data, "data.frame")
})

test_that("name_usage children route works", {
skip_on_cran()
rte3 <- name_usage(key = 5231190, data = 'children')
rte3a <- name_usage(key = 5135790, data = 'children')
expect_is(rte3, "list")
expect_is(rte3a, "list")
expect_is(rte3$meta, "data.frame")
expect_is(rte3a$meta, "data.frame")
expect_is(rte3$data, "data.frame")
expect_is(rte3a$data, "data.frame")
})

test_that("name_usage related route works", {
skip_on_cran()
rte4 <- name_usage(key = 5231190, data = 'related')
rte4a <- name_usage(key = 5135787, data = 'related')
expect_is(rte4, "list")
expect_is(rte4a, "list")
expect_null(rte4$meta)
expect_null(rte4a$meta)
expect_is(rte4$data, "data.frame")
expect_is(rte4a$data, "data.frame")
})

test_that("name_usage synonyms route works", {
skip_on_cran()
rte5 <- name_usage(key = 5231190, data = 'synonyms')
rte5a <- name_usage(key = 5135790, data = 'synonyms')
expect_is(rte5, "list")
expect_is(rte5a, "list")
expect_is(rte5$meta, "data.frame")
expect_is(rte5a$meta, "data.frame")
expect_null(rte5$data)
expect_is(rte5a$data, "data.frame")
})

test_that("name_usage descriptions route works", {
skip_on_cran()
rte6 <- name_usage(key = 5231190, data = 'descriptions')
rte6a <- name_usage(key = 5127299, data = 'descriptions')
expect_is(rte6, "list")
expect_is(rte6a, "list")
expect_is(rte6$meta, "data.frame")
expect_is(rte6a$meta, "data.frame")
expect_is(rte6$data, "data.frame")
expect_is(rte6a$data, "data.frame")
})

test_that("name_usage distributions route works", {
skip_on_cran()
rte7 <- name_usage(key = 5231190, data = 'distributions')
rte7a <- name_usage(key = 5231190, data = 'distributions')
expect_is(rte7, "list")
expect_is(rte7a, "list")
expect_is(rte7$meta, "data.frame")
expect_is(rte7a$meta, "data.frame")
expect_is(rte7$data, "data.frame")
expect_is(rte7a$data, "data.frame")
})

test_that("name_usage media route works", {
skip_on_cran()
rte8 <- name_usage(key = 5231190, data = 'media')
rte8a <- name_usage(key = 5231190, data = 'media')
expect_is(rte8, "list")
expect_is(rte8a, "list")
expect_is(rte8$meta, "data.frame")
expect_is(rte8a$meta, "data.frame")
expect_is(rte8$data, "data.frame")
expect_is(rte8a$data, "data.frame")
})

test_that("name_usage references route works", {
skip_on_cran()
rte9 <- name_usage(key = 5231190, data = 'references')
rte9a <- name_usage(key = 5231190, data = 'references')
expect_is(rte9, "list")
expect_is(rte9a, "list")
expect_is(rte9$meta, "data.frame")
expect_is(rte9a$meta, "data.frame")
expect_is(rte9$data, "data.frame")
expect_is(rte9a$data, "data.frame")
})

test_that("name_usage speciesProfiles route works", {
skip_on_cran()
rte10 <- name_usage(key = 5231190, data = 'speciesProfiles')
rte10a <- name_usage(key = 5136020, data = 'speciesProfiles')
expect_is(rte10, "list")
expect_is(rte10a, "list")
expect_is(rte10$meta, "data.frame")
expect_is(rte10a$meta, "data.frame")
expect_is(rte10$data, "data.frame")
expect_is(rte10a$data, "data.frame")
})

test_that("name_usage vernacularNames route works", {
skip_on_cran()
rte11 <- name_usage(key = 5231190, data = 'vernacularNames')
rte11a <- name_usage(key = 5136034, data = 'vernacularNames')
expect_is(rte11, "list")
expect_is(rte11a, "list")
expect_is(rte11$meta, "data.frame")
expect_is(rte11a$meta, "data.frame")
expect_is(rte11$data, "data.frame")
expect_is(rte11a$data, "data.frame")
})

test_that("name_usage typeSpecimens route works", {
skip_on_cran()
rte12 <- name_usage(key = 5231190, data = 'typeSpecimens')
rte12a <- name_usage(key = 5097652, data = 'typeSpecimens')
expect_is(rte12, "list")
expect_is(rte12a, "list")
expect_is(rte12$meta, "data.frame")
expect_is(rte12a$meta, "data.frame")
expect_null(rte12$data)
expect_is(rte12a$data, "data.frame")
})

test_that("name_usage fails correctly", {
skip_on_cran()
### Not working right now for some unknown reason
# Select many options
expect_error(name_usage(key=3119195, data=c('images','synonyms')))
### verbatim not working right now for some unknown reason
expect_error(name_usage(key = 3119195, data = 'verbatim'))
# Select many options, doesn't work
expect_error(name_usage(key = 3119195, data = c('media', 'synonyms')))
})

0 comments on commit 6caaf2f

Please sign in to comment.