Add `nest()` verbs
billdenney opened this issue · 0 comments
billdenney commented
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]
}