diff --git a/NAMESPACE b/NAMESPACE index 9f078e8..67f0eb5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,12 @@ # Generated by roxygen2: do not edit by hand +S3method("$",activityInfoVariableExpression) +S3method("$",tbl_activityInfoRemoteRecords) +S3method(.DollarNames,activityInfoVariableExpression) +S3method(.DollarNames,tbl_activityInfoRemoteRecords) +S3method(activityInfoVariableExpression,activityInfoFormTree) +S3method(activityInfoVariableExpression,activityInfoVariableExpression) +S3method(activityInfoVariableExpression,character) S3method(addForm,character) S3method(addForm,default) S3method(addForm,formSchema) @@ -34,6 +41,10 @@ S3method(getDatabaseRole,character) S3method(getDatabaseRole,databaseTree) S3method(getDatabaseRoles,character) S3method(getDatabaseRoles,databaseTree) +S3method(getNextExpansions,activityInfoFormTree) +S3method(getNextExpansions,activityInfoVariableExpression) +S3method(getNextExpansions,character) +S3method(getNextExpansions,tbl_activityInfoRemoteRecords) S3method(getRecords,activityInfoFormSchema) S3method(getRecords,activityInfoFormTree) S3method(getRecords,activityInfo_tbl_df) @@ -55,6 +66,7 @@ S3method(mutate_,tbl_activityInfoRemoteRecords) S3method(nest_by,tbl_activityInfoRemoteRecords) S3method(print,activityInfoFormFieldSchema) S3method(print,activityInfoSelectOptions) +S3method(print,activityInfoVariableExpression) S3method(print,databaseTree) S3method(print,formSchema) S3method(pull,tbl_activityInfoRemoteRecords) @@ -107,6 +119,7 @@ export("%>%") export(activityInfoLogin) export(activityInfoRootUrl) export(activityInfoToken) +export(activityInfoVariableExpression) export(addDatabase) export(addDatabaseUser) export(addFilter) @@ -155,6 +168,7 @@ export(getDatabaseUsers) export(getDatabases) export(getFormSchema) export(getFormTree) +export(getNextExpansions) export(getQuantityTable) export(getRecord) export(getRecordHistory) @@ -167,6 +181,7 @@ export(migrateFieldData) export(minimalColumnStyle) export(monthFieldSchema) export(multilineFieldSchema) +export(multipleReferenceFieldSchema) export(multipleSelectFieldSchema) export(namedElementVarList) export(parameter) @@ -181,6 +196,7 @@ export(reference) export(referenceFieldSchema) export(relocateForm) export(resourcePermissions) +export(reverseReferenceFieldSchema) export(role) export(roleAssignment) export(roleFilter) @@ -293,6 +309,7 @@ importFrom(tidyselect,eval_select) importFrom(tidyselect,everything) importFrom(tidyselect,tidyselect_data_has_predicates) importFrom(tidyselect,tidyselect_data_proxy) +importFrom(utils,.DollarNames) importFrom(utils,head) importFrom(utils,lsf.str) importFrom(utils,read.table) diff --git a/R/eval.R b/R/eval.R index 77849ae..dc15d34 100644 --- a/R/eval.R +++ b/R/eval.R @@ -1,20 +1,107 @@ -#' Convert an expression using columns in a remote records into an ActivityInfo style formula +activityInfoFunctionNames <- c( + "CONCAT", + "IF", + "ISNUMBER", + "ISBLANK", + "SEARCH", + "VALUE", + "LOWER", + "TRIM", + "CONCAT", + "LEFT", + "RIGHT", + "MID", + "REGEXMATCH", + "REGEXEXTRACT", + "REGEXREPLACE", + "TEXT", + "DATE", + "YEAR", + "MONTH", + "DAY", + "YEARFRAC", + "TODAY", + "NOW", + "DATEVALUE", + "MONTHVALUE", + "WEEKVALUE", + "FORTNIGHTVALUE", + "ADDDATE", + "DAYS", + "SUM", + "ANY", + "AVERAGE", + "MAX", + "MIN", + "COUNT", + "COUNTDISTINCT", + "FIRST", + "LAST", + "TEXTJOIN", + "POWER", + "CEIL", + "FLOOR", + "COALESCE", + "GREAT_CIRCLE" +) + + + +#' Convert an expression using columns in a remote records into an ActivityInfo +#' style formula #' #' @description -#' This function attempts to convert an R expression using the columns of the -#' [activityinfo::getRecords] object into an ActivityInfo formula (as a string). +#' This function attempts to convert an R expression in the context of a +#' [activityinfo::getRecords] object into an ActivityInfo formula (as a +#' character string). +#' +#' It also supports ActivityInfo variable expressions like `[Form Field Label]` +#' written as a variable or derived from a getRecords object with $ syntax (see +#' example). +#' +#' It will check if the field/variable/column is available and whether the +#' functions used are in a list of supported functions but does no syntax +#' checking during translation. +#' +#' This function is used to implement the mutate() and filter() dplyr verbs. #' #' @param .data the remote records object fetched with getRecords(). #' @param expr the expression to convert +#' @param rootEnvironment the original caller environment where the data remote +#' records object resides +#' +#' @examples +#' \dontrun{ +#' +#' x <- getRecords(formId) +#' +#' # Filter out records where the partner organization in BeDataDriven using $ +#' x %>% +#' mutate(new_field = x$`[Partner organization]`$`[Name]`) %>% +#' filter(new_field == "BeDataDriven") +#' +#' # Create a label for use in a report that prefixes the partner name using +#' # a variable name and the CONCAT() function. +#' x %>% +#' mutate(new_field = `[Partner organization].[Name]`) %>% +#' mutate(report_label = CONCAT("Partner organization: ", new_field)) +#' +#' # Get the text of an expression +#' aiFormula <- toActivityInfoFormula(x, IF(ISBLANK(x$`[Partner organization]`), +#' "No partner specified", x$`[Partner organization]`$`[Name]`)) +#' +#' # returns "IF(ISBLANK((ce844hgm3x4xtgr5)), \"No partner specified\", +#' # (ce844hgm3x4xtgr5.c4cx7l663x4xtgr6))" +#' } #' #' @export -toActivityInfoFormula <- function(.data, expr) { - +toActivityInfoFormula <- function(.data, expr, rootEnvironment = parent.frame()) { stopifnot("tbl_activityInfoRemoteRecords" %in% class(.data)) columns <- tblColumns(.data) exprQuo <- rlang::enquo(expr) expr2 <- rlang::quo_get_expr(exprQuo) + formTree <- .data[["formTree"]] # Symbols: handle variable names if(is.symbol(expr2)) { @@ -25,33 +112,83 @@ toActivityInfoFormula <- function(.data, expr) { if(grepl(x = idVar, pattern = "^[A-Za-z_][A-Za-z0-9_]*$")) { return(idVar) } else { - #return(sprintf("[%s]", idVar)) - return(sprintf("%s", idVar)) + return(sprintf("(%s)", idVar)) + #return(sprintf("%s", idVar)) + } + } else if (exists(as.character(expr2), envir = rootEnvironment, inherits = TRUE)) { + result <- rlang::eval_tidy(expr2, env = rootEnvironment) + if (inherits(result, "activityInfoVariableExpression")&&result[["formTree"]]$root==.data[["formTree"]]$root) { + return(sprintf("(%s)",paste(c(result[["formTree"]]$root, result[["pathIds"]]), collapse = "."))) + } else if (inherits(result, "activityInfoFormulaExpression")&&attributes(result)$root==.data[["formTree"]]$root) { + return(sprintf("%s", result)) + } else { + expr2 <- deparse(rlang::eval_tidy(exprQuo)) } } else { - expr2 <- deparse(rlang::eval_tidy(exprQuo)) + pathIds <- tryCatch({ + getPathIds(formTree, as.character(expr2)) + }, error = function(e) { + NULL + }) + if (is.null(pathIds)) { + stop('Cannot evaluate: ', as.character(expr2)) + } else { + return(paste(c(formTree$root, pathIds), collapse = ".")) + } } } # Function calls if(is.call(expr2)) { fn <- as.character(expr2[[1]]) - if(fn %in% c("+", "-", "*", "/","==", "!=", ">", "<", ">=", "<=")) { + + if (fn == "$") { + result = rlang::eval_tidy(expr2, env = rootEnvironment) + if (inherits(result, "activityInfoVariableExpression")&&result[["formTree"]]$root==.data[["formTree"]]$root) { + return(sprintf("%s",paste(c(result[["formTree"]]$root, result[["pathIds"]]), collapse = "."))) + } else if (inherits(result, "activityInfoFormulaExpression")&&attributes(result)$root==.data[["formTree"]]$root) { + return(sprintf("%s", result)) + } + } else if (fn %in% activityInfoFunctionNames) { + args <- lapply(as.list(expr2)[-1], function(arg) toActivityInfoFormula(.data, !!arg, rootEnvironment = rootEnvironment)) + return(sprintf("%s(%s)", fn, paste(args, collapse = ", "))) + } else if(fn %in% c("+", "-", "*", "/","==", "!=", ">", "<", ">=", "<=", "&&", "||")) { # These binary infix operators use the same semantic and syntax in ActivityInfo - return(sprintf("(%s %s %s)", toActivityInfoFormula(.data, !!expr2[[2]]), fn, toActivityInfoFormula(.data, !!expr2[[3]]))) + return(sprintf("(%s %s %s)", + toActivityInfoFormula(.data, !!expr2[[2]], rootEnvironment = rootEnvironment), + fn, + toActivityInfoFormula(.data, !!expr2[[3]], rootEnvironment = rootEnvironment))) + } else if(fn %in% c("&", "|")) { + # These binary infix operators use a slightly modified semantic and syntax in ActivityInfo + return(sprintf("(%s %s%s %s)", + toActivityInfoFormula(.data, !!expr2[[2]], rootEnvironment = rootEnvironment), + fn, + fn, + toActivityInfoFormula(.data, !!expr2[[3]], rootEnvironment = rootEnvironment))) + } else if(fn == "!") { + return(sprintf("%s(%s)", + fn, + toActivityInfoFormula(.data, !!expr2[[2]], rootEnvironment = rootEnvironment))) + } else if(fn == "(") { + return(sprintf("(%s)", + toActivityInfoFormula(.data, !!expr2[[2]], rootEnvironment = rootEnvironment))) } else if(fn == "grepl") { # Translate a call to grepl to AI's REGEXMATCH() call <- match.call(definition = grepl, expr2) - return(sprintf("REGEXMATCH(%s, %s)", toActivityInfoFormula(.data, !!call$x), toActivityInfoFormula(.data, !!call$pattern))) + return(sprintf("REGEXMATCH(%s, %s)", + toActivityInfoFormula(.data, !!call$x, rootEnvironment = rootEnvironment), + toActivityInfoFormula(.data, !!call$pattern, rootEnvironment = rootEnvironment))) + } else if(fn == "paste0") { + args <- lapply(as.list(expr2)[-1], function(arg) toActivityInfoFormula(.data, !!arg, rootEnvironment = rootEnvironment)) + return(sprintf("%s(%s)", "CONCAT", paste(args, collapse = ", "))) } else { stop("This function is not yet supported: ", fn) - #return(deparse(rlang::eval_tidy(exprQuo, data = columns))) } } # Literals: evaluate to be sure we've got the literal. Just deparse, R and ActivityInfo use the same literal syntax # Currently to do not support lists, better to do that in the context of the handling of functions like match or %in%. - if(is.character(expr2) || is.numeric(expr2)) { + if(is.character(expr2) || is.numeric(expr2) || is.logical(expr2)) { expr2 <- rlang::eval_tidy(exprQuo) if(length(expr2) != 1) { stop(sprintf("The expression %s has a length of %d", deparse(expr2), length(expr2))) @@ -62,3 +199,390 @@ toActivityInfoFormula <- function(.data, expr) { stop(sprintf("TODO: %s", deparse(expr2))) } +parentSymbols = c("@parent", "@Parent", "Parent") + +parseActivityInfoVariable <- function(path) { + # Remove leading and trailing white spaces + path <- trimws(path) + + # Match sequences within square brackets or sequences of non-dot characters + pattern <- "\\[[^\\[\\]]*\\]|[^\\.]+" + + matches <- gregexpr(pattern, path, perl = TRUE) + components <- regmatches(path, matches)[[1]] + + # Remove only the outer square brackets for each component + components <- sapply(components, function(component) { + if (startsWith(component, "[") && endsWith(component, "]")) { + # Remove only the outermost square brackets + substring(component, 2, nchar(component) - 1) + } else { + component + } + }, USE.NAMES = FALSE) + + # Trim white space from each component + components <- trimws(components) + + components +} + +findFieldIds <- function(formTree, currentFormId, pathComponents, collectedIds = list(), depth = 0) { + if (length(pathComponents) == 0) { + return(unlist(collectedIds)) + } + + # form schema + currentForm <- formTree$forms[[currentFormId]] + if (is.null(currentForm)) { + stop(paste("Form with ID", currentFormId, "not found in form tree.")) + } + + # Get next component + currentComponent <- pathComponents[1] + names(currentComponent) <- currentFormId + remainingComponents <- pathComponents[-1] + + if (depth == 0 && currentComponent == currentFormId) { + collectedIds <- currentComponent + return(findFieldIds(formTree, currentFormId, remainingComponents, collectedIds, depth + 1)) + } + + # Search form's elements + elementFound <- FALSE + for (element in currentForm$elements) { + + fieldMatch <- + element$id == currentComponent || + (!is.null(element$code) && !is.na(element$code) && element$code == currentComponent) || + trimws(element$label) == currentComponent + + if (fieldMatch) { + elementFound <- TRUE + collectedIds <- c(collectedIds, set_names(element$id, names(currentComponent))) + + # If there are no more components, return the collected IDs + if (length(remainingComponents) == 0) { + return(unlist(collectedIds)) + } + + # If the element is a reference or subform, move to the referenced form + + refFormId <- getFieldReferenceFormId(element) + + if (!is.null(refFormId)) { + return(findFieldIds(formTree, refFormId, remainingComponents, collectedIds)) + } else { + stop(paste("Cannot traverse non-reference field", element$label)) + } + + stop(paste("Cannot traverse non-reference field", element$label)) + } + } + + if (currentComponent == '_id') { + collectedIds <- c(collectedIds, currentComponent) + if (length(remainingComponents) == 0) { + return(unlist(collectedIds)) + } else { + stop("Cannot traverse `_id` column.") + } + } + + if (currentComponent == '_lastEditTime') { + collectedIds <- c(collectedIds, currentComponent) + if (length(remainingComponents) == 0) { + return(unlist(collectedIds)) + } else { + stop("Cannot traverse `_lastEditTime` column.") + } + } + + if (!is.null(currentForm$parentFormId)&¤tComponent %in% parentSymbols) { + collectedIds <- c(collectedIds, currentComponent) + if (length(remainingComponents) == 0) { + return(unlist(collectedIds)) + } else { + return(findFieldIds(formTree, currentForm$parentFormId, remainingComponents, collectedIds)) + } + } + + # Did not match any element or form, stop with an error + stop(paste("Component", currentComponent, "not found in form", currentForm$label)) +} + +getPathIds <- function(formTree, path) { + pathComponents <- parseActivityInfoVariable(path) + rootFormId <- formTree$root + ids <- findFieldIds(formTree, rootFormId, pathComponents, collectedIds = list()) + ids +} + +pathValid <- function(formTree, path) { + tryCatch({ + getPathIds(formTree, path) + TRUE + }, error = function(e) { + FALSE + }) +} + + +#' Get next possible expansions from an ActivityInfo variable expression or form id +#' +#' @description +#' +#' A simple helper function to get the variables/columns available from a form +#' or reference field. +#' +#' @param x An ActivityInfo get records object, form id, or form tree. +#' @param path A variable expression (path) or form ID. +#' +#' @return A character vector of possible next expansions (field labels, IDs, or codes). +#' +#' @examples +#' \dontrun{ +#' +#' x <- getRecords(formId) +#' +#' # Get a list of fields available from the "Office administrator" reference +#' # form, e.g. from the Staff form +#' available_fields <- getNextExpansions(x, "[Office administrator]") +#' +#' } +#' +#' @export +getNextExpansions <- function(x, path = NULL) { + UseMethod("getNextExpansions") +} + +#' @export +getNextExpansions.character <- function(x, path = NULL) { + getNextExpansions(getFormTree(x), path) +} + +#' @export +getNextExpansions.tbl_activityInfoRemoteRecords <- function(x, path = NULL) { + getNextExpansions(x[["formTree"]], path) +} + +#' @export +getNextExpansions.activityInfoFormTree <- function(x, path = NULL) { + expr <- activityInfoVariableExpression(x, path) + getNextExpansions(expr) +} + +# do not use path argument +#' @export +getNextExpansions.activityInfoVariableExpression <- function(x, path = NULL) { + expr <- x + + formTree <- expr[["formTree"]] + + fieldIds <- expr[["pathIds"]] + formIds <- names(fieldIds) + + lastFieldId <- expr[["lastId"]] + currentFormId <- tail(formIds, n = 1) + + currentFormSchema <- formTree$forms[[currentFormId]] + + field <- NULL + for (el in currentFormSchema$elements) { + if (el$id == lastFieldId) { + field <- el + break + } + } + + if (is.null(field)) { + + if (lastFieldId %in% c("_id", "_lastEditTime")) { + return(character(0)) + } else if (!is.null(currentFormSchema$parentFormId)&&(lastFieldId %in% parentSymbols)) { + return(getFormExpansions(formSchema = formTree$forms[[currentFormSchema$parentFormId]])) + } + + stop("Cannot expand path (", expr[["currentPath"]], ") in form `", currentFormId,"`.") + } + + nextFormId <- getFieldReferenceFormId(field) + if (is.null(nextFormId)) return(character(0)) + + getFormExpansions(formSchema = formTree$forms[[nextFormId]]) +} + +getFormExpansions <- function(formSchema) { + stopifnot("Invalid form schema passed to getFormExpansions()." = "activityInfoFormSchema" %in% class(formSchema)) + + expansions <- c("_id", "_lastEditTime") + + if (!is.null(formSchema$parentFormId)) { + expansions <- c(expansions, "@parent") + } + + for (el in formSchema$elements) { + expansions <- c(expansions, el$id, sprintf("[%s]",el$label)) + if (!is.null(el$code)) { + expansions <- c(expansions, el$code) + } + } + + names(expansions) <- rep(formSchema$id, length(expansions)) + + expansions +} + +getFieldReferenceFormId <- function(field) { + stopifnot("getFieldReferenceFormId() requires an activityInfoFormFieldSchema" = "activityInfoFormFieldSchema" %in% class(field)) + if ((field$type == "multiselectreference"||field$type == "reference") && !is.null(field$typeParameters$range)) { + return(field$typeParameters$range[[1]]$formId) + } else if ((field$type == "subform"||field$type == "reversereference") && !is.null(field$typeParameters$formId)) { + return(field$typeParameters$formId) + } + return(NULL) +} + +#' An ActivityInfo variable expression +#' +#' @description +#' A helper object to get a reference to variables/columns available from a form +#' or reference field. These expressions support the $ syntax in R so that the +#' user can interactively expand reference and sub-form fields. +#' +#' This is also returned when using $ in a getRecords() object. +#' +#' @param x An ActivityInfo form id, form tree, or another ActivityInfo variable expression. +#' @param path The next valid element/name in the variable expression or the root form ID (optional). +#' +#' @export +activityInfoVariableExpression <- function(x, path = NULL) { + UseMethod("activityInfoVariableExpression") +} + +#' @export +activityInfoVariableExpression.character <- function(x, path = NULL) { + activityInfoVariableExpression(getFormTree(x), path) +} + +#' @export +activityInfoVariableExpression.activityInfoFormTree <- function(x, path = NULL) { + formTree <- x + + if (is.null(path)) { + stop("A NULL value passed as an ActivityInfo variable expression.") + } + + pathIds <- getPathIds(formTree, path) + lastId <- tail(pathIds, n = 1) + + x <- structure( + list( + "formTree" = formTree, + "currentPath" = path, + "pathIds" = pathIds, + "lastId" = lastId + ), + class = "activityInfoVariableExpression" + ) + + x[["nextExpansion"]] <- getNextExpansions(x) + + x[["activityInfoColumn"]] <- paste(c(formTree$root, pathIds), collapse = ".") + + x +} + +#' @export +activityInfoVariableExpression.activityInfoVariableExpression <- function(x, path = NULL) { + expr <- x + + if (is.null(path)) return(expr) + activityInfoVariableExpression(expr[['formTree']], path) +} + +#' @export +`$.activityInfoVariableExpression` <- function(x, name) { + nm <- as.character(substitute(name)) + + if (nm %in% base::names(x)) { + return(x[[nm]]) + } + + if (nm %in% x[["nextExpansion"]]) { + return(activityInfoVariableExpression(x, sprintf("%s.%s", x[["currentPath"]], nm))) + } + + stop("Invalid element: ", name) +} + +#' @export +print.activityInfoVariableExpression <- function(x, ...) { + expr <- x + cat("ActivityInfo variable expression\n") + cat(sprintf(" Database id: %s\n", expr[["formTree"]]$forms[[expr[["formTree"]]$root]]$databaseId)) + cat(sprintf(" Root form id: %s\n", expr[["formTree"]]$forms[[expr[["formTree"]]$root]]$id)) + cat(sprintf(" Path: %s\n", expr[["currentPath"]])) + cat(sprintf(" Id path: %s\n", expr[["activityInfoColumn"]])) + + invisible() +} + +#' @export +#' @importFrom utils .DollarNames +.DollarNames.activityInfoVariableExpression <- function(x, pattern = "") { + vars <- c(x[["nextExpansion"]]) + # Add backticks to variables needing escaping + # vars <- ifelse(grepl("[^A-Za-z0-9_.]", vars), paste0("`", vars, "`"), vars) + vars[grep(pattern, vars)] +} + +#' @export +`$.tbl_activityInfoRemoteRecords` <- function(x, name) { + nm <- as.character(substitute(name)) + + if (nm %in% base::names(x)) { + return(x[[nm]]) + } + + if (nm %in% x[['step']][['vars']]) { + expr <- tryCatch({ + activityInfoVariableExpression(x[['formTree']], x[['step']][['columns']][[nm]]) + }, + error = function(e) { + expr <- x[['step']][['columns']][[nm]] + class(expr) <- c("activityInfoFormulaExpression", class(expr)) + attr(expr, 'columnName') <- nm + attr(expr, 'root') <- x[["formTree"]]$root + return(expr) + }) + + return(expr) + } + + nextExpansion <- getFormExpansions(x[['formTree']]$forms[[x[['formTree']]$root]]) + + if (nm %in% nextExpansion) { + + return(activityInfoVariableExpression(x[['formTree']], nm)) + } + + stop("Invalid element: ", name) + + return(NULL) +} + +#' @export +.DollarNames.tbl_activityInfoRemoteRecords <- function(x, pattern = "") { + existingVars <- names(x[['step']]$vars) + nextExpansion <- getFormExpansions(x[['formTree']]$forms[[x[['formTree']]$root]]) + + # Combine existing vars and next expansions + vars <- c(existingVars, nextExpansion) + + # Apply filtering based on the provided pattern + vars[grep(pattern, vars)] +} + + + diff --git a/R/formField.R b/R/formField.R index 080c557..61ad53d 100644 --- a/R/formField.R +++ b/R/formField.R @@ -126,6 +126,10 @@ addFormFieldSchemaCustomClass <- function(e) { } else { class(e) <- c("activityInfoReferenceFieldSchema", class(e)) } + } else if (e$type == "reversereference") { + class(e) <- c("activityInfoReverseReferenceFieldSchema", class(e)) + } else if (e$type == "multiselectreference") { + class(e) <- c("activityInfoMultipleReferenceFieldSchema", class(e)) } else if (e$type == "section") { class(e) <- c("activityInfoSectionFieldSchema", class(e)) } @@ -627,6 +631,78 @@ referenceFieldSchema <- function(label, description = NULL, referencedFormId, co schema } + +#' Create a Multiple Reference field schema +#' +#' A multiple reference field is used to create a multiple select list of +#' reference records. For example, to create a field that indicates in a report +#' table, exactly which people were taking part in an activity. It will allow +#' multiple people to be selected in the field. This is a many-to-many +#' relationship +#' +#' @inheritParams formFieldSchema +#' @param referencedFormId The id of the referenced form +#' @family field schemas +#' @export +multipleReferenceFieldSchema <- function(label, description = NULL, referencedFormId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { + stopifnot("The reference form id must be a character string" = is.character(referencedFormId)&&length(referencedFormId)==1&&nchar(referencedFormId)>0) + schema <- do.call( + formFieldSchema, + args = c( + list(type = "multiselectreference"), + formFieldArgs(as.list(environment())), + list( + typeParameters = list( + "range" = list( + list( + "formId" = referencedFormId + ) + ) + ) + ) + ) + ) + + schema +} + + +#' Create a Reverse Reference field schema +#' +#' A reverse reference field is used to get records that reference the current +#' form. For example, a partner organization record could lookup and reverse +#' reference all the reports that are assigned to the partner. +#' +#' @inheritParams formFieldSchema +#' @param referencedFormId The id of the referenced form +#' @param referencedFieldId The id of the referenced field +#' @family field schemas +#' @export +reverseReferenceFieldSchema <- function(label, description = NULL, referencedFormId, referencedFieldId, code = NULL, id = cuid(), key = FALSE, required = key, hideFromEntry = FALSE, hideInTable = FALSE, relevanceRule = "", validationRule = "", reviewerOnly = FALSE) { + stopifnot("The reverse reference form id must be a character string" = is.character(referencedFormId)&&length(referencedFormId)==1&&nchar(referencedFormId)>0) + stopifnot("The reverse reference field id must be a character string" = is.character(referencedFieldId)&&length(referencedFormId)==1&&nchar(referencedFormId)>0) + schema <- do.call( + formFieldSchema, + args = c( + list(type = "reversereference"), + formFieldArgs(as.list(environment())), + list( + typeParameters = list( + "formId" = referencedFormId, + "fieldId" = referencedFieldId + ) + ) + ) + ) + + schema +} + + + + + + #' Create a Geographic Point form field schema #' #' A Geographic Point field allow users to enter a geo-location with a certain @@ -967,16 +1043,16 @@ checkFormField <- function(formSchema, schema, df = as.data.frame(formSchema)) { #' Migrate and convert the data of one form field into another #' #' With this function, the data from one form field (column) can be moved to -#' another form field and converted with a user-supplied function. +#' another form field and converted with a user-supplied R function. #' #' @rdname migrateFieldData #' @param .data remote records object of the form online #' @param from the source form field from which to get the data #' @param to the destination form field which will receive the converted data -#' @param fn the user-supplied conversion function; default is to do nothing +#' @param fn the user-supplied R conversion function; default is to do nothing #' @param idColumn the id column. The default is `_id` #' -#' @return The form field schema after the addition. This will be the form field schema from the server if changes are uploaded. +#' @return The remote records object. #' #' @importFrom rlang enquo #' @export @@ -999,5 +1075,7 @@ migrateFieldData <- function(.data, from, to, fn = function(x) x, idColumn = as. cols <- tblColumns(remoteDf %>% select(id, to)) names(df) <- cols - importRecords(formId = .data$formTree$root, data = df, recordIdColumn = "_id") + importRecords(formId = .data[["formTree"]]$root, data = df, recordIdColumn = "_id") + + return(.data) } \ No newline at end of file diff --git a/R/forms.R b/R/forms.R index d3e8c50..f53c590 100644 --- a/R/forms.R +++ b/R/forms.R @@ -84,7 +84,8 @@ print.formSchema <- function(x, ...) { #' @export as.data.frame.formSchema <- function(x, row.names = NULL, optional = FALSE, ...) { nfields <- length(x$elements) - null2na <- function(y) if (is.null(y) || !nzchar(y)) NA else y + null2na <- function(y) tryCatch({if (is.null(y) || !nzchar(y)) NA else y}, error = function(e) {return(NA)}) + ifnullna <- function(y,z) {if (is.null(y)||is.na(y)) {z} else {y}} data.frame( row.names = row.names, @@ -101,7 +102,10 @@ as.data.frame.formSchema <- function(x, row.names = NULL, optional = FALSE, ...) relevanceCondition = sapply(x$elements, function(e) null2na(e$relevanceCondition)), fieldRequired = sapply(x$elements, function(e) null2na(e$required)), key = sapply(x$elements, function(e) identical(e$key, TRUE)), - referenceFormId = sapply(x$elements, function(e) null2na(e$typeParameters$range[[1]]$formId)), + referenceFormId = sapply(x$elements, function(e) ifnullna( + null2na(e$typeParameters$range[[1]]$formId), + null2na(e$typeParameters$formId))), + referenceFieldId = sapply(x$elements, function(e) null2na(e$typeParameters$fieldId)), formula = sapply(x$elements, function(e) null2na(e$typeParameters$formula)), dataEntryVisible = sapply(x$elements, function(e) !identical(e$dataEntryVisible, FALSE)), tableVisible = sapply(x$elements, function(e) !identical(e$tableVisible, FALSE)), diff --git a/R/records.R b/R/records.R index 881b97f..e01cb06 100644 --- a/R/records.R +++ b/R/records.R @@ -470,7 +470,7 @@ getRecords.activityInfo_tbl_df <- function(form, style) { if (missing(style)) { return(x) } else { - getRecords(x$formTree, style) + getRecords(x[["formTree"]], style) } } @@ -765,9 +765,9 @@ dim.activityInfoFormTree <- function(x) { #' @export dimnames.tbl_activityInfoRemoteRecords <- function(x) { - if(!is.null(x$step$window)&&x$step$window[2]>0) { + if(!is.null(x[['step']]$window)&&x[['step']]$window[2]>0) { list( - as.character(1:x$step$window[2]), + as.character(1:x[['step']]$window[2]), unname(tblNames(x)) ) } else { @@ -780,13 +780,13 @@ dimnames.tbl_activityInfoRemoteRecords <- function(x) { #' @export dim.tbl_activityInfoRemoteRecords <- function(x) { - if (!is.null(x$step$window)) { + if (!is.null(x[['step']]$window)) { c( - min(x$step$window[2], x$totalRecords), + min(x[['step']]$window[2], x[["totalRecords"]]), length(tblNames(x)) ) } else { - c(x$totalRecords, length(tblNames(x))) + c(x[["totalRecords"]], length(tblNames(x))) } } @@ -936,7 +936,7 @@ varNames.activityInfoFormSchema <- function(x, style = defaultColumnStyle(), add #' @exportS3Method varNames tbl_activityInfoRemoteRecords varNames.tbl_activityInfoRemoteRecords <- function(x, style = NULL, addNames = TRUE) { - y <- x$step$vars + y <- x[['step']]$vars if (!addNames) { unname(y) } @@ -1173,7 +1173,10 @@ getTotalLastEditTime <- function(formTree) { df <- queryTable(formTree$root, columns = list("id"="_id", "lastEditTime" = "_lastEditTime"), asTibble = TRUE, makeNames = FALSE, window = c(0L,1L), sort=list(list(dir = "DESC", field = "_lastEditTime"))) totalRecords <- attr(df, "totalRows") } - lastEditTime <- df[[1,"lastEditTime"]] + lastEditTime <- NA + if (nrow(df)>0) { + lastEditTime <- df[[1,"lastEditTime"]] + } list(totalRecords = totalRecords, lastEditTime = lastEditTime, df = df) } @@ -1209,7 +1212,7 @@ addFilter <- function(x, formulaFilter) { if(getOption("activityinfo.verbose.requests")) message(sprintf("Adding filter: %s", formulaFilter)) - x$step <- newStep(x$step, filter = formulaFilter) + x[['step']] <- newStep(x[['step']], filter = formulaFilter) x } @@ -1226,25 +1229,25 @@ addFilter <- function(x, formulaFilter) { #' @export addSort <- function(x, sort) { checkSortList(sort) - if (!is.null(x$step$sort)) { + if (!is.null(x[['step']]$sort)) { stop("It is not possible to add more than one sorting column at the moment with addSort().") - # newSort <- x$step$sort + # newSort <- x[['step']]$sort # invisible(lapply(sort, function(y) { # newSort[[length(newSort)+1]] <<- y # })) - # x$step <- newStep(x$step, sort = newSort) + # x[['step']] <- newStep(x[['step']], sort = newSort) } else { - x$step <- newStep(x$step, sort = sort) + x[['step']] <- newStep(x[['step']], sort = sort) } x } addSelect <- function(.data, new_vars) { - new_columns <- .data$step$columns[new_vars] + new_columns <- .data[['step']]$columns[new_vars] names(new_columns) <- names(new_vars) new_vars[names(new_vars)] <- names(new_vars) - newStep(.data$step, vars = new_vars, columns = new_columns) + newStep(.data[['step']], vars = new_vars, columns = new_columns) } #' Adjust the offset and limit of a remote records object @@ -1261,20 +1264,20 @@ addSelect <- function(.data, new_vars) { #' @export adjustWindow <- function(x, offSet = 0L, limit) { stopifnot(offSet>=0&&is.integer(offSet)) - if (is.null(x$step$window)) { - oldWindow <- c(0L, as.integer(x$totalRecords)) + if (is.null(x[['step']]$window)) { + oldWindow <- c(0L, as.integer(x[["totalRecords"]])) } else { - oldWindow <- x$step$window + oldWindow <- x[['step']]$window } if(missing(limit)) { window <- c(oldWindow[1] + offSet, oldWindow[2]) - x$step <- newStep(x$step, window = window) + x[['step']] <- newStep(x[['step']], window = window) } else { stopifnot(limit>=0) stopifnot(is.integer(limit)) window <- c(oldWindow[1] + offSet, min(oldWindow[2], limit)) - x$step <- newStep(x$step, window = window) + x[['step']] <- newStep(x[['step']], window = window) } x } @@ -1290,18 +1293,18 @@ adjustWindow <- function(x, offSet = 0L, limit) { #' @export tblColumns <- function(x) { stopifnot("tbl_activityInfoRemoteRecords" %in% class(x)) - columns <- x$step$columns - columns[x$step$vars] + columns <- x[['step']]$columns + columns[x[['step']]$vars] } tblNames <- function(x) { - x$step$vars + x[['step']]$vars } tblFieldTypes <- function(x) { columns <- tblColumns(x) types <- unlist(lapply(columns, function(y) { - type <- class(x$elements[[y]])[1] + type <- class(x[["elements"]][[y]])[1] type <- sub("^activityInfo([a-zA-Z0-9]+)FieldSchema$", "\\1", type) type })) @@ -1318,7 +1321,7 @@ tblFieldTypes <- function(x) { #' @export tblSort <- function(x) { stopifnot("tbl_activityInfoRemoteRecords" %in% class(x)) - x$step$sort + x[['step']]$sort } #' Get the filter object of a remote records object @@ -1331,7 +1334,7 @@ tblSort <- function(x) { #' @export tblFilter <- function(x) { stopifnot("tbl_activityInfoRemoteRecords" %in% class(x)) - step <- x$step + step <- x[['step']] combinedFilter <- character() repeat{ @@ -1360,10 +1363,10 @@ tblFilter <- function(x) { #' @export tblWindow <- function(x, limit) { stopifnot("tbl_activityInfoRemoteRecords" %in% class(x)) - window <- x$step$window + window <- x[['step']]$window if (!missing(limit)) { if (is.null(window)) { - window <- c(0L, as.integer(x$totalRecords)) + window <- c(0L, as.integer(x[["totalRecords"]])) } window[2] <- min(window[2], limit) } @@ -1391,8 +1394,8 @@ extractSchemaFromFields <- function(x, databaseId, label, useColumnNames = FALSE codes <- character(0) - lapply(names(x$step$columns), function(colName) { - y <- x$elements[[x$step$columns[colName]]] + lapply(names(x[['step']]$columns), function(colName) { + y <- x[["elements"]][[x[['step']]$columns[colName]]] if(!is.null(y)) { y$id <- cuid() if (is.null(y$code)) { @@ -1463,7 +1466,7 @@ newStep <- function(parent, vars = parent$vars, columns = parent$columns, filter # ---- Table formatting ---- tblLabel <- function(x) { - x$formTree$forms[[x$formTree$root]]$label + x[["formTree"]]$forms[[x[["formTree"]]$root]]$label } #' @importFrom pillar tbl_format_header style_subtle align @@ -1475,10 +1478,10 @@ tbl_format_header.tbl_activityInfoRemoteRecords <- function(x, setup, ...) { columns <- tblColumns(x) named_header <- list( - "Form (id)" = sprintf("%s (%s)", tblLabel(x), x$formTree$root), - "Total form records" = x$totalRecords, - "Last edit time" = format(as.POSIXct(x$lastEditTime, origin = "1970-01-01", tz = "UTC"), "%Y-%m-%d %H:%M:%S"), - "Table fields types" = tblFieldTypes(x), + "Form (id)" = sprintf("%s (%s)", tblLabel(x), x[["formTree"]]$root), + "Total form records" = x[["totalRecords"]], + "Last edit time" = format(as.POSIXct(x[["lastEditTime"]], origin = "1970-01-01", tz = "UTC"), "%Y-%m-%d %H:%M:%S"), + "Table field types" = tblFieldTypes(x), "Table filter" = tblFilter(x), "Table sort" = tblSort(x), "Table Window" = if (is.null(window)) "No offset or limit" else sprintf("offSet: %d; Limit: %d", window[1], window[2]) @@ -1503,13 +1506,9 @@ tbl_sum.tbl_activityInfoRemoteRecords <- function(x, ...) { #' @export tbl_sum.activityInfo_tbl_df <- function(x, ...) { - c("ActivityInfo tibble" = sprintf("Remote form: %s (%s)",tblLabel(attr(x, "remoteRecords")), attr(x, "remoteRecords")$formTree$root), NextMethod()) + c("ActivityInfo tibble" = sprintf("Remote form: %s (%s)",tblLabel(attr(x, "remoteRecords")), attr(x, "remoteRecords")[["formTree"]]$root), NextMethod()) } -# select.tbl_activityInfoRemoteRecords <- function(x) { -# -# } - # ---- Source ---- @@ -1528,7 +1527,7 @@ src_activityInfo.databaseTree <- function(x) { #' @importFrom dplyr src_tbls #' @exportS3Method src_tbls src_activityInfoFormTree src_tbls.src_activityInfoFormTree <- function(x, ...) { - names(x$formTree$forms) + names(x[["formTree"]]$forms) } #' @exportS3Method src_tbls src_activityInfoDatabaseTree @@ -1567,9 +1566,41 @@ summarise.tbl_activityInfoRemoteRecords <- function(.data, ...) { #' @export #' @importFrom dplyr mutate mutate.tbl_activityInfoRemoteRecords <- function(.data, ...) { - warn_collect("mutate") - .data <- collect(.data) - mutate(.data, ...) + + exprs <- rlang::enquos(...) + caller_env <- rlang::caller_env() + + tryCatch({ + result <- lapply(exprs, function(x) { + toActivityInfoFormula(.data, !!x, rootEnvironment = caller_env) + }) + + mutatedVars <- names(result) + existingVars <- .data[['step']]$vars + + existingColumns <- .data[['step']]$columns + + newVars <- setdiff(mutatedVars, existingVars) + newColumns <- result[newVars] + + replacedVars <- mutatedVars[mutatedVars %in% existingVars] + replacedColumns <- result[replacedVars] + + unaffectedVars <- existingVars[!(existingVars %in% mutatedVars)] + unaffectedColumns <- existingColumns[unaffectedVars] + + combinedVars <- c(.data[['step']]$vars, set_names(newVars, newVars)) + combinedColumns <- c(unaffectedColumns, replacedColumns, newColumns) + + .data[['step']] <- newStep(parent = .data[['step']], vars = combinedVars, columns = combinedColumns) + + .data + }, + error = function(e) { + warn_collect("mutate", paste0("Could not convert r expression to an ActivityInfo formula so collecting data for dplyr::mutate(). ", e$message)) + .data <- collect(.data) + mutate(.data, ...) + }) } @@ -1584,15 +1615,16 @@ filter.tbl_activityInfoRemoteRecords <- function(.data, ...) { filter(.data, ...) } else { exprs <- rlang::enquos(...) + caller_env <- rlang::caller_env() tryCatch({ result <- lapply(exprs, function(x) { - toActivityInfoFormula(.data, !!x) + toActivityInfoFormula(.data, !!x, rootEnvironment = caller_env) }) addFilter(.data, paste(as.character(result, collapse = "&&"))) }, error = function(e) { - warn_collect("filter", "Could not convert r expression to an ActivityInfo formula so collecting data for dplyr::filter().") + warn_collect("filter", paste0("Could not convert r expression to an ActivityInfo formula so collecting data for dplyr::filter(). ", e$message)) .data <- collect(.data) filter(.data, ...) }) @@ -1606,7 +1638,7 @@ dplyr::filter #' @importFrom dplyr collect collect.tbl_activityInfoRemoteRecords <- function(x, ...) { newTbl <- queryTable( - x$formTree, + x[["formTree"]], columns = tblColumns(x), asTibble = TRUE, makeNames = FALSE, @@ -1630,12 +1662,88 @@ dplyr::collect #' @export select.tbl_activityInfoRemoteRecords <- function(.data, ...) { if (!is.null(tblFilter(.data))||!is.null(tblSort(.data))) warning("Using select() after a filter or sort step. Be careful not to remove a required variable from your selection.") - - loc <- tidyselect::eval_select(rlang::expr(c(...)), .data) + + # Extract variables to check against ActivityInfo variable expressions + vars <- character(0) + activityInfoVars <- character(0) + + quosToReplace <- list() + quos <- rlang::enquos(...) + quosNames <- names(quos) + + # Extract additional valid ActivityInfo variable paths with getPathIds() that are in symbols or text + for (i in seq_along(quos)) { + quo = quos[[i]] + name <- if (!is.null(quosNames[i]) && quosNames[i] != "") quosNames[i] else NULL + + var <- rlang::quo_squash(quo) + nm <- rlang::quo_name(quo) + + if (rlang::is_call(var, name = "$")||(rlang::is_symbol(var)&&exists(as.character(var), envir = parent.frame(), inherits = TRUE))) { + result <- rlang::eval_tidy(quo) + + if (inherits(result, "activityInfoVariableExpression")&&result[["formTree"]]$root==.data[["formTree"]]$root) { + fullPath <- paste(c(result[["formTree"]]$root, result[["pathIds"]]), collapse = ".") + if (!is.null(name)) { + activityInfoVars[[name]] <- fullPath + quosToReplace[[nm]] <- name + } else { + activityInfoVars[[result[["currentPath"]]]] <- fullPath + quosToReplace[[nm]] <- result[["currentPath"]] + } + } else if (inherits(result, "activityInfoFormulaExpression")&&attributes(result)$root==.data[["formTree"]]$root) { + quosToReplace[[nm]] <- attributes(result)$columnName + } + } else if (rlang::is_character(var)||rlang::is_symbol(var)) { + vars <- c(vars, set_names(as.character(var), nm)) + } + } + + existingVars <- names(.data[['step']]$vars) + missingVars <- vars[setdiff(names(vars), existingVars)] + + missingActivityInfoVars <- activityInfoVars[setdiff(names(activityInfoVars), existingVars)] + + # Extract additional valid ActivityInfo variable paths with getPathIds() that are in symbols or text + validPaths <- missingActivityInfoVars + for (var in missingVars) { + ids <- tryCatch({ + getPathIds(.data[["formTree"]], var) + }, error = function(e) { + NULL # Path is invalid + }) + if (!is.null(ids)) { + validPaths[[var]] <- paste(ids, collapse = ".") + + validPaths[[var]] %in% names(.data[["elements"]]) + + } else { + warning("Invalid ActivityInfo variable path: ", var) + } + } + + if (length(validPaths)>0) { + newVars <- c(.data[['step']]$vars, set_names(names(validPaths), names(validPaths))) + newColumns <- c(.data[['step']]$columns, validPaths) + .data[['step']] <- newStep(parent = .data[['step']], vars = newVars, columns = newColumns) + } + + # Rebuild the quosures with replacements applied + resolvedQuos <- lapply(rlang::enquos(...), function(quo) { + nm <- rlang::quo_name(quo) + if (nm %in% names(quosToReplace)) { + rlang::expr(!!rlang::sym(quosToReplace[[nm]])) + } else { + quo + } + }) + + # Use the resolved quosures in tidyselect + loc <- tidyselect::eval_select(rlang::expr(c(!!!resolvedQuos)), .data) new_vars <- set_names(colnames(.data)[loc], names(loc)) - .data$step <- addSelect(.data, new_vars) + .data[['step']] <- addSelect(.data, new_vars) .data } @@ -1649,7 +1757,7 @@ rename.tbl_activityInfoRemoteRecords <- function(.data, ...) { new_vars <- rlang::set_names(colnames(.data), colnames(.data)) names(new_vars)[loc] <- names(loc) - .data$step <- addSelect(.data, new_vars) + .data[['step']] <- addSelect(.data, new_vars) .data } @@ -1666,7 +1774,7 @@ rename_with.tbl_lazy <- function(.data, .fn, .cols = everything(), ...) { new_vars <- set_names(colnames(.data)) names(new_vars)[cols] <- .fn(new_vars[cols], ...) - .data$step <- addSelect(.data, new_vars) + .data[['step']] <- addSelect(.data, new_vars) .data } @@ -1677,7 +1785,7 @@ slice_head.tbl_activityInfoRemoteRecords <- function(.data, ..., n, prop) { if (missing(n)) { if (missing(prop)) stop("slice_head() must either be provide the number of rows n or prop.") stopifnot(prop>=0&&prop<=1) - n <- prop * .data$totalRecords + n <- prop * .data[["totalRecords"]] } head(.data, n = n) } @@ -1688,7 +1796,7 @@ slice_tail.tbl_activityInfoRemoteRecords <- function(.data, ..., n, prop) { if (missing(n)) { if (missing(prop)) stop("slice_tail() must either be provide the number of rows n or prop.") stopifnot(prop>=0&&prop<=1) - n <- prop * .data$totalRecords + n <- prop * .data[["totalRecords"]] } tail(.data, n = n) } @@ -2063,7 +2171,7 @@ head.tbl_activityInfoRemoteRecords <- function(x, n = 6L, ...) { #' @export tail.tbl_activityInfoRemoteRecords <- function(x, n = 6L, ...) { n <- as.integer(n) - adjustWindow(x, offSet = max(0L, x$step$window[2] - n), limit = n) + adjustWindow(x, offSet = max(0L, x[['step']]$window[2] - n), limit = n) } diff --git a/man/activityInfoVariableExpression.Rd b/man/activityInfoVariableExpression.Rd new file mode 100644 index 0000000..3b6324f --- /dev/null +++ b/man/activityInfoVariableExpression.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/eval.R +\name{activityInfoVariableExpression} +\alias{activityInfoVariableExpression} +\title{An ActivityInfo variable expression} +\usage{ +activityInfoVariableExpression(x, path = NULL) +} +\arguments{ +\item{x}{An ActivityInfo form id, form tree, or another ActivityInfo variable expression.} + +\item{path}{The next valid element/name in the variable expression or the root form ID (optional).} +} +\description{ +A helper object to get a reference to variables/columns available from a form +or reference field. These expressions support the $ syntax in R so that the +user can interactively expand reference and sub-form fields. + +This is also returned when using $ in a getRecords() object. +} diff --git a/man/attachmentFieldSchema.Rd b/man/attachmentFieldSchema.Rd index edc4df2..d069e3e 100644 --- a/man/attachmentFieldSchema.Rd +++ b/man/attachmentFieldSchema.Rd @@ -53,9 +53,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/barcodeFieldSchema.Rd b/man/barcodeFieldSchema.Rd index 9142ea3..da63a8f 100644 --- a/man/barcodeFieldSchema.Rd +++ b/man/barcodeFieldSchema.Rd @@ -53,9 +53,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/calculatedFieldSchema.Rd b/man/calculatedFieldSchema.Rd index 93dd850..5297443 100644 --- a/man/calculatedFieldSchema.Rd +++ b/man/calculatedFieldSchema.Rd @@ -51,9 +51,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/dateFieldSchema.Rd b/man/dateFieldSchema.Rd index 49705ae..899739f 100644 --- a/man/dateFieldSchema.Rd +++ b/man/dateFieldSchema.Rd @@ -54,9 +54,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/formFieldSchema.Rd b/man/formFieldSchema.Rd index bd729f1..9cba60d 100644 --- a/man/formFieldSchema.Rd +++ b/man/formFieldSchema.Rd @@ -61,9 +61,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/geopointFieldSchema.Rd b/man/geopointFieldSchema.Rd index 538a205..74fb295 100644 --- a/man/geopointFieldSchema.Rd +++ b/man/geopointFieldSchema.Rd @@ -68,9 +68,11 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/getNextExpansions.Rd b/man/getNextExpansions.Rd new file mode 100644 index 0000000..858565a --- /dev/null +++ b/man/getNextExpansions.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/eval.R +\name{getNextExpansions} +\alias{getNextExpansions} +\title{Get next possible expansions from an ActivityInfo variable expression or form id} +\usage{ +getNextExpansions(x, path = NULL) +} +\arguments{ +\item{x}{An ActivityInfo get records object, form id, or form tree.} + +\item{path}{A variable expression (path) or form ID.} +} +\value{ +A character vector of possible next expansions (field labels, IDs, or codes). +} +\description{ +A simple helper function to get the variables/columns available from a form +or reference field. +} +\examples{ +\dontrun{ + +x <- getRecords(formId) + +# Get a list of fields available from the "Office administrator" reference +# form, e.g. from the Staff form +available_fields <- getNextExpansions(x, "[Office administrator]") + +} + +} diff --git a/man/migrateFieldData.Rd b/man/migrateFieldData.Rd index a22ae6a..44509cc 100644 --- a/man/migrateFieldData.Rd +++ b/man/migrateFieldData.Rd @@ -19,14 +19,14 @@ migrateFieldData( \item{to}{the destination form field which will receive the converted data} -\item{fn}{the user-supplied conversion function; default is to do nothing} +\item{fn}{the user-supplied R conversion function; default is to do nothing} \item{idColumn}{the id column. The default is \verb{_id}} } \value{ -The form field schema after the addition. This will be the form field schema from the server if changes are uploaded. +The remote records object. } \description{ With this function, the data from one form field (column) can be moved to -another form field and converted with a user-supplied function. +another form field and converted with a user-supplied R function. } diff --git a/man/monthFieldSchema.Rd b/man/monthFieldSchema.Rd index 66b5d4c..ca0667a 100644 --- a/man/monthFieldSchema.Rd +++ b/man/monthFieldSchema.Rd @@ -53,9 +53,11 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{geopointFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/multilineFieldSchema.Rd b/man/multilineFieldSchema.Rd index 497faa3..21523cd 100644 --- a/man/multilineFieldSchema.Rd +++ b/man/multilineFieldSchema.Rd @@ -52,9 +52,11 @@ Other field schemas: \code{\link{formFieldSchema}()}, \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/multipleReferenceFieldSchema.Rd b/man/multipleReferenceFieldSchema.Rd new file mode 100644 index 0000000..8c8b760 --- /dev/null +++ b/man/multipleReferenceFieldSchema.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formField.R +\name{multipleReferenceFieldSchema} +\alias{multipleReferenceFieldSchema} +\title{Create a Multiple Reference field schema} +\usage{ +multipleReferenceFieldSchema( + label, + description = NULL, + referencedFormId, + code = NULL, + id = cuid(), + key = FALSE, + required = key, + hideFromEntry = FALSE, + hideInTable = FALSE, + relevanceRule = "", + validationRule = "", + reviewerOnly = FALSE +) +} +\arguments{ +\item{label}{The label of the form field} + +\item{description}{The description of the form field} + +\item{referencedFormId}{The id of the referenced form} + +\item{code}{The code name of the form field} + +\item{id}{The id of the form Field; default is to generate a new cuid} + +\item{key}{Whether the form field is a key field; default is FALSE} + +\item{required}{Whether the form field is required; default is FALSE} + +\item{hideFromEntry}{Whether the form field is hidden during data entry; default is FALSE} + +\item{hideInTable}{Whether the form field is hidden during data display; default is FALSE} + +\item{relevanceRule}{Relevance rules for the form field given as a single character string; default is ""} + +\item{validationRule}{Validation rules for the form field given as a single character string; default is ""} + +\item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} +} +\description{ +A multiple reference field is used to create a multiple select list of +reference records. For example, to create a field that indicates in a report +table, exactly which people were taking part in an activity. It will allow +multiple people to be selected in the field. This is a many-to-many +relationship +} +\seealso{ +Other field schemas: +\code{\link{attachmentFieldSchema}()}, +\code{\link{barcodeFieldSchema}()}, +\code{\link{calculatedFieldSchema}()}, +\code{\link{dateFieldSchema}()}, +\code{\link{formFieldSchema}()}, +\code{\link{geopointFieldSchema}()}, +\code{\link{monthFieldSchema}()}, +\code{\link{multilineFieldSchema}()}, +\code{\link{multipleSelectFieldSchema}()}, +\code{\link{quantityFieldSchema}()}, +\code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, +\code{\link{sectionFieldSchema}()}, +\code{\link{serialNumberFieldSchema}()}, +\code{\link{singleSelectFieldSchema}()}, +\code{\link{subformFieldSchema}()}, +\code{\link{userFieldSchema}()}, +\code{\link{weekFieldSchema}()} +} +\concept{field schemas} diff --git a/man/multipleSelectFieldSchema.Rd b/man/multipleSelectFieldSchema.Rd index ee9d1e5..d1f4a59 100644 --- a/man/multipleSelectFieldSchema.Rd +++ b/man/multipleSelectFieldSchema.Rd @@ -59,8 +59,10 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/quantityFieldSchema.Rd b/man/quantityFieldSchema.Rd index a39c00e..4988d28 100644 --- a/man/quantityFieldSchema.Rd +++ b/man/quantityFieldSchema.Rd @@ -62,8 +62,10 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/referenceFieldSchema.Rd b/man/referenceFieldSchema.Rd index 3627f73..86e58e3 100644 --- a/man/referenceFieldSchema.Rd +++ b/man/referenceFieldSchema.Rd @@ -57,8 +57,10 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/reverseReferenceFieldSchema.Rd b/man/reverseReferenceFieldSchema.Rd new file mode 100644 index 0000000..3062aa1 --- /dev/null +++ b/man/reverseReferenceFieldSchema.Rd @@ -0,0 +1,76 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formField.R +\name{reverseReferenceFieldSchema} +\alias{reverseReferenceFieldSchema} +\title{Create a Reverse Reference field schema} +\usage{ +reverseReferenceFieldSchema( + label, + description = NULL, + referencedFormId, + referencedFieldId, + code = NULL, + id = cuid(), + key = FALSE, + required = key, + hideFromEntry = FALSE, + hideInTable = FALSE, + relevanceRule = "", + validationRule = "", + reviewerOnly = FALSE +) +} +\arguments{ +\item{label}{The label of the form field} + +\item{description}{The description of the form field} + +\item{referencedFormId}{The id of the referenced form} + +\item{referencedFieldId}{The id of the referenced field} + +\item{code}{The code name of the form field} + +\item{id}{The id of the form Field; default is to generate a new cuid} + +\item{key}{Whether the form field is a key field; default is FALSE} + +\item{required}{Whether the form field is required; default is FALSE} + +\item{hideFromEntry}{Whether the form field is hidden during data entry; default is FALSE} + +\item{hideInTable}{Whether the form field is hidden during data display; default is FALSE} + +\item{relevanceRule}{Relevance rules for the form field given as a single character string; default is ""} + +\item{validationRule}{Validation rules for the form field given as a single character string; default is ""} + +\item{reviewerOnly}{Whether the form field is for reviewers only; default is FALSE} +} +\description{ +A reverse reference field is used to get records that reference the current +form. For example, a partner organization record could lookup and reverse +reference all the reports that are assigned to the partner. +} +\seealso{ +Other field schemas: +\code{\link{attachmentFieldSchema}()}, +\code{\link{barcodeFieldSchema}()}, +\code{\link{calculatedFieldSchema}()}, +\code{\link{dateFieldSchema}()}, +\code{\link{formFieldSchema}()}, +\code{\link{geopointFieldSchema}()}, +\code{\link{monthFieldSchema}()}, +\code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, +\code{\link{multipleSelectFieldSchema}()}, +\code{\link{quantityFieldSchema}()}, +\code{\link{referenceFieldSchema}()}, +\code{\link{sectionFieldSchema}()}, +\code{\link{serialNumberFieldSchema}()}, +\code{\link{singleSelectFieldSchema}()}, +\code{\link{subformFieldSchema}()}, +\code{\link{userFieldSchema}()}, +\code{\link{weekFieldSchema}()} +} +\concept{field schemas} diff --git a/man/sectionFieldSchema.Rd b/man/sectionFieldSchema.Rd index 9c32be0..74a6e88 100644 --- a/man/sectionFieldSchema.Rd +++ b/man/sectionFieldSchema.Rd @@ -26,9 +26,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, \code{\link{subformFieldSchema}()}, diff --git a/man/serialNumberFieldSchema.Rd b/man/serialNumberFieldSchema.Rd index dad1b97..e7664e4 100644 --- a/man/serialNumberFieldSchema.Rd +++ b/man/serialNumberFieldSchema.Rd @@ -52,9 +52,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, \code{\link{subformFieldSchema}()}, diff --git a/man/singleSelectFieldSchema.Rd b/man/singleSelectFieldSchema.Rd index e24e966..d7835ab 100644 --- a/man/singleSelectFieldSchema.Rd +++ b/man/singleSelectFieldSchema.Rd @@ -62,9 +62,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{subformFieldSchema}()}, diff --git a/man/subformFieldSchema.Rd b/man/subformFieldSchema.Rd index 2184aca..ac2e04b 100644 --- a/man/subformFieldSchema.Rd +++ b/man/subformFieldSchema.Rd @@ -54,9 +54,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/toActivityInfoFormula.Rd b/man/toActivityInfoFormula.Rd index 6f43771..50f6c82 100644 --- a/man/toActivityInfoFormula.Rd +++ b/man/toActivityInfoFormula.Rd @@ -2,16 +2,56 @@ % Please edit documentation in R/eval.R \name{toActivityInfoFormula} \alias{toActivityInfoFormula} -\title{Convert an expression using columns in a remote records into an ActivityInfo style formula} +\title{Convert an expression using columns in a remote records into an ActivityInfo +style formula} \usage{ -toActivityInfoFormula(.data, expr) +toActivityInfoFormula(.data, expr, rootEnvironment = parent.frame()) } \arguments{ \item{.data}{the remote records object fetched with getRecords().} \item{expr}{the expression to convert} + +\item{rootEnvironment}{the original caller environment where the data remote +records object resides} } \description{ -This function attempts to convert an R expression using the columns of the -\link{getRecords} object into an ActivityInfo formula (as a string). +This function attempts to convert an R expression in the context of a +\link{getRecords} object into an ActivityInfo formula (as a +character string). + +It also supports ActivityInfo variable expressions like \verb{[Form Field Label]} +written as a variable or derived from a getRecords object with $ syntax (see +example). + +It will check if the field/variable/column is available and whether the +functions used are in a list of supported functions but does no syntax +checking during translation. + +This function is used to implement the mutate() and filter() dplyr verbs. +} +\examples{ +\dontrun{ + +x <- getRecords(formId) + +# Filter out records where the partner organization in BeDataDriven using $ +x \%>\% + mutate(new_field = x$`[Partner organization]`$`[Name]`) \%>\% + filter(new_field == "BeDataDriven") + +# Create a label for use in a report that prefixes the partner name using +# a variable name and the CONCAT() function. +x \%>\% + mutate(new_field = `[Partner organization].[Name]`) \%>\% + mutate(report_label = CONCAT("Partner organization: ", new_field)) + +# Get the text of an expression +aiFormula <- toActivityInfoFormula(x, IF(ISBLANK(x$`[Partner organization]`), + "No partner specified", x$`[Partner organization]`$`[Name]`)) + +# returns "IF(ISBLANK((ce844hgm3x4xtgr5)), \"No partner specified\", +# (ce844hgm3x4xtgr5.c4cx7l663x4xtgr6))" +} + } diff --git a/man/userFieldSchema.Rd b/man/userFieldSchema.Rd index f230d43..5cdc4a1 100644 --- a/man/userFieldSchema.Rd +++ b/man/userFieldSchema.Rd @@ -62,9 +62,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/man/weekFieldSchema.Rd b/man/weekFieldSchema.Rd index 4d7c4cd..fdec364 100644 --- a/man/weekFieldSchema.Rd +++ b/man/weekFieldSchema.Rd @@ -56,9 +56,11 @@ Other field schemas: \code{\link{geopointFieldSchema}()}, \code{\link{monthFieldSchema}()}, \code{\link{multilineFieldSchema}()}, +\code{\link{multipleReferenceFieldSchema}()}, \code{\link{multipleSelectFieldSchema}()}, \code{\link{quantityFieldSchema}()}, \code{\link{referenceFieldSchema}()}, +\code{\link{reverseReferenceFieldSchema}()}, \code{\link{sectionFieldSchema}()}, \code{\link{serialNumberFieldSchema}()}, \code{\link{singleSelectFieldSchema}()}, diff --git a/tests/testthat/_snaps/rmdOutput/TestMessages.html b/tests/testthat/_snaps/rmdOutput/TestMessages.html index cd6002d..a7ed923 100644 --- a/tests/testthat/_snaps/rmdOutput/TestMessages.html +++ b/tests/testthat/_snaps/rmdOutput/TestMessages.html @@ -388,6 +388,14 @@

This is a test of issue #29

subform +author_reverse +reversereference + + +about_reverse +reversereference + + NA reference diff --git a/tests/testthat/test-eval.R b/tests/testthat/test-eval.R new file mode 100644 index 0000000..94896f2 --- /dev/null +++ b/tests/testthat/test-eval.R @@ -0,0 +1,112 @@ +test_that("toActivityInfoFormula() works", { + x <- getRecords( + getDatabaseResources(database$databaseId) %>% filter(label == "Person form") %>% pull(id) + ) + y <- getRecords( + getDatabaseResources(database$databaseId) %>% filter(label == "Children") %>% pull(id) + ) + + testthat::expect_equal(toActivityInfoFormula(x, `_id`),"_id") + testthat::expect_equal(toActivityInfoFormula(x, `_lastEditTime`),"_lastEditTime") + testthat::expect_equal(toActivityInfoFormula(x, `Children`),x[["step"]]$columns[["Children"]]) + testthat::expect_equal(toActivityInfoFormula(x, `[Children]`),sprintf("%s.%s", x[["formTree"]]$root, x[["step"]]$columns[["Children"]])) + testthat::expect_equal(toActivityInfoFormula(x, `[Children].[Child name]`),sprintf("%s.%s.%s", x[["formTree"]]$root, x[["step"]]$columns[["Children"]], y[["step"]]$columns[["Child name"]])) + + aIFormula <- toActivityInfoFormula(x, TEXTJOIN(",", TRUE, `[Children].NAME`)) + aIFormula2 <- toActivityInfoFormula(x, TEXTJOIN(",", TRUE, x$Children$NAME)) + + pre_df_1 <- mutate(x, children_names = TEXTJOIN(",", TRUE, x$Children$NAME)) + + df <- pre_df_1 %>% + filter(`Respondent name` == "Bob", `Respondent name` == x$`Respondent name`, `Respondent name`==`[Respondent name]`) %>% + collect() + + testthat::expect_true(nrow(df)==1) + testthat::expect_true(all(!is.na(df$children_names)&lengths(df$children_names)>0)) + + df <- x %>% + mutate( + children_names = TEXTJOIN(",", TRUE, x$Children$NAME) + ) %>% + select(starts_with("_"), children_names) %>% + collect() + + testthat::expect_true(all(!is.na(df$children_names)&lengths(df$children_names)>0)) + + df <- y %>% mutate(parent_name = y$`@parent`$NAME) %>% collect() + + testthat::expect_true(nrow(df)>1) + testthat::expect_true(all(!is.na(df$parent_name)&lengths(df$parent_name)>0)) + +}) + +test_that("$ syntax works to create variable expressions and activityInfoVariableExpression() and getNextExpansions() works", { + # these are implicit in the $ tests + # reference field + # sub-form field + # multiple reference field + # reverse reference field + + testthat::expect_no_error({ + personSchemaCopy <- getFormSchema(personFormId) + + titleFieldSchema <- textFieldSchema("Title", code = "title_field") + authorFieldSchema <- referenceFieldSchema("Author[yup!!]", code = "author_field", referencedFormId = personSchemaCopy$id) + aboutFieldSchema <- multipleReferenceFieldSchema("People referenced", code = "about_people", referencedFormId = personSchemaCopy$id) + descFieldSchema <- textFieldSchema("Description", code = "desc_field") + + entryFormSchema <- formSchema(databaseId = database$databaseId, "Journal entry") %>% + addFormField(titleFieldSchema) %>% + addFormField(authorFieldSchema) %>% + addFormField(aboutFieldSchema) %>% + addFormField(descFieldSchema) + + authorReversed <- reverseReferenceFieldSchema( + "Author (reverse reference) ------------ really long", + referencedFormId = entryFormSchema$id, + referencedFieldId = authorFieldSchema$id, + code = "author_reverse") + + aboutReversed <- reverseReferenceFieldSchema( + "People referenced (reverse reference) ------------ really long", + referencedFormId = entryFormSchema$id, + referencedFieldId = aboutFieldSchema$id, + code = "about_reverse") + + personSchemaCopy <- personSchemaCopy %>% + addFormField(authorReversed) %>% + addFormField(aboutReversed) + + dbMetadata <- addForm(databaseId = database$databaseId, schema = entryFormSchema) + dbMetadata <- updateFormSchema(schema = personSchemaCopy) + + x <- getRecords(personSchemaCopy$id) + + # with reverse reference fields + # with special characters in label using remote column expression + # with code + x$author_reverse$`[Author[yup!!]]` + x$CHILDREN$`_id` + + # with circular reference fields + x$author_reverse$author_field$CHILDREN + x$about_reverse$about_people$author_reverse$author_field + + # with multiple reference fields + x$author_reverse$about_people$CHILDREN + + # climb back up to parent + x$author_reverse$about_people$CHILDREN$`@parent`$NAME + + # using local calculated column from lazy data frame + y <- x %>% mutate(chldrn_plus_one = Children+1) + y$chldrn_plus_one + z <- collect(y) + testthat::expect_gt(nrow(z),0) + testthat::expect_gt(sum(z$chldrn_plus_one),0) + + yy <- y %>% select(y$chldrn_plus_one) %>% mutate(chldrn_plus_one2 = y$chldrn_plus_one) %>% collect() + testthat::expect_gt(nrow(yy),0) + testthat::expect_gt(sum(yy$chldrn_plus_one2),0) + }) +}) diff --git a/tests/testthat/test-formField.r b/tests/testthat/test-formField.r index 07abbff..36e8188 100644 --- a/tests/testthat/test-formField.r +++ b/tests/testthat/test-formField.r @@ -1,9 +1,6 @@ - testField <- function(fieldSchema) { testthat::expect_identical(length(class(fieldSchema)), 4L) - length(class(barcodeFieldSchema("Test"))) - databaseId = database$databaseId fmSchm <- formSchema(databaseId = databaseId, label = paste0("R form ",fieldSchema$label , " test ", cuid())) @@ -121,6 +118,14 @@ test_that("Test roundtrip of referenceFieldSchema()", { testField(referenceFieldSchema(label = "A referenceFieldSchema field", referencedFormId = "A dummy formId")) }) +test_that("Test roundtrip of reverseReferenceFieldSchema()", { + testField(reverseReferenceFieldSchema(label = "A reversedReferenceFieldSchema field", referencedFormId = "A dummy formId", referencedFieldId = "A dummy fieldId")) +}) + +test_that("Test roundtrip of multipleReferenceFieldSchema()", { + testField(multipleReferenceFieldSchema(label = "A multipleReferenceFieldSchema field to the person form", referencedFormId = personFormId)) +}) + test_that("Test roundtrip of sectionFieldSchema()", { testField(sectionFieldSchema(label = "A sectionFieldSchema field")) }) diff --git a/tests/testthat/test-forms.R b/tests/testthat/test-forms.R index f2e618e..55eec45 100644 --- a/tests/testthat/test-forms.R +++ b/tests/testthat/test-forms.R @@ -22,7 +22,7 @@ testthat::test_that("getFormSchema() and as.data.frame.formSchema() return a Sch output <- as.data.frame(output) - testthat::expect_true(inherits(output, "data.frame") & nrow(output) == 2 & ncol(output) == 17) + testthat::expect_true(inherits(output, "data.frame") & nrow(output) > 1 & ncol(output) > 10) testthat::expect_true(all(c( "databaseId", "formId", diff --git a/tests/testthat/test-records.R b/tests/testthat/test-records.R index a54052f..ee2b146 100644 --- a/tests/testthat/test-records.R +++ b/tests/testthat/test-records.R @@ -405,7 +405,7 @@ testthat::test_that("getRecords() works", { ) %>% select(-values) - names(newRef1Values) <- c("personId", person$columns[["Ref 1"]]) + names(newRef1Values) <- c("personId", person[["columns"]][["Ref 1"]]) importRecords(formId = personFormId, data = newRef1Values, recordIdColumn = "personId") diff --git a/vignettes/images/clipboard-1150423579.png b/vignettes/images/clipboard-1150423579.png new file mode 100644 index 0000000..234ad05 Binary files /dev/null and b/vignettes/images/clipboard-1150423579.png differ diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd index dd24cd6..12a1ce4 100644 --- a/vignettes/introduction.Rmd +++ b/vignettes/introduction.Rmd @@ -13,8 +13,9 @@ relatedVideos: - /support/webinars/2022-09-22-introduction-to-R-and-ActivityInfo vignette: > %\VignetteIndexEntry{Introduction to ActivityInfo and R} - %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} + %\VignetteEngine{knitr::rmarkdown} +editor_options: --- ```{r, include = FALSE} @@ -25,14 +26,9 @@ knitr::opts_chunk$set( ## Introduction -This tutorial is about the *ActivityInfo R Package* that is a client used to -access to the [ActivityInfo REST API](https://www.activityinfo.org/apidocs/index.html). -While this is an API client, names of functions and arguments are modeled more -closely to web user interface to facilitate its use. +This tutorial is about the *ActivityInfo R Package* that is a client used to access to the [ActivityInfo REST API](https://www.activityinfo.org/apidocs/index.html). While this is an API client, names of functions and arguments are modeled more closely to web user interface to facilitate its use. -With this client, you can programmatically obtain and modify your data. You can also manage users, create new -databases and forms, or define reports. Any thing else that is possible through -ActivityInfo's user interface can be automated using the API and this R package. +With this client, you can programmatically obtain and modify your data. You can also manage users, create new databases and forms, or define reports. Any thing else that is possible through ActivityInfo's user interface can be automated using the API and this R package. ## Install the R client @@ -43,22 +39,18 @@ First, you should install *ActivityInfo API R client* in your system. devtools::install_github("bedatadriven/activityinfo-R") ``` -Then, put the library call at the top of your script file. +Then, put the library call at the top of your script file. ```{r, warning=FALSE} library(activityinfo) library(dplyr) ``` -If you are using the [ActivityInfo Self-Managed Server](https://www.activityinfo.org/support/docs/self-managed/index.html), you must -provide the URL of your server using [activityInfoRootUrl](../reference/activityInfoRootUrl.html) +If you are using the [ActivityInfo Self-Managed Server](https://www.activityinfo.org/support/docs/self-managed/index.html), you must provide the URL of your server using [activityInfoRootUrl](../reference/activityInfoRootUrl.html) ## Authentication -In order to access to the *ActivityInfo API*, you must authenticate to the server -with a personal API token. You can -[generate a personal access token](https://www.activityinfo.org/support/docs/m/84880/l/1333305.html) -from the Profile Settings page in ActivityInfo. Logging in by email and password through the API is now deprecated and insecure. +In order to access to the *ActivityInfo API*, you must authenticate to the server with a personal API token. You can [generate a personal access token](https://www.activityinfo.org/support/docs/m/84880/l/1333305.html) from the Profile Settings page in ActivityInfo. Logging in by email and password through the API is now deprecated and insecure. ```{r, eval=FALSE} activityInfoToken("2d6016c9cb3be78954eb396f806a20e9") @@ -66,27 +58,22 @@ activityInfoToken("2d6016c9cb3be78954eb396f806a20e9") After the authentication process has been successfully completed, a prompt will ask if the token file named *`r basename(activityinfo:::credentialsFile)`* should be written to your home directory. Only write the file to your home directory if this is secure. Don't share or publish this token file and preserve securely as it contains your personal access token. -If you would like to avoid prompts, set `prompt = FALSE` to explicitly do this, including for Shiny server apps or non-interactive scripts. +If you would like to avoid prompts, set `prompt = FALSE` to explicitly do this, including for Shiny server apps or non-interactive scripts. + ```{r, eval=FALSE} activityInfoToken("2d6016c9cb3be78954eb396f806a20e9", prompt = FALSE) ``` ## Databases -You can list the databases that you own or have been shared with you using -[activityinfo::getDatabases]. Use the `asDf` argument to get the list -as a `data.frame`: +You can list the databases that you own or have been shared with you using [activityinfo::getDatabases]. Use the `asDf` argument to get the list as a `data.frame`: ```{r, eval=FALSE} dbList <- getDatabases() head(dbList) ``` - -In order to get details about a specific database, you can use [activityinfo::getDatabaseTree], -or [activityinfo::getDatabaseResources] to return a `data.frame` with the list -of resources in the database. "Resources" include forms, subforms, folders, -and reports. +In order to get details about a specific database, you can use [activityinfo::getDatabaseTree], or [activityinfo::getDatabaseResources] to return a `data.frame` with the list of resources in the database. "Resources" include forms, subforms, folders, and reports. ```{r} resources <- getDatabaseResources("cfcdyr0kq6ik2wmf") @@ -95,51 +82,96 @@ head(resources) ## Forms -In order to get the form or sub-form schemas that you have access to, use `getFormSchema(formId)` call, -which retrieves the the form's schema, including a list of fields in the form: - +In order to get the form or sub-form schemas that you have access to, use `getFormSchema(formId)` call, which retrieves the the form's schema, including a list of fields in the form: ```{r} schema <- getFormSchema("ceam1x8kq6ikcujg") head(schema, 4) ``` -You can find a form's ID from your browser's address bar when you have the form -page open: +You can find a form's ID from your browser's address bar when you have the form page open: ![The form id is the part following "form/"](https://www.activityinfo.org/support/screenshot/S65tNEnPlFqua.png) ## Getting records -You can get the records from an ActivityInfo form as a dplyr-compatible table. -Let's retrieve the list of projects from the [Simple 3W template](https://www.activityinfo.org/support/templates/3w.html) - +You can get the records from an ActivityInfo form as a dplyr-compatible table. Let's retrieve the list of projects from the [Simple 3W template](https://www.activityinfo.org/support/templates/3w.html) ```{r} records <- getRecords("ceam1x8kq6ikcujg") |> collect() head(records) ``` -Note that we pipe the records to [dplyr::collect], which actually retrieves -all the records from the server. +Note that we pipe the records to [dplyr::collect], which actually retrieves all the records from the server. + +For forms with tens of thousands of records, you may want to apply filtering to narrow down the results before downloading all the records from the server and select specific columns. -For forms with tens of thousands of records, you may want to apply filtering -to narrow down the results before downloading all the records from the server. -You can use the [dplyr::filter] function to apply a filter: +You can use the [dplyr::filter] function to apply a filter and the [dplyr::select] function to select columns: ```{r} unicef <- getRecords("ceam1x8kq6ikcujg", prettyColumnStyle()) |> + select(starts_with('_'), `Organization Name`) |> filter(`Organization Name` == "United Nations Childrens Fund") |> collect() ``` -This will send the filter to the server, and only download matching records. +This will send the filter and selected columns to the server, and only download matching records and fields. The select statement will include the record id and last edited time that start with the special character "\_" and the organization name. + +### Creating and using calculated columns + +The remote records can be used to select specific columns and even auto expand into reference forms or subforms. + +![](images/clipboard-1150423579.png) + +The \$ character will trigger a list potential field names. This is an example of using these field references to select columns: + +```{r} +x <- getRecords("ceam1x8kq6ikcujg") + +unicef <- x |> + select( + starts_with('_'), + `Organization Name`, + location_name_burmese = x$Location$`[Name (Burmese)]`, + location_name_en = x$Location$`[Name]` + ) |> + filter(`Organization Name` == "United Nations Childrens Fund") |> + collect() +``` + +Additionally, one can use the [dplyr::mutate] function to add calculated fields using ActivityInfo formulas and fields before downloading the data. These can be used in filters: + +```{r} +x <- getRecords("ceam1x8kq6ikcujg") + +unicef_falam <- x |> + mutate( + location_combined = + CONCAT( + "Burmese: ", x$Location$`[Name (Burmese)]`, + "; ", + "English: ", x$Location$`[Name]` + ), + location_name_burmese = x$Location$`[Name (Burmese)]`, + location_name_en = `[Location].[Name]` + ) |> + select( + starts_with('_'), + `Organization Name`, + contains("location") + ) |> + filter( + `Organization Name` == "United Nations Childrens Fund", + location_name_en == "Falam" + ) |> + collect() + +unicef$location_combined +``` ## Updating records -You can also use the R package to add, update, and import records. For single -records you can use the [activityinfo::addRecord] and [activityinfo::updateRecord] -functions: +You can also use the R package to add, update, and import records. For single records you can use the [activityinfo::addRecord] and [activityinfo::updateRecord] functions: ```{r,eval=FALSE} addRecord(formId = "cxy123", fieldValues = list( @@ -159,11 +191,9 @@ For adding or updating many records at once, you can use the [activityinfo::impo ## Adding and modifying forms -You can also add new forms and modify existing form schemas. You can add or remove -fields from a form, or add an entirely new form. +You can also add new forms and modify existing form schemas. You can add or remove fields from a form, or add an entirely new form. -The example below will add a new database, and then add a new form for a survey -to the database. +The example below will add a new database, and then add a new form for a survey to the database. ```{r, eval=FALSE} surveyDb <- addDatabase("Surveys") @@ -194,13 +224,12 @@ surveySchema <- formSchema( surveyForm <- addForm(survey) ``` + ## Managing users The R package can also be used to automate user management for a database. -For example, you could read a list of users from Active Directory or other -external source and automatically add them to an ActivityInfo database using -[activityinfo::addDatabaseUser]: +For example, you could read a list of users from Active Directory or other external source and automatically add them to an ActivityInfo database using [activityinfo::addDatabaseUser]: ```{r,eval=FALSE} @@ -211,7 +240,3 @@ addDatabaseUser( locale = "en", roleId = "admin") ``` - - - -