context("BETYdb tests")
test_that("Broken Function", {
skip_on_cran()
expect_error(betydb_traits(genus = "Miscanthus", author = "Arundale", trait = "yield"))
})
test_that("BETYdb v1 API works", {
skip_on_cran()
check_betydb()
betyurl <- "https://www.betydb.org/"
priors_url <- makeurl("priors", fmt = "json", betyurl = betyurl, api_version = "v1")
expect_equal(priors_url, paste0(betyurl, "api/v1/priors.json"))
get.out <- GET(paste0(priors_url, "/?key=eI6TMmBl3IAb7v4ToWYzR0nZYY07shLiCikvT6Lv")) # Priors is a small table
expect_is(get.out, "response")
expect_match(httr::headers(get.out)$status, "OK" )
expect_match(get.out$url, betyurl)
})
test_that("table to property name matching works", {
skip_on_cran()
check_betydb()
getprop <- function(name){
txt <- betydb_http(
makeurl(name, fmt = "json", betyurl = "https://www.betydb.org/", api_version = "v1"),
args = list(limit = 1),
key = NULL,
user = NULL,
pwd = NULL)
names(jsonlite::fromJSON(txt, simplifyVector = TRUE, flatten = FALSE)$data)[[1]]
}
tablenames <- c("search", "species", "entities", "citations", "pfts")
expected_propnames <- sapply(tablenames, makepropname, api_version = "v1")
got_propnames <- sapply(tablenames, getprop)
expect_equal(got_propnames, expected_propnames)
})
test_that("Basic search works", {
skip_on_cran()
check_betydb()
acru <- betydb_search('Acer rubrum')
acru_vcmax <- betydb_search('Acer rubrum Vcmax')
expect_true(all(acru_vcmax$id %in% acru$id))
expect_equal(unique(acru_vcmax$trait), "Vcmax")
})
test_that("Credentials work", {
skip_on_cran()
check_betydb()
usrpwd <- betydb_search('Acer rubrum', user = "ropensci-traits", pwd = "ropensci")
key <- betydb_search('Acer rubrum', key = "eI6TMmBl3IAb7v4ToWYzR0nZYY07shLiCikvT6Lv")
expect_equal(usrpwd$id, key$id)
prevkey <- options(betydb_key = "NOTVALID")
on.exit(options(prevkey))
options(betydb_key = 'NOT A KEY')
expect_error(betydb_search("Acer rubrum", api_version = "v1"), "Unauthorized",
class = "error")
options(betydb_key = "eI6TMmBl3IAb7v4ToWYzR0nZYY07shLiCikvT6Lv")
optkey <- betydb_search('Acer rubrum')
expect_equal(optkey$id, key$id)
salix <- betydb_search('salix yield')
expect_gte(min(salix$access_level), 4)
## Glopnet data are restricted
expect_null(betydb_search('wright 2004'))
})
test_that("URL & version options work", {
skip_on_cran()
check_betydb()
opts <- options()
on.exit(reset_opts(opts))
options(
betydb_url = "https://www.betydb.org/",
betydb_api_version = "v0")
opt1 <- betydb_query(author = "Arundale", table = "citations")
options(betydb_url = "http://example.com/", betydb_api_version = "v1")
expect_error(betydb_query(author = "Arundale", table = "citations"),
"Not Found", class = "error")
opt2 <- betydb_query(author = "Arundale", table = "citations",
betyurl = "https://www.betydb.org/")
opt3 <- betydb_query(author = "Arundale", table = "citations",
betyurl = "https://www.betydb.org/", api_version = "v0")
expect_gt(ncol(opt2), ncol(opt3)) # new API returns more params
expect_equal(opt2$id, opt3$id) # but both should find same IDs
expect_equal(opt1, opt3)
})
test_that("betydb_query works", {
skip_on_cran()
check_betydb()
np <- betydb_query(distn = "norm", table = "priors")
expect_is(np, "data.frame")
expect_is(np$distn, "character")
expect_equal(length(unique(np$distn)), 1)
expect_equal(unique(np$distn), "norm")
np_grass <- betydb_query(distn = "norm", phylogeny = "grass", table = "priors")
expect_true(all(np_grass$id %in% np$id))
})
test_that("paging works with betydb query and search functions",{
skip_on_cran()
check_betydb()
opts <- options()
on.exit(reset_opts(opts))
options(
betydb_url = "https://www.betydb.org/",
betydb_api_version = "v1",
betydb_key = "eI6TMmBl3IAb7v4ToWYzR0nZYY07shLiCikvT6Lv",
per_call_limit = 10, # check paging without a 5000-item request
warn=-1 ## suppress warnings that we did not get all data
)
# return 200 records by default
limit_default <- betydb_query(table = "traits", progress = FALSE)
expect_equal(nrow(limit_default), 200)
# check that paging returns correct # below and above default
limit3 <- betydb_query(table = 'traits', limit = 3)
expect_equal(nrow(limit3), 3)
expect_equal(nrow(limit3), attributes(limit3)$metadata$count)
limit30 <- betydb_query(table = "traits", limit = 30, progress = FALSE)
expect_equal(nrow(limit30), 30)
expect_equal(nrow(limit30), attributes(limit30)$metadata$count)
limit401 <- betydb_query(table = 'traits', limit = 401, progress = FALSE)
expect_equal(nrow(limit401), 401)
expect_equal(nrow(limit401), attributes(limit401)$metadata$count)
})
test_that("betydb_record works", {
skip_on_cran()
check_betydb()
rec <- betydb_record(id = 10, table = "traits")
expect_is(rec, "tbl_df")
expect_is(rec$id, "integer")
expect_equal(rec$id, 10)
})
test_that("betydb_trait works", {
skip_on_cran()
check_betydb()
aa <- betydb_trait(id = 10)
expect_is(aa, "tbl_df")
expect_is(aa$id, "integer")
expect_equal(aa$id, 10)
})
test_that("betydb_specie works", {
skip_on_cran()
check_betydb()
bb <- betydb_specie(id = 1)
expect_is(bb, "tbl_df")
expect_is(bb$id, "integer")
expect_equal(bb$id, 1)
})
test_that("betydb_citation works", {
skip_on_cran()
check_betydb()
cc <- betydb_citation(id = 1)
expect_is(cc, "tbl_df")
expect_is(cc$id, "integer")
expect_equal(cc$id, 1)
})
test_that("betydb_site works", {
skip_on_cran()
check_betydb()
dd <- betydb_site(id = 795)
expect_is(dd, "tbl_df")
expect_is(dd$city, "character")
})
test_that("include_unchecked works", {
skip_on_cran()
check_betydb()
q1 <- betydb_search(query = "maple SLA")
q2 <- betydb_search(query = "maple SLA", include_unchecked = TRUE)
expect_gt(nrow(q2), nrow(q1))
expect_true(all(q1$id %in% q2$id))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.