We read every piece of feedback, and take your input very seriously.
To see all available qualifiers, see our documentation.
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
nest()
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] }
The text was updated successfully, but these errors were encountered:
No branches or pull requests
Here is some code that works for at least one example:
The text was updated successfully, but these errors were encountered: