forked from CIP-RIU/brapi
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathba_commoncropnames.R
54 lines (51 loc) · 1.95 KB
/
ba_commoncropnames.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
#' ba_commoncropnames
#'
#' List supported crops in a database.
#'
#' @param con list, brapi connection object
#' @param rclass character, class of the object to be returned; default: "tibble"
#' , possible other values: "json"/"list"/"vector"/"data.frame"
#'
#' @return an object of class as specified by rclass with common crop names or
#' NULL
#'
#' @note Tested against: test-server
#' @note BrAPI Version: 1.2
#' @note BrAPI Status: active
#'
#' @author Reinhard Simon, Maikel Verouden
#' @references \href{https://github.com/plantbreeding/API/blob/V1.2/Specification/Crops/CommonCropNames_GET.md}{github}
#' @family brapicore
#' @example inst/examples/ex-ba_commoncropnames.R
#' @export
ba_commoncropnames <- function(con = NULL,
rclass = c("tibble", "data.frame",
"list", "json", "vector")) {
ba_check(con = con, verbose = FALSE, brapi_calls = "commoncropnames")
rclass <- match.arg(rclass)
# temporarily store the multicrop argument in omc (oldmulticrop)
omc <- con$multicrop
con$multicrop <- FALSE
brp <- get_brapi(con = con)
callurl <- paste0(brp, "commoncropnames")
# store original rclass, needed when equal to data.frame
orclass <- rclass
rclass <- df2tibble(rclass = rclass)
out <- try({
res <- brapiGET(url = callurl, con = con)
res2 <- httr::content(x = res, as = "text", encoding = "UTF-8")
out <- dat2tbl(res = res2, rclass = rclass)
if (any(class(out) %in% c("tbl_df", "data.frame"))) {
names(out)[1] <- "commonCropNames"
# out$commonCropNames <- tolower(out$commonCropNames)
}
# if (rclass == "list") out$result$data <- tolower(out$result$data )
# if (rclass == "vector") out <- tolower(out)
if (orclass == "data.frame") out <- as.data.frame(out)
class(out) <- c(class(out), "ba_crops")
out
})
# reset multicrop argument in con object to omc (oldmulticrop) value
con$multicrop <- omc
return(out)
}