Open billdenney opened 6 months ago
Here is some code that works for at least one example:
nest.PKNCAconc <- function(object, ..., .by = NULL, .key = "PKNCAconc", .names_sep = NULL) { ret_prep <- object ret_prep$formula <- formulops::modify_formula( ret_prep$formula, lapply(X = .by, FUN = as.name), replace = rep(list(NULL), length(.by)) ) # Not requiring .by to be part of the groups because the PKNCAdose object may # not have it as part of the groups # checkmate::assert_subset(.by, choices = unlist(ret_prep$columns$groups)) ret_prep$columns$groups$group_vars <- setdiff(ret_prep$columns$groups$group_vars, .by) ret_prep$columns$groups$group_analyte <- setdiff(ret_prep$columns$groups$group_analyte, .by) # tidyr::any_of is used instead of tidyr::all_of so that it can work for # PKNCAdose even when the group does not apply to the dose. data_nested <- tidyr::nest(as.data.frame(object), .by = tidyr::any_of(.by), .key = "data") data_nested[[.key]] <- rep(list(ret_prep), nrow(data_nested)) for (idx in seq_len(nrow(data_nested))) { data_nested[[.key]][[idx]]$data <- data_nested$data[[idx]] } data_nested$data <- NULL data_nested } nest.PKNCAdose <- function(object, ..., .by = NULL, .key = "PKNCAdose", .names_sep = NULL) { nest.PKNCAconc(object = object, .by = .by, .key = .key, .names_sep = .names_sep) } nest.PKNCAdata <- function(object, ..., .by = NULL, .key = "PKNCAdata", .names_sep = NULL) { intervals_nested <- tidyr::nest(object$intervals, .by = tidyr::any_of(.by), .key = "intervals") conc_nested <- tidyr::nest(object$conc, .by = .by) dose_nested <- tidyr::nest(object$dose, .by = .by) ret_concdose <- dplyr::left_join(conc_nested, dose_nested) ret <- dplyr::left_join(ret_concdose, intervals_nested) ret[[.key]] <- rep(list(object), nrow(ret)) for (idx in seq_len(nrow(ret))) { ret[[.key]][[idx]]$conc <- ret$PKNCAconc[[idx]] ret[[.key]][[idx]]$dose <- ret$PKNCAdose[[idx]] ret[[.key]][[idx]]$intervals <- ret$intervals[[idx]] } ret[, c(.by, .key), drop = FALSE] } nest.PKNCAresults <- function(object, ..., .by = NULL, .key = "PKNCAresults", .names_sep = NULL) { checkmate::assert_character(.by, any.missing = FALSE) result_nested <- tidyr::nest(as.data.frame(object), .by = .by, .key = "data_result", .names_sep = .names_sep) data_nested <- tidyr::nest(object$data, .by = .by) ret <- dplyr::left_join(result_nested, data_nested, by = .by) ret[[.key]] <- rep(list(object), nrow(ret)) for (idx in seq_len(nrow(ret))) { ret[[.key]][[idx]]$result <- ret$data_result[[idx]] ret[[.key]][[idx]]$data <- ret$PKNCAdata[[idx]] } ret ret[, c(.by, .key), drop = FALSE] }
Here is some code that works for at least one example: