Skip to content

Commit

Permalink
Intermediate work
Browse files Browse the repository at this point in the history
  • Loading branch information
@billdenney
billdenney committed Feb 6, 2024
1 parent 20a7db2 commit b258f8c
Show file tree
Hide file tree
Showing 3 changed files with 98 additions and 56 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.1
Imports:
checkmate,
nlmixr2est,
rxode2 (>= 2.0.14),
targets
Expand Down
116 changes: 64 additions & 52 deletions R/tar_nlmixr.R
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,14 @@
#' Generate a set of targets for nlmixr estimation
#'
#' The targets generated will include the \code{name} as the final estimation
#' step, \code{paste(name, "object_simple", sep = "_tar_")} (e.g.
#' The targets generated will include the `name` as the final estimation step,
#' `paste(name, "object_simple", sep = "_tar_")` (e.g.
#' "pheno_tar_object_simple") as the simplified model object, and
#' \code{paste(name, "data_simple", sep = "_tar_")} (e.g. "pheno_tar_data_simple")
#' as the simplified data object.
#' `paste(name, "data_simple", sep = "_tar_")` (e.g. "pheno_tar_data_simple") as
#' the simplified data object.
#'
#' For the way that the objects are simplified, see
#' \code{\link{nlmixr_object_simplify}()} and
#' \code{\link{nlmixr_data_simplify}()}. To see how to write initial conditions
#' to work with targets, see \code{\link{nlmixr_object_simplify}()}.
#' For the way that the objects are simplified, see `nlmixr_object_simplify()`
#' and `nlmixr_data_simplify()`. To see how to write initial conditions to work
#' with targets, see `nlmixr_object_simplify()`.
#'
#' @inheritParams nlmixr2est::nlmixr
#' @inheritParams targets::tar_target
Expand Down Expand Up @@ -53,51 +52,64 @@ tar_nlmixr <- function(name, object, data, est = NULL, control = list(), table =
stop("'est' must not be null")
}
name <- targets::tar_deparse_language(substitute(name))
name_obj_simple <- paste(name, "object_simple", sep = "_tar_")
name_data_simple <- paste(name, "data_simple", sep = "_tar_")
ret <-
list(
targets::tar_target_raw(
name = name_obj_simple,
command =
substitute(
nlmixr_object_simplify(object = object),
list(object = substitute(object))
),
packages = "nlmixr2est"
),
targets::tar_target_raw(
name = name_data_simple,
command =
substitute(
nlmixr_data_simplify(object = object_simple, data = data, table = table),
list(
object_simple = as.name(name_obj_simple),
data = substitute(data),
table = substitute(table)
)
tar_nlmixr_raw(
name = name,
object = object,
data = data,
est = est,
control = control,
table = table,
object_simple_name = paste(name, "object_simple", sep = "_tar_"),
data_simple_name = paste(name, "data_simple", sep = "_tar_")
)
}

#' @describeIn tar_nlmixr An internal function to generate the targets
#' @param object_simple_name,data_simple_name target names to use for the object
#' and data
#' @export
tar_nlmixr_raw <- function(name, object, data, est, control, table, object_simple_name, data_simple_name) {
list(
targets::tar_target_raw(
name = object_simple_name,
command =
substitute(
nlmixr_object_simplify(object = object),
list(object = substitute(object))
),
packages = "nlmixr2est"
),
targets::tar_target_raw(
name = data_simple_name,
command =
substitute(
nlmixr_data_simplify(object = object_simple, data = data, table = table),
list(
object_simple = as.name(object_simple_name),
data = substitute(data),
table = substitute(table)
)
),
targets::tar_target_raw(
name = name,
command =
substitute(
nlmixr2est::nlmixr(
object = object_simple,
data = data_simple,
est = est,
control = control
),
list(
object_simple = as.name(name_obj_simple),
data_simple = as.name(name_data_simple),
est = substitute(est),
control = substitute(control),
table = substitute(table)
)
)
),
targets::tar_target_raw(
name = name,
command =
substitute(
nlmixr2est::nlmixr(
object = object_simple_name,
data = data_simple_name,
est = est,
control = control
),
packages = "nlmixr2est"
)
list(
object_simple = as.name(object_simple_name),
data_simple = as.name(name_data_simple),
est = substitute(est),
control = substitute(control),
table = substitute(table)
)
),
packages = "nlmixr2est"
)
ret
)
}
37 changes: 33 additions & 4 deletions R/tar_nlmixr_multimodel.R
View file
Original file line number Diff line number Diff line change
@@ -1,16 +1,45 @@
#' Generate a list of models based on a single dataset and estimation method
#'
#' @param ... Named arguments with the format `"Model description" =
#' modelFunction`
#' @inheritParams nlmixr2est::nlmixr
#' @inheritParams targets::tar_target
#' @return A list of targets for the model simplification, data simplification,
#' and model estimation.
#' @export
tar_nlmixr_multimodel <- function(name, data, est, control = list(), table = nlmixr2est::tableControl()) {
tar_nlmixr_multimodel <- function(name, ..., data, est, control = list(), table = nlmixr2est::tableControl()) {
if (is.null(est)) {
stop("'est' must not be null")
}
name <- targets::tar_deparse_language(substitute(name))
name_obj_simple <- paste(name, "object_simple", sep = "_tar_")
name_data_simple <- paste(name, "data_simple", sep = "_tar_")
tar_nlmixr_multimodel_parse(
name = targets::tar_deparse_language(substitute(name)),
data = data,
est = est,
control = control,
table = table
)
}

tar_nlmixr_multimodel_parse <- function(name, data, est, control, table, ...) {
args <- list(...)
checkmate::assert_named(args, type = "unique")
lapply(
X = seq_along(args),
FUN = \(idx, data) {
tar_nlmixr_multimodel_single(
name = name,
object = args[[idx]],
data = data,
description = names(args)[[idx]],
est = est,
control = control,
table = table
)
}
)
}

tar_nlmixr_multimodel_single <- function(name, object, data, description, est, control, table) {
tar_nlmixr(
)
}

0 comments on commit b258f8c

Please sign in to comment.