diff --git a/DESCRIPTION b/DESCRIPTION index d3e76b0b6..923c91047 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -63,6 +63,7 @@ Collate: 'deprecated.R' 'dummy_function.R' 'join_key.R' + 'join_keys-append.R' 'join_keys-c.R' 'join_keys-extract.R' 'join_keys-names.R' diff --git a/NAMESPACE b/NAMESPACE index 92d44016a..f2159c7eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export("col_labels<-") export("datanames<-") export("join_keys<-") export("parents<-") +export(append_join_keys) export(cdisc_data) export(col_labels) export(col_relabel) diff --git a/R/join_keys-append.R b/R/join_keys-append.R new file mode 100644 index 000000000..ba0b708d4 --- /dev/null +++ b/R/join_keys-append.R @@ -0,0 +1,32 @@ +#' Append elements to join_keys +#' +#' This function appends elements to the join_keys slot of a teal_data object. +#' It follows the same pattern as base R's append() function. +#' +#' @param x A teal_data object +#' @param values (`join_keys`) object to append +#' @param after Integer, the position after which the elements are to be appended. +#' If negative or zero, the values are prepended to the join_keys. +#' If missing, the values are appended at the end. +#' +#' @return A teal_data object with updated join_keys +#' +#' @examples +#' data <- teal_data() +#' keys1 <- join_keys( +#' join_key("ADSL", "ADSL", "USUBJID"), +#' join_key("ADAE", "ADAE", "USUBJID"), +#' join_key("ADSL", "ADAE", c(USUBJID = "USUBJID")) +#' ) +#' data <- append_join_keys(data, keys1) +#' join_keys(data) +#' +#' @export +append_join_keys <- function(x, values, after = length(join_keys(x))) { + checkmate::assert_class(x, "teal_data") + checkmate::assert_int(after, lower = 0, upper = length(join_keys(x)), null.ok = TRUE) + checkmate::assert_class(value, "join_keys") + + join_keys(x) <- append(join_keys(x), values, after = after) + x +} diff --git a/R/teal_data-class.R b/R/teal_data-class.R index 46baa004b..0b9d6918d 100644 --- a/R/teal_data-class.R +++ b/R/teal_data-class.R @@ -35,11 +35,7 @@ setOldClass("join_keys") setClass( Class = "teal_data", contains = "qenv", - slots = c(join_keys = "join_keys", verified = "logical"), - prototype = list( - join_keys = join_keys(), - verified = logical(0) - ) + slots = c(join_keys = "join_keys", verified = "logical") ) #' It initializes the `teal_data` class @@ -50,13 +46,12 @@ setClass( setMethod( "initialize", "teal_data", - function(.Object, .xData = list(), join_keys = join_keys(), code = list(), ...) { # nolint: object_name. - # Allow .xData to be a list and convert it to an environment - if (!missing(.xData) && inherits(.xData, "list")) { - .xData <- rlang::env_clone(list2env(.xData), parent = parent.env(.GlobalEnv)) # nolint: object_name. - lockEnvironment(.xData, bindings = TRUE) - } + function(.Object, .xData, join_keys, code, ...) { # nolint: object_name. + if (missing(.xData)) .xData <- new.env() + if (missing(join_keys)) join_keys <- teal.data::join_keys() + if (missing(code)) code <- character(0L) args <- list(...) + checkmate::assert_environment(.xData) checkmate::assert_class(join_keys, "join_keys") checkmate::assert_list(args, names = "named") @@ -67,15 +62,12 @@ setMethod( if (is.language(code)) { code <- paste(lang2calls(code), collapse = "\n") } - if (length(code)) { - code <- paste(code, collapse = "\n") - } methods::callNextMethod( .Object, .xData, join_keys = join_keys, - verified = (length(args$code) == 0L && length(.xData) == 0L), + verified = (length(code) == 0L && length(.xData) == 0L), code = code2list(code), ... ) @@ -97,6 +89,7 @@ code2list <- function(code) { if (length(code) == 0) { return(list()) } + code <- paste(code, collapse = "\n") parsed_code <- parse(text = code, keep.source = TRUE) diff --git a/R/teal_data-constructor.R b/R/teal_data-constructor.R index 25a705342..2c308f723 100644 --- a/R/teal_data-constructor.R +++ b/R/teal_data-constructor.R @@ -48,13 +48,12 @@ teal_data <- function(..., if (inherits(join_keys, "join_key_set")) { join_keys <- teal.data::join_keys(join_keys) } - if (length(data_objects) > 0 && !checkmate::test_names(names(data_objects), type = "named")) { stop("Dot (`...`) arguments on `teal_data()` must be named.") } methods::new( "teal_data", - .xData = data_objects, + .xData = list2env(data_objects), code = code, join_keys = join_keys ) diff --git a/R/teal_data-show.R b/R/teal_data-show.R index 4ce54d8b8..96f10acc2 100644 --- a/R/teal_data-show.R +++ b/R/teal_data-show.R @@ -12,9 +12,9 @@ #' @export setMethod("show", signature = "teal_data", function(object) { if (object@verified) { - cat("\u2705\ufe0e", "verified teal_data object\n") + cat("\u2705\ufe0e", "code verified\n") } else { - cat("\u2716", "unverified teal_data object\n") + cat("\u2716", "code unverified\n") } methods::callNextMethod(object) invisible(object) diff --git a/man/append_join_keys.Rd b/man/append_join_keys.Rd new file mode 100644 index 000000000..d152b19db --- /dev/null +++ b/man/append_join_keys.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/join_keys-append.R +\name{append_join_keys} +\alias{append_join_keys} +\title{Append elements to join_keys} +\usage{ +append_join_keys(x, values, after = length(join_keys(x))) +} +\arguments{ +\item{x}{A teal_data object} + +\item{values}{(\code{join_keys}) object to append} + +\item{after}{Integer, the position after which the elements are to be appended. +If negative or zero, the values are prepended to the join_keys. +If missing, the values are appended at the end.} +} +\value{ +A teal_data object with updated join_keys +} +\description{ +This function appends elements to the join_keys slot of a teal_data object. +It follows the same pattern as base R's append() function. +} +\examples{ +data <- teal_data() +keys1 <- join_keys( + join_key("ADSL", "ADSL", "USUBJID"), + join_key("ADAE", "ADAE", "USUBJID"), + join_key("ADSL", "ADAE", c(USUBJID = "USUBJID")) +) +data <- append_join_keys(data, keys1) +join_keys(data)data + +}