From 54049953af15a3d1797180be2119c31c8c9698c3 Mon Sep 17 00:00:00 2001 From: kauedesousa Date: Thu, 17 Feb 2022 20:27:04 +0100 Subject: [PATCH] v0.4.5 --- DESCRIPTION | 6 +- NAMESPACE | 2 +- NEWS.md | 4 +- R/AAA-getDataCM.R | 27 +++-- R/as.data.frame-climmob_list.R | 4 +- R/getProjectProgress.R | 151 +++++++++++++------------ R/getProjectsCM.R | 123 ++++++++++---------- R/print.R | 10 ++ R/rankTricot.R | 53 ++++----- R/rmGeoIdentity.R | 10 +- R/seedNeed.R | 62 ---------- codemeta.json | 20 +++- docs/404.html | 4 +- docs/CODE_OF_CONDUCT.html | 4 +- docs/CONTRIBUTING.html | 4 +- docs/LICENSE-text.html | 4 +- docs/articles/Overview.html | 4 +- docs/articles/index.html | 4 +- docs/authors.html | 8 +- docs/index.html | 6 +- docs/news/index.html | 10 +- docs/pkgdown.yml | 2 +- docs/reference/ClimMobTools.html | 10 +- docs/reference/getDataCM.html | 31 +++-- docs/reference/getProjectProgress.html | 49 ++++---- docs/reference/getProjectsCM.html | 40 +++---- docs/reference/index.html | 10 +- docs/reference/randomise.html | 28 ++--- docs/reference/rankTricot.html | 58 +++++----- docs/reference/rmGeoIdentity.html | 11 +- man/getDataCM.Rd | 25 ++-- man/getProjectProgress.Rd | 40 ++++--- man/getProjectsCM.Rd | 38 +++---- man/rankTricot.Rd | 54 ++++----- man/rmGeoIdentity.Rd | 7 +- man/seedNeed.Rd | 46 -------- 36 files changed, 429 insertions(+), 540 deletions(-) delete mode 100644 R/seedNeed.R delete mode 100644 man/seedNeed.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 04b06a8..1f34f54 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,15 +1,14 @@ Package: ClimMobTools Type: Package Title: API Client for the 'ClimMob' Platform -Version: 0.4.4 +Version: 0.4.5 Authors@R: c(person("Kauê", "de Sousa", email = "kaue.desousa@inn.no", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7571-7845")), person("Jacob", "van Etten", role = "aut", comment = c(ORCID = "0000-0001-7554-2558")), - person("Brandon", "Madriz", role = "ctb", - comment = "API Client implementation")) + person("Brandon", "Madriz", role = "aut")) URL: https://agrdatasci.github.io/ClimMobTools/ BugReports: https://github.com/agrdatasci/ClimMobTools/issues Description: API client for 'ClimMob', an open source software for experimental @@ -36,6 +35,7 @@ Imports: Suggests: knitr, rmarkdown, + PlackettLuce, testthat (>= 2.1.0) Language: en-GB RoxygenNote: 7.1.2 diff --git a/NAMESPACE b/NAMESPACE index 9e719d9..8845b87 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(as.data.frame,CM_list) S3method(print,CM_df) +S3method(print,CM_list) export(getDataCM) export(getProjectProgress) export(getProjectsCM) @@ -9,7 +10,6 @@ export(randomise) export(randomize) export(rankTricot) export(rmGeoIdentity) -export(seedNeed) importFrom(Matrix,Diagonal) importFrom(RSpectra,eigs) importFrom(httr,RETRY) diff --git a/NEWS.md b/NEWS.md index cd10389..177b3e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -ClimMobTools 0.4.4 (2021-02-14) +ClimMobTools 0.4.5 (2021-02-14) ========================= ### IMPROVEMENTS @@ -92,4 +92,4 @@ CliMobTools 0.2.7 CliMobTools 0.1.0 ========================= -* GitHub-only release of prototype package. \ No newline at end of file +* GitHub-only release of prototype package. diff --git a/R/AAA-getDataCM.R b/R/AAA-getDataCM.R index 3d25b77..8246bd8 100644 --- a/R/AAA-getDataCM.R +++ b/R/AAA-getDataCM.R @@ -20,26 +20,24 @@ #' \item{value}{the value for each variable} #' @details #' \code{server}: the default server is "climmob" used for clients of -#' https://climmob.net/climmob3/, other options are: +#' \url{https://climmob.net/climmob3/}, other options are: #' -#' "1000farms" for clients of https://1000farms.climmob.net/ +#' "1000farms" for clients of \url{https://1000farms.climmob.net/} #' -#' "rtb" for clients of https://rtb.climmob.net/ +#' "rtb" for clients of \url{https://rtb.climmob.net/} #' -#' @examples +#' @examplesIf interactive() #' -#' # This function will not work without an API key -#' # the user API key can be obtained once a free ClimMob account +#' # This function only works with an API key +#' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ #' -#' # my_key <- "add_your_key" -#' # my_project <- "my_climmob_project" -#' # my_userowner <- "userowner" -#' -#' # data <- getDataCM(key = my_key, -#' # project = my_project, -#' # userowner = my_userowner) +#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" #' +#' getDataCM(key = my_key, +#' project = "testmark", +#' userowner = "kauedesousa", +#' server = "testing") #' #' @seealso ClimMob website \url{https://climmob.net/} #' @importFrom httr accept_json content RETRY @@ -77,7 +75,8 @@ getDataCM <- function(key, # if not then return a warning message if (length(cmdata) < 7) { pstring <- paste0("'",project,"'") - stop("Project ", pstring, " was found but has no associated data. \n") + message("Project ", pstring, " was found but has no associated data. \n") + return(project) } class(cmdata) <- union("CM_list", class(cmdata)) diff --git a/R/as.data.frame-climmob_list.R b/R/as.data.frame-climmob_list.R index d93464b..4a38068 100644 --- a/R/as.data.frame-climmob_list.R +++ b/R/as.data.frame-climmob_list.R @@ -46,10 +46,10 @@ as.data.frame.CM_list <- function(x, has_data <- length(dat[["data"]]) > 0 - ncomp <- dat$project$project_numcom - if (isTRUE(has_data)) { + ncomp <- dat$project$project_numcom + # get the names of assessments questions assess_q <- dat[["specialfields"]] diff --git a/R/getProjectProgress.R b/R/getProjectProgress.R index 2d6cbc3..6b6f580 100644 --- a/R/getProjectProgress.R +++ b/R/getProjectProgress.R @@ -4,120 +4,121 @@ #' #' @author Kauê de Sousa #' @family GET functions -#' @param key a character for the user's application programming -#' interface (API) key -#' @param project a character with the id of one or more projects -#' @param server optional, a character to select from which server -#' the data will be retrieved. See details -#' @param ... additional arguments passed to methods. See details -#' @return A data frame with the ClimMob projects -#' \item{project_id}{the project unique id} -#' \item{name}{the project name} -#' \item{moment}{either the design, registration or data collection} -#' \item{number_obs}{number of observations collected in a given moment} -#' \item{last_activity}{last activity of the given moment} -#' +#' @inheritParams getDataCM +#' @return A list with number of submissions per assessment and +#' submissions per assessment per enumerator #' @details #' \code{server}: the default server is "climmob" used for clients of -#' https://climmob.net/climmob3/, other options are: +#' \url{https://climmob.net/climmob3/}, other options are: #' -#' "1000farms" for clients of https://1000farms.climmob.net/ +#' "1000farms" for clients of \url{https://1000farms.climmob.net/} #' -#' "rtb" for clients of https://rtb.climmob.net/ +#' "rtb" for clients of \url{https://rtb.climmob.net/} #' -#' @examples -#' # This function will not work without an API key -#' # the user API key can be obtained once a free ClimMob account +#' @examplesIf interactive() +#' # This function only works with an API key +#' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ #' -#' # my_key <- "add_your_key" -#' -#' # my_project <- "project_id" -#' -#' # getProjectProgress(my_key, my_project) +#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" +#' +#' getProjectProgress(key = my_key, +#' project = "testmark", +#' userowner = "kauedesousa", +#' server = "testing") #' #' #' @seealso ClimMob website \url{https://climmob.net/} #' @export -getProjectProgress <- function(key, project, server = "climmob3", ...){ - - dots <- list(...) +getProjectProgress <- function(key, project, userowner, server = "climmob3"){ - url <- .set_url(server, extension = "readProjects?Apikey=") + url <- .set_url(server, extension = "readDataOfProject?Body={}&Apikey={}") - dat <- httr::RETRY(verb = "GET", + dat <- httr::RETRY(verb = "GET", url = url, - query = list(Apikey = key), - httr::accept_json(), + query = list(Body = paste0('{"project_cod":"', project, '", + "user_owner":"',userowner,'"}'), + Apikey = key), + httr::accept_json(), terminate_on = c(403, 404)) - + dat <- httr::content(dat, as = "text") dat <- jsonlite::fromJSON(dat) - - progress <- dat$progress - dat <- cbind(dat, progress) - - dat <- dat[,c("project_cod","project_name", "project_cnty", - "project_regstatus","project_creationdate", - "project_numobs", "regtotal","lastreg", - "assessments")] + # check if the given project has data + # if not then return a warning message + if (length(dat) < 7) { + pstring <- paste0("'",project,"'") + message("Project ", pstring, " was found but has no associated data. \n") + return(project) + } + result <- .project_progress(dat) - p <- project %in% dat$project_cod + return(result) - if (isFALSE(p)) { - stop("Unknown project '", project, "' please check the project id with getProjectsCM() \n") - } +} + +#' Get the progress data +#' @param x a list with the climmob data +#' @noRd +.project_progress <- function(x) { - p <- which(dat$project_cod %in% project) + assess_code <- x$assessments[["code"]] + assess_name <- x$assessments[["desc"]] + assess_day <- x$assessments[["intervalindays"]] - assessments <- dat$assessments[[p]] + # run over assessments and collect number of submissions + nsubs <- data.frame(assessment = "Registration", + interval_in_days = 1, + n_entries = length(x$data$REG__submitted_by)) - newnames <- c("project_id", "name", "moment", "number_obs", "last_activity") + enumerators <- data.frame(assessment = "Registration", + table(x$data$REG__submitted_by)) - if (length(assessments) == 0) { - progress <- NULL - } + names(enumerators)[2:3] <- c("enumerator", "n_entries") - if (length(assessments) > 1) { + for (i in seq_along(assess_code)) { + + sub_i <- x$data[,paste0("ASS", assess_code[i], "__submitted_by")] + + y <- data.frame(assessment = assess_name[i], + interval_in_days = 0, + n_entries = sum(!is.na(sub_i))) - progress <- data.frame(project_id = dat[p, "project_cod"], - project_name = dat[p, "project_name"], - assessments[,c("ass_desc","submissions","lastass")]) + nsubs <- rbind(nsubs, y) - names(progress) <- newnames + if(sum(!is.na(sub_i)) > 0) { + + enum_i <- data.frame(assessment = assess_name[i], + table(sub_i)) + + names(enum_i)[2:3] <- c("enumerator", "n_entries") + + enumerators <- rbind(enumerators, enum_i) + + } } - design <- dat[p ,c("project_cod","project_name", - "project_numobs", "project_creationdate")] - - design$moment <- "Design" - - design <- design[c(1:2,5,3:4)] - - names(design) <- newnames - - regis <- dat[p ,c("project_cod","project_name", - "regtotal","lastreg")] - - regis$moment <- "Registration" + enumerators$enumerator <- as.character(enumerators$enumerator) - regis <- regis[c(1:2,5,3:4)] + nsubs$interval_in_days <- as.integer(nsubs$interval_in_days) - names(regis) <- newnames + nsubs <- nsubs[order(nsubs$interval_in_days), ] - dat <- rbind(design, regis, progress) + rownames(nsubs) <- 1:nrow(nsubs) - dat <- as.data.frame(dat, stringsAsFactors = FALSE) + class(nsubs) <- union("CM_df", class(nsubs)) + class(enumerators) <- union("CM_df", class(enumerators)) - rownames(dat) <- 1:nrow(dat) + r <- list(submissions = nsubs, + enumerators = enumerators) - class(dat) <- union("CM_df", class(dat)) + class(r) <- union("CM_list", class(r)) - return(dat) + return(r) } diff --git a/R/getProjectsCM.R b/R/getProjectsCM.R index 64cbe3e..975bc94 100644 --- a/R/getProjectsCM.R +++ b/R/getProjectsCM.R @@ -1,3 +1,45 @@ +#' Set server URL +#' This will set the server URL following the argument server +#' in the main functions +#' @param server the server name +#' @param extension a character for the extension in the API call +#' @noRd +.set_url <- function(server = "climmob3", extension = NULL){ + + other_server <- c("1000farms", "avisa", "rtb", "1000FARMS", "AVISA") + + known <- server %in% other_server + + if (known) { + + url <- paste0("https://", server, ".climmob.net/api/", extension) + + } + + if (server == "testing") { + + url <- paste0("https://", server, ".climmob.net/climmob3/api/", extension) + + } + + if (server == "climmob3") { + + url <- paste0("https://climmob.net/climmob3/api/", extension) + + } + + if (isFALSE(known) & isFALSE(server == "climmob3") & isFALSE(server == "testing")) { + + stop("You are trying to reach an unknown server, please choose between '", + paste(c("climmob", other_server), collapse = "', '"), "'\n") + + } + + return(url) + +} + + #' Get ClimMob projects #' #' Fetch the status of ClimMob projects @@ -9,38 +51,29 @@ #' @param server optional, a character to select from which server #' the data will be retrieved. See details #' @param ... additional arguments passed to methods. See details -#' @return A data frame with the ClimMob projects -#' \item{project_id}{the project unique id} -#' \item{name}{the project name} -#' \item{country}{ISO code for the country where the project was implemented} -#' \item{status}{the current status} -#' \item{creation_date}{the project's creation date} -#' \item{intended_participants}{the number of participants the project -#' intended to register} -#' \item{intended_participants}{the number of participants the project -#' intended to register} -#' \item{registered_participants}{the number of participants registered} -#' \item{last_registration_activity}{number of days since the submission -#' of the last registration} #' @details #' \code{server}: the default server is "climmob" used for clients of -#' https://climmob.net/climmob3/, other options are: +#' \url{https://climmob.net/climmob3/}, other options are: #' -#' "1000farms" for clients of https://1000farms.climmob.net/ +#' "1000farms" for clients of \url{https://1000farms.climmob.net/} #' -#' "rtb" for clients of https://rtb.climmob.net/ +#' "rtb" for clients of \url{https://rtb.climmob.net/} #' -#' @examples -#' \dontrun{ -#' # This function will not work without an API key -#' # the user API key can be obtained once a free ClimMob account +#' @return A data.frame with the variables: +#' \item{project_id}{the project's id} +#' \item{project_name}{the project's name} +#' \item{user_owner}{the account name that owns the project} +#' \item{country}{the country of project's implementation} +#' \item{status}{the current status} +#' \item{creation_date}{date where the project was created} +#' @examplesIf interactive() +#' # This function only works with an API key +#' # the API key can be obtained once a free ClimMob account #' # is created via https://climmob.net/ #' -#' # my_key <- "add_your_key" +#' my_key <- "92cec84d-44f5-4858-9ef0-bd872496311c" #' -#' # getProjectsCM(key = my_key) -#' -#' } +#' getProjectsCM(key = my_key, server = "testing") #' #' @seealso ClimMob website \url{https://climmob.net/} #' @export @@ -93,45 +126,3 @@ getProjectsCM <- function(key, server = "climmob3", ...){ -#' Set server URL -#' This will set the server URL following the argument server -#' in the main functions -#' @param server the server name -#' @param extension a character for the extension in the API call -#' @noRd -.set_url <- function(server = "climmob3", extension = NULL){ - - other_server <- c("1000farms", "avisa", "rtb") - - known <- server %in% other_server - - if (known) { - - url <- paste0("https://", server, ".climmob.net/api/", extension) - - } - - if (server == "testing") { - - url <- paste0("https://", server, ".climmob.net/climmob3/api/", extension) - - } - - if (server == "climmob3") { - - url <- paste0("https://climmob.net/climmob3/api/", extension) - - } - - if (isFALSE(known) & isFALSE(server == "climmob3") & isFALSE(server == "testing")) { - - stop("You are trying to reach an unknown server, please choose between '", - paste(c("climmob", other_server), collapse = "', '"), "'\n") - - } - - return(url) - -} - - diff --git a/R/print.R b/R/print.R index 45fe686..f15cbec 100644 --- a/R/print.R +++ b/R/print.R @@ -58,6 +58,16 @@ print.CM_df <- function(x, ...){ } +#' @method print CM_list +#' @export +print.CM_list <- function(x, ...){ + + x <- x[[1]] + + print(x) + +} + #' Tail of data frame #' #' @param x a data frame diff --git a/R/rankTricot.R b/R/rankTricot.R index e3f1bbb..8fe32b8 100644 --- a/R/rankTricot.R +++ b/R/rankTricot.R @@ -22,32 +22,33 @@ #' full.output: logical, to return a list with a "rankings", #' a "grouped_rankings" and the ordered items #' -#' @examples -#' # beans data where each observer compares 3 varieties randomly distributed -#' # from a list of 11 and additionally compares these 3 varieties -#' # with their local variety -#' # library("PlackettLuce") -#' # data("beans", package = "PlackettLuce") -#' # -#' # # first build rankings with only tricot items -#' # # and return an object of class 'rankings' -#' # R <- rankTricot(data = beans, -#' # items = c(1:3), -#' # input = c(4:5)) -#' # head(R) -#' # -#' # ############################################################ -#' # -#' # # pass the comparison with local item as an additional rankings, then -#' # # each of the 3 varieties are compared separately with the local item -#' # # and return an object of class grouped_rankings -#' # G <- rankTricot(data = beans, -#' # items = c(1:3), -#' # input = c(4:5), -#' # group = TRUE, -#' # additional.rank = beans[c(6:8)]) -#' # -#' # head(G) +#' @examplesIf interactive() +#' # beans data where each observer compares 3 varieties randomly distributed +#' # from a list of 11 and additionally compares these 3 varieties +#' # with their local variety +#' if (require("PlackettLuce")){ +#' data("beans", package = "PlackettLuce") +#' +#' # first build rankings with only tricot items +#' # and return an object of class 'rankings' +#' R <- rankTricot(data = beans, +#' items = c(1:3), +#' input = c(4:5)) +#' head(R) +#' +#' ############################################################ +#' +#' # pass the comparison with local item as an additional rankings, then +#' # each of the 3 varieties are compared separately with the local item +#' # and return an object of class grouped_rankings +#' G <- rankTricot(data = beans, +#' items = c(1:3), +#' input = c(4:5), +#' group = TRUE, +#' additional.rank = beans[c(6:8)]) +#' +#' head(G) +#' } #' #' @export rankTricot <- function(data, items, input, diff --git a/R/rmGeoIdentity.R b/R/rmGeoIdentity.R index 3481e40..e38f363 100644 --- a/R/rmGeoIdentity.R +++ b/R/rmGeoIdentity.R @@ -3,11 +3,13 @@ #' Build a buffer around the a set of geographical coordinates #' and take a random point around the buffer. The function is #' used to omit the precise location of tricot participants -#' but keeping a close distance to its agro-environment +#' but keeping a close distance to its agro-environment +#' #' @param lonlat a data.frame or matrix with geographical coordinates long lat #' @param dist numeric, buffer distance for all \var{lonlat} #' @param nQuadSegs integer, number of segments per quadrant #' @param ... further arguments passed to \code{\link[sf]{sf}} methods +#' @return A data frame with the anonymised coordinates long lat #' @examples #' xy <- matrix(c(11.097799, 60.801090, #' 11.161298, 60.804199, @@ -16,8 +18,8 @@ #' #' rmGeoIdentity(xy) #' -#' # the function handles NAs by keeping then -#' # in a logic vector to reconstruct the matrix +#' # the function also handles NAs +#' #' xy2 <- matrix(c(11.097799, 60.801090, #' NA, NA, #' 11.161298, 60.804199, @@ -76,7 +78,7 @@ rmGeoIdentity <- function(lonlat, dist = 0.015, nQuadSegs = 2L, ...){ r <- as.data.frame(r) - names(r) <- c("x", "y") + names(r) <- c("long", "lat") return(r) diff --git a/R/seedNeed.R b/R/seedNeed.R deleted file mode 100644 index 08c8dfe..0000000 --- a/R/seedNeed.R +++ /dev/null @@ -1,62 +0,0 @@ -#' Required seed amount in a tricot project -#' -#' Calculate the required amount of seeds (or other technology) required -#' for a triadic comparison of technologies (tricot) project. -#' -#' @author Kauê de Sousa -#' @param unit optional, a character specifying the metric unit used -#' @param nitems number of items tested in the project -#' @param nseeds an integer for the metric of seeds each bag receives -#' @inheritParams randomise -#' @return a dataframe with required number of seeds -#' @examples -#' -#' # allocate 0.2 kg of seeds per variety in a project with 500 -#' # participants and 14 varieties -#' seedNeed(npackages = 500, -#' ncomp = 3, -#' nitems = 14, -#' nseeds = 0.2) -#' -#' # allocate 100 seedlings per variety in a project with 400 -#' # participants, 8 varieties and 3 comparisons between varieties -#' seedNeed(npackages = 400, -#' ncomp = 3, -#' nitems = 9, -#' nseeds = 100, -#' unit = "unit") -#' @export -seedNeed <- function(npackages = 100, - ncomp = 3, nitems = 10, nseeds = 0.15, unit = "kg") { - - # number of bags in total - nbags <- npackages * ncomp - - # number of bags per item - bagsvar <- ceiling(nbags / nitems) - - # refresh nbags - nbags <- bagsvar * nitems - - # number of seeds per variety - seedsvar <- ceiling(bagsvar * nseeds) - - # number of seeds in total - seedstotal <- ceiling(seedsvar * nitems) - - namevar <- c("N bags", "Bags per variety", - "Seeds per variety", "Seeds total") - - result <- data.frame(var = namevar, - quant= c(nbags, bagsvar, seedsvar, seedstotal), - unit = c(rep("unit",2), rep(unit, 2)), - stringsAsFactors = FALSE) - - class(result) <- union("CM_df", class(result)) - - return(result) - - -} - - diff --git a/codemeta.json b/codemeta.json index 2eed7b4..2e5e414 100644 --- a/codemeta.json +++ b/codemeta.json @@ -7,7 +7,7 @@ "codeRepository": "https://agrdatasci.github.io/ClimMobTools/", "issueTracker": "https://github.com/agrdatasci/ClimMobTools/issues", "license": "https://spdx.org/licenses/MIT", - "version": "0.4.4", + "version": "0.4.5", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", @@ -27,9 +27,7 @@ "givenName": "Jacob", "familyName": "van Etten", "@id": "https://orcid.org/0000-0001-7554-2558" - } - ], - "contributor": [ + }, { "@type": "Person", "givenName": "Brandon", @@ -70,6 +68,18 @@ }, "sameAs": "https://CRAN.R-project.org/package=rmarkdown" }, + { + "@type": "SoftwareApplication", + "identifier": "PlackettLuce", + "name": "PlackettLuce", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=PlackettLuce" + }, { "@type": "SoftwareApplication", "identifier": "testthat", @@ -163,5 +173,5 @@ }, "SystemRequirements": null }, - "fileSize": "2304.323KB" + "fileSize": "2335.687KB" } diff --git a/docs/404.html b/docs/404.html index b3ebbfe..8d27528 100644 --- a/docs/404.html +++ b/docs/404.html @@ -79,7 +79,7 @@ ClimMobTools - 0.4.4 + 0.4.5 @@ -149,7 +149,7 @@

Contents