v0.4.5

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 = "[email protected]", 
         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

NAMESPACE

@@ -2,14 +2,14 @@
 
 S3method(as.data.frame,CM_list)
 S3method(print,CM_df)
+S3method(print,CM_list)
 export(getDataCM)
 export(getProjectProgress)
 export(getProjectsCM)
 export(randomise)
 export(randomize)
 export(rankTricot)
 export(rmGeoIdentity)
-export(seedNeed)
 importFrom(Matrix,Diagonal)
 importFrom(RSpectra,eigs)
 importFrom(httr,RETRY)

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.
+* GitHub-only release of prototype package.

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))

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"]]
 

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)
 
 }