diff --git a/.Rbuildignore b/.Rbuildignore index d83707bdd..bbb24eb74 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -20,3 +20,5 @@ ^dev$ ^\.posit$ ^temp$ +^codecov\.yml$ +^vignettes/\.quarto$ diff --git a/.gitignore b/.gitignore index 6c4a6a4d7..7446fbb4c 100755 --- a/.gitignore +++ b/.gitignore @@ -48,6 +48,7 @@ inst/rust/template/* # Example runs data-raw/Runs/ +data-raw/errors.xlsx inst/Examples/ diff --git a/Cargo.lock b/Cargo.lock index 3a49c26a4..8787dd928 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -1067,15 +1067,6 @@ version = "0.2.16" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" -[[package]] -name = "libmimalloc-sys" -version = "0.1.49" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6a45a52f43e1c16f667ccfe4dd8c85b7f7c204fd5e3bf46c5b0db9a5c3c0b8e9" -dependencies = [ - "cc", -] - [[package]] name = "lock_api" version = "0.4.14" @@ -1147,15 +1138,6 @@ dependencies = [ "libc", ] -[[package]] -name = "mimalloc" -version = "0.1.52" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2d4139bb28d14ad1facf21d5eb8825051b326e172d216b39f6d31df53cc97862" -dependencies = [ - "libmimalloc-sys", -] - [[package]] name = "nalgebra" version = "0.35.0" @@ -1518,7 +1500,6 @@ version = "0.1.0" dependencies = [ "anyhow", "extendr-api", - "mimalloc", "pmcore", "rayon", "tracing", diff --git a/DESCRIPTION b/DESCRIPTION index 46dceca42..9b79db58d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: Pmetrics Title: Pmetrics for Population Modeling and Simulation -Version: 3.2.6 +Version: 3.2.7 Authors@R: c( person("Michael", "Neely", , "mneely@usc.edu", role = c("aut", "cre")), person("Julián", "Otálvaro", , "juliandavid347@gmail.com", role = "aut"), diff --git a/NAMESPACE b/NAMESPACE index 922fc1179..5cb0c5763 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -69,6 +69,7 @@ export(PM_sim) export(PM_step) export(PM_tree) export(PM_tutorial) +export(PM_upgrade) export(PM_valid) export(PMbuild) export(PMcheck) @@ -157,6 +158,7 @@ export(two_comp_bolus_cl) export(two_comp_iv) export(two_comp_iv_cl) export(zBMI) +importFrom(DT,datatable) importFrom(R6,R6Class) importFrom(bslib, accordion, @@ -264,6 +266,7 @@ importFrom(graphics, segments, text ) +importFrom(magrittr,not) importFrom(parallel, clusterExport, makeCluster, @@ -304,6 +307,7 @@ importFrom(readr, importFrom(rlang, ":=", .data, + .env, set_names ) importFrom(shiny, diff --git a/R/PM_cov.R b/R/PM_cov.R index 93eb69049..51f8edfc0 100755 --- a/R/PM_cov.R +++ b/R/PM_cov.R @@ -97,8 +97,9 @@ PM_cov <- R6::R6Class( if (file.exists(file.path(path, "posterior.csv"))) { posts <- readr::read_csv(file = file.path(path, "posterior.csv"), show_col_types = FALSE) } else if (inherits(data, "PM_cov") & !is.null(data$data)) { # file not there, and already PM_cov - class(data$data) <- c("PM_cov_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_cov_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate covariate-posterior information.", @@ -110,8 +111,9 @@ PM_cov <- R6::R6Class( if (file.exists(file.path(path, "covs.csv"))) { covs <- readr::read_csv(file = file.path(path, "covs.csv"), show_col_types = FALSE) } else if (inherits(data, "PM_cov")) { # file not there, and already PM_cov - class(data$data) <- c("PM_cov_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_cov_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate covariate-posterior information.", @@ -120,7 +122,9 @@ PM_cov <- R6::R6Class( return(NULL) } - covs <- covs |> mutate(block = block + 1) + covs <- covs |> + mutate(occasion = block + 1) |> + select(-block) post_mean <- posts |> @@ -140,10 +144,10 @@ PM_cov <- R6::R6Class( dplyr::left_join(post_mean, covs, by = "id"), dplyr::left_join(post_med, covs, by = "id") ) |> - select(id, time, block, icen, everything()) + select(id, time, occasion, icen, everything()) class(res) <- c("PM_cov_data", "data.frame") - attr(res, "ncov") <- ncol(covs) - 3 # subtract id, time, block + attr(res, "ncov") <- ncol(covs) - 3 # subtract id, time, occasion return(res) } @@ -564,7 +568,7 @@ summary.PM_cov <- function(object, icen = "median", ...) { sumCov <- data |> group_by(id) |> - dplyr::summarize(across(c(-time, -block), ~ purrr::exec(icen, x = .x, na.rm = TRUE))) |> + dplyr::summarize(across(c(-time, -occasion), ~ purrr::exec(icen, x = .x, na.rm = TRUE))) |> mutate(icen = !!icen) return(sumCov) diff --git a/R/PM_cycle.R b/R/PM_cycle.R index ecff44bee..86217bb80 100755 --- a/R/PM_cycle.R +++ b/R/PM_cycle.R @@ -126,8 +126,9 @@ PM_cycle <- R6::R6Class( write.csv(raw, file.path(path, "cycles.csv"), row.names = FALSE) } } else if (inherits(data, "PM_cycle") & !is.null(data$data)) { # file not there, and already PM_cycle - class(data$data) <- c("PM_cycle_data", "list") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_cycle_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate cycle information.", @@ -153,8 +154,9 @@ PM_cycle <- R6::R6Class( ), show_col_types = FALSE ) |> filter(!is.na(obs)) } else if (inherits(data, "PM_cycle")) { # file not there, and already PM_op - class(data$data) <- c("PM_cycle_data", "list") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_cycle_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate cycle information.", @@ -167,8 +169,9 @@ PM_cycle <- R6::R6Class( if (file.exists(file.path(path, "settings.json"))) { config <- jsonlite::fromJSON(file.path(path, "settings.json")) } else if (inherits(data, "PM_cycle") & !is.null(data$data)) { # file not there, and already PM_op - class(data$data) <- c("PM_cycle_data", "list") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_cycle_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate cycle information.", diff --git a/R/PM_data.R b/R/PM_data.R index 2d758ecb5..10fc4fa6a 100755 --- a/R/PM_data.R +++ b/R/PM_data.R @@ -14,7 +14,9 @@ #' @details #' *PM_data* objects are passed to the `$fit` method of compiled [PM_model] objects to initiate a #' population analysis. The object is created by reading a delimited file in -#' the current working directory. The data will be transformed into the standard +#' the current working directory. The format of the file is detailed in the online +#' [Pmetrics in R book](https://lapkb.github.io/PM_tutorial/data.html). +#' The data will be transformed into the standard #' format which is the same for all engines, with a report of any assumptions #' that were necessary to standardize the data. [PMcheck] is called #' on the standard data to evaluate for errors. If dates and times are converted @@ -87,10 +89,10 @@ PM_data <- R6::R6Class("PM_data", ) path <- dirname(data) } else if (inherits(data, "PM_data")) { # R6 - self$data <- data$data + self$data <- PM_upgrade(data$data) path <- getwd() } else { # something else - self$data <- data + self$data <- PM_upgrade(data) path <- getwd() } @@ -315,7 +317,7 @@ PM_data <- R6::R6Class("PM_data", dataNames <- names(dataObj) standardNames <- getFixedColNames() - covNames <- dataNames[!dataNames %in% standardNames] + covNames <- dataNames[!dataNames %in% c(standardNames, "occasion")] if ("date" %in% covNames) { covNames <- covNames[-which(covNames == "date")] } @@ -427,23 +429,19 @@ PM_data <- R6::R6Class("PM_data", cat(msg) } - # Assign a block number for each id, incremented at each evid == 4 - dataObj <- dataObj |> - group_by(id) |> - mutate(block = cumsum(evid == 4)) |> - group_by(id, block) |> + # Assign an observation occasion number for each id, incremented at each EVID = 4. + dataObj <- makePMdataOccasion(dataObj) |> + group_by(id, occasion) |> arrange(time, desc(evid), .by_group = TRUE) |> ungroup() |> - select(-block) + relocate(occasion, .after = last_col()) if ("evid" %in% names(dataObj_orig)) { - dataObj_orig <- dataObj_orig |> - group_by(id) |> - mutate(block = cumsum(evid == 4)) |> - group_by(id, block) |> + dataObj_orig <- makePMdataOccasion(dataObj_orig) |> + group_by(id, occasion) |> arrange(time, desc(evid), .by_group = TRUE) |> ungroup() |> - select(-block) + select(-occasion) } else { dataObj_orig <- dataObj_orig |> arrange(id, time, out) } @@ -572,7 +570,7 @@ PMreadMatrix <- function( #' @details #' \code{PMmatrixRelTime} will convert absolute dates and times in a dataset #' into relative hours, suitable for Pmetrics analysis. Additionally, the user has -#' the option to split subjects into pseudosubjects every time a dose reset (evid=4) +#' the option to split subjects into pseudosubjects every time a dose reset (`EVID = 4`) #' is encountered. #' #' @param data The name of an R data object. @@ -593,7 +591,8 @@ PMreadMatrix <- function( #' or two digits, but time is in 24-hour format, and \emph{s} is required #' to avoid ambiguity. #' @param split If \emph{true}, \code{PMmatrixRelTime} will split every \code{id} -#' into id.block, where block is defined by a dose reset, or evid=4, +#' into pseudo-subject IDs suffixed by the observation occasion number. Occasions +#' are delimited by dose reset events (`EVID = 4`), #' e.g. \code{id} 1.1, 1.2, 1.3, 2.1, 3.1, 3.2. #' @return Returns a dataframe with columns *id, evid, relTime*. #' If \code{split}=T all evid values that were previously 4 will be converted to 1. @@ -720,8 +719,8 @@ PMmatrixRelTime <- function( } # calculate relative times - temp <- makePMmatrixBlock(temp) |> - dplyr::group_by(id, block) |> + temp <- makePMdataOccasion(temp) |> + dplyr::group_by(id, occasion) |> dplyr::mutate(relTime = (dt - dt[1]) / lubridate::dhours(1)) temp$relTime <- round(temp$relTime, 2) @@ -879,6 +878,23 @@ PMcheck <- function(data, path = ".", fix = FALSE, quiet = FALSE) { legacy <- F } + occasion_name <- names(data2)[tolower(names(data2)) == "occasion"] + if (length(occasion_name) > 0 && !source %in% c("PM_data", "list")) { + is_occasion_metadata <- identical(occasion_name, "occasion") && + all(c("id", "evid") %in% names(data2)) && + isTRUE(all.equal( + data2$occasion, + makePMdataOccasion(data2)$occasion, + check.attributes = FALSE + )) + if (!is_occasion_metadata) { + cli::cli_abort(c( + "x" = "{.field occasion} is a reserved Pmetrics data header and cannot be used as a covariate name.", + "i" = "Rename that covariate before calling {.fn PMcheck}." + )) + } + } + # check for errors err <- errcheck(data2, quiet = quiet, source = source) @@ -1084,7 +1100,7 @@ errcheck <- function(data2, quiet, source) { } } - # check that all times within a given ID block are monotonically increasing + # check that all times within a given observation occasion are monotonically increasing misorder <- NA for (i in 2:nrow(data2)) { time_diff <- suppressWarnings(tryCatch(data2$time[i] - data2$time[i - 1], error = function(e) NA)) @@ -1238,16 +1254,16 @@ errfix <- function(data2, err, quiet) { report <- c(report, paste("All covariates must have values for each subject's first event. See errors.xlsx and fix manually.")) } - # Reorder times - assume times are in correct block + # Reorder times within each observation occasion if (length(grep("FAIL", err$timeOrder$msg)) > 0) { - data2 <- makePMmatrixBlock(data2) |> - dplyr::group_by(id, block) |> + data2 <- makePMdataOccasion(data2) |> + dplyr::group_by(id, occasion) |> dplyr::arrange(time, .by_group = T) |> ungroup() |> - select(-block) + select(-occasion) if (any(data2$evid == 4)) { - report <- c(report, paste("Your dataset has EVID=4 events. Times ordered within each event block.")) + report <- c(report, paste("Your dataset has EVID=4 events. Times ordered within each observation occasion.")) } else { report <- c(report, paste("Times for each subject have been ordered.")) } @@ -1628,7 +1644,8 @@ createInstructions <- function(wb) { #' In the case of multiple outputs, `group_colors` will be used to color the lines and markers. #' @param out_names Character vector of names to label the outputs if `legend = TRUE`. These can be combined with `group_names`. #' The number must match the number of outputs in `outeq`. If missing, the default is "Output 1", "Output 2", etc. -#' @param block `r template("block")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param occasion `r template("occasion")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param tad `r template("tad")` #' @param overlay Operator to overlay all time concentration profiles in a single plot. #' The default is `TRUE`. If `FALSE`, will trellisplot subjects one at a time. Can also be @@ -1684,7 +1701,7 @@ plot.PM_data <- function( mult = 1, outeq = 1, out_names = NULL, - block = 1, + occasion = 1, tad = FALSE, overlay = TRUE, legend, @@ -1694,8 +1711,21 @@ plot.PM_data <- function( ylab = "Output", title = "", xlim, ylim, - print = TRUE, ... + print = TRUE, ..., + block = lifecycle::deprecated() ) { + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "plot.PM_data(block)", "plot.PM_data(occasion)") + occasion <- block + } + # Plot parameters --------------------------------------------------------- if (is.list(marker) && !is.null(marker$shape) && is.null(marker$symbol)) { @@ -1832,8 +1862,8 @@ plot.PM_data <- function( # Data processing --------------------------------------------------------- dat <- x$clone() # make copy of x to work with - # make blocks - dat$standard_data <- makePMmatrixBlock(dat$standard_data) + # Assign observation occasions, delimited by EVID = 4 events. + dat$standard_data <- makePMdataOccasion(dat$standard_data) # time after dose if (tad) { @@ -1843,10 +1873,10 @@ plot.PM_data <- function( # filter presub <- dat$standard_data |> - filter(outeq %in% !!outeq, block %in% !!block, evid == 0) |> + filter(.data$outeq %in% .env$outeq, .data$occasion %in% .env$occasion, .data$evid == 0) |> includeExclude(include, exclude) - show_block_label <- dplyr::n_distinct(presub$block) > 1 + show_occasion_label <- dplyr::n_distinct(presub$occasion) > 1 # ---- covariate group (drives COLOR) ------------------------------------ @@ -1897,7 +1927,7 @@ plot.PM_data <- function( parts <- parts[nchar(trimws(parts)) > 0] paste(parts, collapse = ", ") }, cov_group, outeq_group, - if (show_block_label) paste0("Block ", presub$block) else "" + if (show_occasion_label) paste0("Occasion ", presub$occasion) else "" ) }) |> ungroup() @@ -1981,7 +2011,7 @@ plot.PM_data <- function( # filter and group by id if (!is.null(pred[[1]])) { # if pred not reset to null b/c of invalid pred[[1]] predsub <- pred[[1]] |> - filter(outeq %in% !!outeq, block %in% !!block, icen == !!icen) |> + filter(.data$outeq %in% .env$outeq, .data$occasion %in% .env$occasion, .data$icen == .env$icen) |> mutate(cens = "none") |> # always none for predictions includeExclude(include, exclude) |> group_by(id) @@ -2509,6 +2539,11 @@ PMwriteMatrix <- function( data, filename, override = FALSE, version = "DEC_11", header = FALSE ) { + # Observation occasions are derived metadata and are not an engine covariate. + data <- PM_upgrade(data) + if ("occasion" %in% names(data)) { + data <- data |> dplyr::select(-occasion) + } if (!override) { err <- PMcheck(data, quiet = TRUE) if (length(grep("FAIL", err)) > 0) { @@ -2518,11 +2553,6 @@ PMwriteMatrix <- function( } else { err <- NULL } - # remove the block column if added during run - if ("block" %in% names(data)) { - data <- data |> dplyr::select(-block) - } - versionNum <- as.numeric(substr(version, 5, 7)) + switch(substr(version, 1, 3), JAN = 1, FEB = 2, diff --git a/R/PM_final.R b/R/PM_final.R index e72d31c6f..c29b80b28 100755 --- a/R/PM_final.R +++ b/R/PM_final.R @@ -233,8 +233,9 @@ PM_final <- R6::R6Class( if (file.exists(file.path(path, "theta.csv"))) { theta <- readr::read_csv(file = file.path(path, "theta.csv"), show_col_types = FALSE) } else if (inherits(data, "PM_final") & !is.null(data$data)) { # file not there, and already PM_final - class(data$data) <- c("PM_final_data", "list") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_final_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate final cycle information.", @@ -246,8 +247,9 @@ PM_final <- R6::R6Class( if (file.exists(file.path(path, "posterior.csv"))) { post <- readr::read_csv(file = file.path(path, "posterior.csv"), show_col_types = FALSE) } else if (inherits(data, "PM_final") & !is.null(data$data)) { # file not there, and already PM_final - class(data$data) <- c("PM_final_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_final_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate final cycle information.", @@ -259,8 +261,9 @@ PM_final <- R6::R6Class( if (file.exists(file.path(path, "settings.json"))) { config <- jsonlite::fromJSON(file.path(path, "settings.json")) } else if (inherits(data, "PM_final")) { # file not there, and already PM_final - class(data$data) <- c("PM_final_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_final_data", "list") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate final cycle information.", diff --git a/R/PM_op.R b/R/PM_op.R index 296233f35..68fd712e3 100755 --- a/R/PM_op.R +++ b/R/PM_op.R @@ -53,8 +53,9 @@ PM_op <- R6::R6Class( icen = NULL, #' @field outeq output equation number outeq = NULL, - #' @field block dosing block number for each subject, as defined by dose resets (evid=4). - block = NULL, + #' @field occasion Observation occasion number for each subject; occasions are + #' delimited by dose reset events (`EVID = 4`). + occasion = NULL, #' @field obsSD standard deviation of the observation based on the assay error polynomial obsSD = NULL, #' @field d prediction error, `pred` - `obs` @@ -87,7 +88,7 @@ PM_op <- R6::R6Class( self$pred.type <- op$pred.type self$icen <- op$icen self$outeq <- op$outeq - self$block <- op$block + self$occasion <- op$occasion self$obsSD <- op$obsSD self$d <- op$d self$ds <- op$ds @@ -148,11 +149,12 @@ PM_op <- R6::R6Class( op_raw <- op_raw |> mutate(cens = "none") # if cens column missing, assume all observed } } else if (inherits(data, "PM_op") & !is.null(data$data)) { # file not there, and already PM_op - if (!"cens" %in% names(data$data)) { - data$data <- data$data |> mutate(cens = "none") # if cens column missing, assume all observed + upgraded_data <- PM_upgrade(data$data) + if (!"cens" %in% names(upgraded_data)) { + upgraded_data <- upgraded_data |> mutate(cens = "none") # if cens column missing, assume all observed } - class(data$data) <- c("PM_op_data", "data.frame") - return(data$data) + class(upgraded_data) <- c("PM_op_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate obs-pred information.", @@ -165,8 +167,9 @@ PM_op <- R6::R6Class( if (file.exists(file.path(path, "settings.json"))) { config <- jsonlite::fromJSON(file.path(path, "settings.json")) } else if (inherits(data, "PM_op")) { # file not there, and already PM_op - class(data$data) <- c("PM_op_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_op_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate obs-pred information.", @@ -212,7 +215,8 @@ PM_op <- R6::R6Class( select(-name) |> dplyr::rename(pred = value) |> dplyr::mutate(outeq = normalize_engine_index(outeq)) |> - dplyr::mutate(block = block + 1) |> + dplyr::mutate(occasion = block + 1) |> + dplyr::select(-block) |> # dplyr::mutate(obs = dplyr::na_if(obs, -99)) |> # obsolete dplyr::rowwise() |> mutate(d = pred - obs) |> @@ -257,7 +261,8 @@ PM_op <- R6::R6Class( #' @param icen `r template("icen")` #' @param pred.type Either 'post' for a posterior object or 'pop' for a population object. Default is 'post'. #' @param outeq `r template("outeq")` -#' @param block `r template("block")` Default is missing, which results in all blocks included. +#' @param occasion `r template("occasion")` Default is missing, which results in all occasions included. +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param marker `r template("marker")` Default is #' `marker = list(color = orange, shape = "circle", size = 10, opacity = 0.5, line = list(color = black, width = 1))`. #' The color of any BLQ points is set to a color 90 degrees different on the color wheel from the @@ -342,7 +347,7 @@ plot.PM_op <- function( line = list(lm = NULL, loess = NULL, ref = NULL), marker = TRUE, resid = FALSE, - icen = "median", pred.type = "post", outeq = 1, block, + icen = "median", pred.type = "post", outeq = 1, occasion, include, exclude, mult = 1, legend, @@ -352,17 +357,31 @@ plot.PM_op <- function( title, stats = TRUE, print = TRUE, - xlim, ylim, ... + xlim, ylim, ..., + block = lifecycle::deprecated() ) { + occasion_supplied <- !missing(occasion) + if (inherits(x, "PM_op")) { x <- x$data } + x <- PM_upgrade(x) # include/exclude if (missing(include)) include <- unique(x$id) if (missing(exclude)) exclude <- NULL - if (missing(block)) { - block <- unique(x$block) + if (!occasion_supplied) { + occasion <- unique(x$occasion) + } + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "plot.PM_op(block)", "plot.PM_op(occasion)") + occasion <- block } if (max(outeq) > max(x$outeq)) { @@ -371,16 +390,16 @@ plot.PM_op <- function( "i" = "Choose {max(x$outeq)} or fewer for {.code outeq}." )) } - if (max(block) > max(x$block)) { + if (max(occasion) > max(x$occasion)) { cli::cli_abort(c( - "x" = "{.cls PM_op} object does not have {block} blocks.", - "i" = "Choose {max(x$block)} or fewer for {.code block}." + "x" = "{.cls PM_op} object does not have occasion {occasion}.", + "i" = "Choose {max(x$occasion)} or fewer for {.arg occasion}." )) } sub1 <- x |> dplyr::filter( icen == !!icen, outeq %in% !!outeq, pred.type == !!pred.type, - block %in% !!block + .data$occasion %in% .env$occasion ) |> includeExclude(include, exclude) |> dplyr::filter(!is.na(obs)) |> @@ -388,7 +407,7 @@ plot.PM_op <- function( dplyr::arrange(id, time) if (nrow(sub1) == 0) { - cli::cli_abort(c("x" = "You have selected <0> rows in your {.cls PM_op} object.", "i" = "Check the values of {.code include}, {.code exclude}, {.code outeq}, and {.code block}.")) + cli::cli_abort(c("x" = "You have selected <0> rows in your {.cls PM_op} object.", "i" = "Check the values of {.code include}, {.code exclude}, {.code outeq}, and {.code occasion}.")) } diff --git a/R/PM_pop.R b/R/PM_pop.R index 44f6dbe2e..8101fdb73 100755 --- a/R/PM_pop.R +++ b/R/PM_pop.R @@ -44,7 +44,8 @@ PM_pop <- R6::R6Class( #' * **icen** Prediction based on mean or median of Bayesian posterior parameter distribution #' * **outeq** Output equation number #' * **pred** Predicted output for each outeq - #' * **block** Observation blocks within subjects as defined by *EVID=4* dosing events + #' * **occasion** Observation occasion number within subjects; occasions are + #' delimited by dose reset events (`EVID = 4`) data = NULL, #' @description #' Create new object populated with population predicted data at @@ -107,8 +108,9 @@ PM_pop <- R6::R6Class( ), show_col_types = FALSE ) } else if (inherits(data, "PM_pop") & !is.null(data$data)) { # file not there, and already PM_pop - class(data$data) <- c("PM_pop_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_pop_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate pop pred information.", @@ -129,9 +131,10 @@ PM_pop <- R6::R6Class( icen == "pop_median" ~ "median", icen == "pop_mean" ~ "mean" )) |> - mutate(block = block + 1) |> + mutate(occasion = block + 1) |> + select(-block) |> mutate(outeq = normalize_engine_index(outeq)) |> - relocate(id, time, icen, outeq, pred, block) + relocate(id, time, icen, outeq, pred, occasion) class(pop) <- c("PM_pop_data", "data.frame") return(pop) @@ -190,7 +193,8 @@ PM_pop <- R6::R6Class( #' value distributions, or `"mean"`. Default is `"median"`. #' Only a single value is accepted; `outeq` is the sole grouping dimension. #' @param outeq `r template("outeq")` Default is 1, but can be multiple if present in the data, e.g. `1:2` or `c(1, 3)`. -#' @param block `r template("block")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param occasion `r template("occasion")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param overlay Operator to overlay all time prediction profiles in a single plot. #' The default is `TRUE`. If `FALSE`, will trellisplot subjects one at a time. Can also be #' specified as a vector with number of rows and columns, e.g. `c(3, 2)` for 3 rows and @@ -232,7 +236,7 @@ plot.PM_pop <- function( mult = 1, icen = "median", outeq = 1, - block = 1, + occasion = 1, overlay = TRUE, legend = FALSE, log = FALSE, @@ -241,13 +245,27 @@ plot.PM_pop <- function( ylab = "Output", title = "", xlim, ylim, - print = TRUE, ... + print = TRUE, ..., + block = lifecycle::deprecated() ) { + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "plot.PM_pop(block)", "plot.PM_pop(occasion)") + occasion <- block + } + # Plot parameters --------------------------------------------------------- x <- if (inherits(x, "PM_pop")) { x$data } + x <- PM_upgrade(x) user_color <- if (is.list(marker) && !is.null(marker$color)) marker$color else NULL @@ -341,7 +359,7 @@ plot.PM_pop <- function( # filter — icen is a single-value filter only; outeq is the sole grouping dimension presub <- x |> - filter(outeq %in% !!outeq, block %in% !!block, icen == !!icen[1]) |> + filter(.data$outeq %in% .env$outeq, .data$occasion %in% .env$occasion, .data$icen == .env$icen[1]) |> mutate(group = "") |> includeExclude(include, exclude) diff --git a/R/PM_post.R b/R/PM_post.R index eb8fb5b85..124152c2a 100755 --- a/R/PM_post.R +++ b/R/PM_post.R @@ -45,7 +45,8 @@ PM_post <- R6::R6Class( #' * **icen** Prediction based on mean or median of Bayesian posterior parameter distribution #' * **outeq** Output equation number #' * **pred** Predicted output for each outeq - #' * **block** Observation blocks within subjects as defined by *EVID=4* dosing events + #' * **occasion** Observation occasion number within subjects; occasions are + #' delimited by dose reset events (`EVID = 4`) data = NULL, #' @description #' Create new object populated with Bayesian posterior predicted data at @@ -108,8 +109,9 @@ PM_post <- R6::R6Class( ), show_col_types = FALSE ) } else if (inherits(data, "PM_post") & !is.null(data$data)) { # file not there, and already PM_post - class(data$data) <- c("PM_post_data", "data.frame") - return(data$data) + upgraded_data <- PM_upgrade(data$data) + class(upgraded_data) <- c("PM_post_data", "data.frame") + return(upgraded_data) } else { cli::cli_warn(c( "!" = "Unable to generate post pred information.", @@ -133,9 +135,10 @@ PM_post <- R6::R6Class( icen == "post_median" ~ "median", icen == "post_mean" ~ "mean" )) |> - mutate(block = block + 1) |> + mutate(occasion = block + 1) |> + select(-block) |> mutate(outeq = normalize_engine_index(outeq)) |> - relocate(id, time, icen, outeq, pred, block) + relocate(id, time, icen, outeq, pred, occasion) class(post) <- c("PM_post_data", "data.frame") return(post) @@ -193,7 +196,8 @@ PM_post <- R6::R6Class( #' value distributions, or `"mean"`. Default is `"median"`. #' Only a single value is accepted; `outeq` is the sole grouping dimension. #' @param outeq `r template("outeq")` Default is 1, but can be multiple if present in the data, e.g. `1:2` or `c(1, 3)`. -#' @param block `r template("block")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param occasion `r template("occasion")` Default is 1, but can be multiple if present in the data, as for `outeq`. +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param overlay Operator to overlay all time prediction profiles in a single plot. #' The default is `TRUE`. If `FALSE`, will trellisplot subjects one at a time. Can also be #' specified as a vector with number of rows and columns, e.g. `c(3, 2)` for 3 rows and @@ -235,7 +239,7 @@ plot.PM_post <- function( mult = 1, icen = "median", outeq = 1, - block = 1, + occasion = 1, overlay = TRUE, legend = FALSE, log = FALSE, @@ -244,13 +248,27 @@ plot.PM_post <- function( ylab = "Output", title = "", print = TRUE, - xlim, ylim, ... + xlim, ylim, ..., + block = lifecycle::deprecated() ) { + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "plot.PM_post(block)", "plot.PM_post(occasion)") + occasion <- block + } + # Plot parameters --------------------------------------------------------- x <- if (inherits(x, "PM_post")) { x$data } + x <- PM_upgrade(x) user_color <- if (is.list(marker) && !is.null(marker$color)) marker$color else NULL @@ -343,7 +361,7 @@ plot.PM_post <- function( # filter — icen is a single-value filter only; outeq is the sole grouping dimension presub <- x |> - filter(outeq %in% !!outeq, block %in% !!block, icen == !!icen[1]) |> + filter(.data$outeq %in% .env$outeq, .data$occasion %in% .env$occasion, .data$icen == .env$icen[1]) |> mutate(group = "") |> includeExclude(include, exclude) diff --git a/R/PM_pta.R b/R/PM_pta.R index 8ff470fc8..4e7d1d3d8 100755 --- a/R/PM_pta.R +++ b/R/PM_pta.R @@ -93,7 +93,8 @@ PM_pta <- R6::R6Class( #' Ideally then, the simulated datset should contain sufficient observations within the interval specified by `start` and `end`. #' @param icen Can be either "median" for the predictions based on medians of `pred.type` parameter value #' distributions, or "mean". Default is "median". - #' @param block Which block to plot, where a new block is defined by dose resets (evid = 4); default is 1. + #' @param occasion Which observation occasion to use, where a new occasion is defined by dose resets (`EVID = 4`); default is 1. + #' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param ... Not currently used #' @return A list of class *PM_pta_data*, included in the `data` field of the [PM_pta] object. #' The list contains each `target_type` as an element, followed by a final `intersection` @@ -159,8 +160,20 @@ PM_pta <- R6::R6Class( #' } initialize = function(simdata, simlabels, target, target_type, success, outeq = 1, - free_fraction = 1, start = 0, end = Inf, icen = "median", block = 1, - ...) { # dots are for deprecated arguments + free_fraction = 1, start = 0, end = Inf, icen = "median", occasion = 1, + ..., block = lifecycle::deprecated()) { # dots are for deprecated arguments + + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "PM_pta$new(block)", "PM_pta$new(occasion)") + occasion <- block + } # handle deprecated arguments extraArgs <- list(...) @@ -241,13 +254,13 @@ PM_pta <- R6::R6Class( } if (dataType == 5) { # PM_post object - simdata <- simdata$data |> filter(icen == !!icen & block == !!block) + simdata <- PM_upgrade(simdata$data) |> filter(.data$icen == .env$icen & .data$occasion %in% .env$occasion) temp <- list(obs = data.frame(id = simdata$id, time = simdata$time, out = simdata$pred, outeq = simdata$outeq)) simdata <- list(temp) } if (dataType == 6) { # PM_post_data object - simdata <- simdata |> filter(icen == !!icen & block == !!block) + simdata <- PM_upgrade(simdata) |> filter(.data$icen == .env$icen & .data$occasion %in% .env$occasion) temp <- list(obs = data.frame(id = simdata$id, time = simdata$time, out = simdata$pred, outeq = simdata$outeq)) simdata <- list(temp) } @@ -256,8 +269,8 @@ PM_pta <- R6::R6Class( if (dataType == 8) { simdata <- simdata$data } - simdata <- makePMmatrixBlock(simdata) - simdata <- simdata |> filter(evid == 0 & block == !!block) + simdata <- makePMdataOccasion(simdata) + simdata <- simdata |> filter(.data$evid == 0 & .data$occasion %in% .env$occasion) temp <- list(obs = data.frame(id = simdata$id, time = simdata$time, out = simdata$out, outeq = simdata$outeq)) simdata <- list(temp) } @@ -274,11 +287,11 @@ PM_pta <- R6::R6Class( start = start, end = end, icen = icen, - block = block, ... + occasion = occasion, ... ) private$populate(pta) } else { # try simdata as a filename - pta <- readRDS(simdata) + pta <- PM_upgrade(readRDS(simdata)) private$populate(pta) } }, @@ -313,7 +326,7 @@ PM_pta <- R6::R6Class( ), # end public private = list( make = function(simdata, simlabels, target, target_type, success, outeq = 1, - free_fraction = 1, start = 0, end = Inf, icen = "median", block = 1) { + free_fraction = 1, start = 0, end = Inf, icen = "median", occasion = 1) { if (is.numeric(target) | inherits(target, "PMpta.targ")) { target <- list(target) # make a list } diff --git a/R/PM_sim.R b/R/PM_sim.R index 7c55fe4db..dee1d6a8a 100755 --- a/R/PM_sim.R +++ b/R/PM_sim.R @@ -1762,7 +1762,7 @@ PM_sim <- R6::R6Class( filter(!!filter_exprs) # Keep the rest remaining_data <- template |> - filter(magrittr::not(!!filter_exprs)) + filter(not(!!filter_exprs)) } else { filter_status <- "" filtered_data <- template diff --git a/R/PM_upgrade.R b/R/PM_upgrade.R new file mode 100644 index 000000000..963716845 --- /dev/null +++ b/R/PM_upgrade.R @@ -0,0 +1,108 @@ +#' Upgrade legacy Pmetrics objects +#' +#' @description +#' `r lifecycle::badge("stable")` +#' +#' Upgrades data created by older Pmetrics versions to the current schema. +#' In particular, the former observation-occasion column, `block`, is renamed +#' to `occasion` throughout data frames embedded in the supplied object. +#' +#' `PM_upgrade()` is called automatically by Pmetrics object constructors, so +#' most users only need it when working directly with an older saved data frame +#' or list. Re-save an upgraded object to make the conversion permanent. +#' +#' @param x A data frame, list, or Pmetrics R6 object to upgrade. +#' @param warn Whether to warn when a legacy `block` column is converted. +#' +#' @return An upgraded copy of `x`. +#' @export +#' +#' @examples +#' old_data <- data.frame(id = 1, block = 1) +#' PM_upgrade(old_data) +PM_upgrade <- function(x, warn = TRUE) { + upgraded <- FALSE + + pm_upgrade_occasion_column <- function(data) { + if (!is.data.frame(data) || !"block" %in% names(data)) { + return(data) + } + + if ("occasion" %in% names(data)) { + columns_match <- isTRUE(all.equal( + data$block, + data$occasion, + check.attributes = FALSE + )) + if (!columns_match) { + cli::cli_abort(c( + "x" = "Cannot upgrade data containing conflicting {.field block} and {.field occasion} columns.", + "i" = "Remove one column or make their values identical before calling {.fn PM_upgrade}." + )) + } + data$block <- NULL + } else { + names(data)[names(data) == "block"] <- "occasion" + } + + upgraded <<- TRUE + data + } + + upgrade_value <- function(value) { + if (is.data.frame(value)) { + return(pm_upgrade_occasion_column(value)) + } + + # Rebuild PM_op objects so the legacy public `$block` field is replaced by + # the current `$occasion` field as well as upgrading the underlying data. + if (inherits(value, "PM_op")) { + rebuild <- function() PM_op$new(value, path = file.path(tempdir(), "PM_upgrade")) + return(if (isTRUE(warn)) rebuild() else suppressWarnings(rebuild())) + } + + if (inherits(value, "PM_data")) { + rebuild <- function() PM_data$new(value$data, quiet = TRUE) + rebuilt <- if (isTRUE(warn)) rebuild() else suppressWarnings(rebuild()) + rebuilt$pop <- upgrade_value(value$pop) + rebuilt$post <- upgrade_value(value$post) + return(rebuilt) + } + + if (is.list(value) && !inherits(value, "R6")) { + attributes_value <- attributes(value) + value <- lapply(value, upgrade_value) + attributes(value) <- attributes_value + return(value) + } + + if (inherits(value, "R6")) { + value <- value$clone(deep = TRUE) + upgrade_fields <- intersect( + c("data", "standard_data", "pop", "post", "op", "cov", "cycle", "final", "valid"), + ls(envir = value, all.names = TRUE) + ) + for (field in upgrade_fields) { + current <- value[[field]] + if (!is.null(current) && !is.function(current)) { + value[[field]] <- upgrade_value(current) + } + } + return(value) + } + + value + } + + result <- upgrade_value(x) + if (upgraded && isTRUE(warn)) { + lifecycle::deprecate_warn( + "3.2.7", + what = I("The `block` column in Pmetrics data"), + with = I("the `occasion` column"), + details = "The object was upgraded automatically in memory. Re-save it to make this change permanent." + ) + } + + result +} diff --git a/R/PMutilities.R b/R/PMutilities.R index 21efe6aef..e87c17aed 100755 --- a/R/PMutilities.R +++ b/R/PMutilities.R @@ -317,19 +317,14 @@ getOS <- function() { } -# makePMmatrixBlock ------------------------------------------------------- - -makePMmatrixBlock <- function(mdata) { - # make event blocks, delimited by evid=4 - mdata$block <- 1 - if (any(mdata$evid == 4)) { - blocks <- tapply(mdata$time[mdata$evid == 1 | mdata$evid == 4], mdata$id[mdata$evid == 1 | mdata$evid == 4], function(x) sum(x == 0)) - blocks <- blocks[rank(unique(mdata$id))] # sort blocks back into id order in mdata - blocks2 <- unlist(mapply(function(x) 1:x, blocks)) - time0 <- c(which(mdata$time == 0 & mdata$evid != 0), nrow(mdata)) - blocks3 <- rep(blocks2, times = diff(time0)) - mdata$block <- c(blocks3, tail(blocks3, 1)) - } +# makePMdataOccasion -------------------------------------------------- + +makePMdataOccasion <- function(mdata) { + # Assign observation occasions, delimited by EVID = 4 and stored in `occasion`. + mdata <- mdata |> + dplyr::group_by(id) |> + dplyr::mutate(occasion = 1L + cumsum(dplyr::coalesce(evid == 4, FALSE))) |> + dplyr::ungroup() return(mdata) } @@ -365,11 +360,12 @@ getCov <- function(mdata) { } nfixed <- getFixedColNum() ncolData <- ncol(mdata) - ncov <- ncolData - nfixed + occasion_present <- "occasion" %in% names(mdata) + ncov <- ncolData - nfixed - as.integer(occasion_present) if (ncov > 0) { - covnames <- names(mdata)[(nfixed + 1):ncolData] + covnames <- setdiff(names(mdata)[(nfixed + 1):ncolData], "occasion") covstart <- nfixed + 1 - covend <- ncolData + covend <- nfixed + ncov } else { covnames <- NA covstart <- NA diff --git a/R/Pmetrics-package.R b/R/Pmetrics-package.R index c362c62bd..27e794f6b 100755 --- a/R/Pmetrics-package.R +++ b/R/Pmetrics-package.R @@ -23,13 +23,15 @@ #' @importFrom stats aggregate anova approx as.formula binom.test coef complete.cases confint cor cor.test cov cov.wt cov2cor density dnorm get_all_vars glm kmeans kruskal.test ks.test lm median model.frame pchisq pnorm predict pt qchisq qnorm qqline qqnorm qqplot qt quantile rnorm runif sd shapiro.test step t.test terms time var weighted.mean wilcox.test #' @importFrom utils compareVersion data flush.console glob2rx head install.packages modifyList news packageVersion read.table setTxtProgressBar str tail txtProgressBar write.csv write.table getTxtProgressBar #' @importFrom R6 R6Class -#' @importFrom rlang .data set_names := +#' @importFrom rlang .data .env set_names := #' @importFrom plotly filter mutate plot_ly add_markers add_lines layout ggplotly subplot add_annotations add_bars renderPlotly add_trace #' @importFrom shiny fluidPage titlePanel tags navlistPanel tabPanel fluidRow column h2 h3 h4 h5 fileInput selectInput numericInput radioButtons checkboxInput textInput uiOutput actionButton hr textAreaInput reactiveVal reactive observeEvent updateSelectizeInput updateTextAreaInput updateNumericInput updateSelectInput renderUI markdown plotOutput div HTML htmlOutput showModal modalDialog icon shinyApp textOutput helpText conditionalPanel br #' @importFrom bslib accordion accordion_panel card navset_card_tab nav_panel #' @importFrom parallel makeCluster stopCluster clusterExport parLapply #' @importFrom progress progress_bar #' @importFrom withr with_dir +#' @importFrom DT datatable +#' @importFrom magrittr not #' NULL diff --git a/R/globalVariables.R b/R/globalVariables.R index e3761d1ed..25ba0ba09 100755 --- a/R/globalVariables.R +++ b/R/globalVariables.R @@ -1,7 +1,7 @@ utils::globalVariables( ".groups A AGE Agemos B1 B2 B3 CHART HTML KNOT PERCENTILE SEX Sex dataEx actionButton ageyrs aic algebraic annotate arrow assignInNamespace - bic block bmi bolus browseURL browseVignettes cdc_bmi checkboxInput + bic block occasion bmi bolus browseURL browseVignettes cdc_bmi checkboxInput ci cmt code colorRampPalette column combn corr_age cyc cycle d dcBin div dose elim evid fileInput final fitted fluidPage fluidRow found from gamma_lambda ger_bmi getFromNamespace group h2 h3 h4 h5 hr ht diff --git a/R/make_AUC.R b/R/make_AUC.R index 253d7d252..bfdca5029 100755 --- a/R/make_AUC.R +++ b/R/make_AUC.R @@ -26,7 +26,8 @@ #' AUC calculated for the available data, not to exceed the specified interval. #' @param icen `r template("icen")` Only relevant for PMpost or PMpop objects. #' @param outeq `r template("outeq")` -#' @param block `r template("block")` +#' @param occasion `r template("occasion")` +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param method Default is "linear" for AUC trapezoidal calculation. Any other value will result in #' linear up, log down. #' @param addZero Boolean to add a zero concentration at time 0. Default is \code{FALSE}. @@ -54,10 +55,23 @@ make_AUC <- function( include = NULL, exclude = NULL, start = 0, end = Inf, icen = "median", - outeq = 1, block = 1, + outeq = 1, occasion = 1, method = "linear", - addZero = FALSE + addZero = FALSE, + block = lifecycle::deprecated() ) { + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "make_AUC(block)", "make_AUC(occasion)") + occasion <- block + } + # handle objects if (is.null(data)) { cli::cli_abort("Please supply a data object to calculate AUC.") @@ -84,10 +98,10 @@ make_AUC <- function( data |> mutate(out = pred), # PM_post_data data$data |> mutate(out = pred), # PM_post data |> - makePMmatrixBlock() |> + makePMdataOccasion() |> filter(!is.na(out)), # PM_data_data data$standard_data |> - makePMmatrixBlock() |> + makePMdataOccasion() |> filter(!is.na(out)) # PM_data ) group <- "id" @@ -113,19 +127,20 @@ make_AUC <- function( # create dummy variables if missing if (!group %in% names(data2)) data2[[group]] <- 1 # add id if missing if (!"outeq" %in% names(data2)) data2$outeq <- 1 # add outeq if missing - if (!"block" %in% names(data2)) data2$block <- 1 # add block if missing + data2 <- PM_upgrade(data2) + if (!"occasion" %in% names(data2)) data2$occasion <- 1 if (!"icen" %in% names(data2)) data2$icen <- "median" # add icen if missing if (is.null(include)) include <- unique(data2[[group]]) if (is.null(exclude)) exclude <- NA - group_vars <- c(group, "outeq", "block") + group_vars <- c(group, "outeq", "occasion") if (!"nsim" %in% group && "nsim" %in% names(data2)) group_vars <- c(group_vars, "nsim") group_syms <- rlang::syms(group_vars) # filter to create object to pass to auc calculation data3 <- data2 |> dplyr::filter( outeq == !!outeq, - block == !!block, + .data$occasion %in% .env$occasion, !!rlang::sym(group) %in% include, !(!!rlang::sym(group)) %in% exclude, time >= start & time <= end, @@ -136,7 +151,7 @@ make_AUC <- function( dplyr::group_by(!!!group_syms) if (nrow(data3) < 2) { - cli::cli_warn(c("!" = "You have selected fewer than 2 rows in your data.", "i" = "Check the values of {.code include}, {.code exclude}, {.code outeq}, {.code block}, {.code start}, and {.code end}.")) + cli::cli_warn(c("!" = "You have selected fewer than 2 rows in your data.", "i" = "Check the values of {.code include}, {.code exclude}, {.code outeq}, {.code occasion}, {.code start}, and {.code end}.")) } diff --git a/R/make_NCA.R b/R/make_NCA.R index a28dc1e98..081efbc67 100755 --- a/R/make_NCA.R +++ b/R/make_NCA.R @@ -25,8 +25,9 @@ #' @param icen If `postPred` is `TRUE`, use predictions based on median or mean of each #' subject's Bayesian posterior parameter distribution. Default is "median", but could be "mean". #' @param outeq The number of the output equation to analyze; default 1 -#' @param block The number of the observation block within subjects, -#' with each block delimited by EVID=4 in the data file; default 1 +#' @param occasion The number of the observation occasion within subjects, +#' with each occasion delimited by `EVID = 4` in the data file; default 1. +#' @param block `r lifecycle::badge("deprecated")` Use `occasion` instead. #' @param start The beginning of the time interval to look for doses and observations, #' e.g. 120. It can be a vector to allow for individual start times per subject, #' e.g. `c(120,120,144,168)`. If the length of `start` @@ -72,15 +73,28 @@ #' @author Michael Neely #' @export -make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "median", outeq = 1, block = 1, - start = 0, end = Inf, first = NA, last = NA, terminal = 3) { +make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "median", outeq = 1, occasion = 1, + start = 0, end = Inf, first = NA, last = NA, terminal = 3, + block = lifecycle::deprecated()) { + occasion_supplied <- !missing(occasion) + if (lifecycle::is_present(block)) { + if (occasion_supplied) { + cli::cli_abort(c( + "x" = "Arguments {.arg occasion} and deprecated {.arg block} were both supplied.", + "i" = "Supply only {.arg occasion}." + )) + } + lifecycle::deprecate_warn("3.2.7", "make_NCA(block)", "make_NCA(occasion)") + occasion <- block + } + # declare global variables id <- NULL if (!"PM_result" %in% class(x)) stop("You must specify a PM_result object.") - mdata <- x$data$standard_data - post <- x$post$data + mdata <- PM_upgrade(x$data$standard_data) + post <- PM_upgrade(x$post$data) timeFilter <- function(idkeep, thisStartTime, thisEndTime) { dataSub <- mdata |> filter(id == idkeep & time >= thisStartTime & time <= thisEndTime) @@ -148,13 +162,13 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m } # function to convert mdata into data frame of of ID, time, conc, prev dose - conv_mdata <- function(mdata, input, outeq, block, start, end, first, last) { + conv_mdata <- function(mdata, input, outeq, occasion, start, end, first, last) { # first, figure out time interval filterResults <- mdataFilter(mdata, start, end, first, last) mdata2 <- filterResults[[1]] startTimes <- filterResults[[2]] endTimes <- filterResults[[3]] - # now filter to input, outeq, and block + # now filter to input, outeq, and occasion otherInputs <- which(mdata2$evid != 0 & mdata2$input != input) if (length(otherInputs) > 0) { mdata2 <- mdata2[-otherInputs, ] @@ -164,8 +178,8 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m mdata2 <- mdata2[-otherOuteq, ] } mdata2 <- mdata2[!is.na(mdata2$id), ] - mdata2 <- makePMmatrixBlock(mdata2) - mdata2 <- mdata2[mdata2$block == block, ] + mdata2 <- makePMdataOccasion(mdata2) + mdata2 <- mdata2[mdata2$occasion %in% occasion, ] mdata2 <- mdata2[order(mdata2$id, mdata2$time, -mdata2$evid), ] # then calculate time after dose and previous dose @@ -193,7 +207,7 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m } # function to convert post into data frame of of ID, time, conc, prev dose - conv_post <- function(post, mdata, include, exclude, input, outeq, block, icen, start, end, first, last) { + conv_post <- function(post, mdata, include, exclude, input, outeq, occasion, icen, start, end, first, last) { # first, figure out time interval filterResults <- mdataFilter(mdata, start, end, first, last) @@ -213,7 +227,7 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m if (length(otherOuteq) > 0) { post2 <- post2[-otherOuteq, ] } - post2 <- post2[post2$block == block, ] + post2 <- post2[post2$occasion %in% occasion, ] post2 <- post2[post2$icen == icen, ] # rename pred column to out names(post2)[5] <- "out" @@ -231,8 +245,8 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m mdata2 <- mdata2[-otherOuteq, ] } mdata2 <- mdata2[!is.na(mdata2$id), ] - mdata2 <- makePMmatrixBlock(mdata2) - mdata2 <- mdata2[mdata2$block == block, ] + mdata2 <- makePMdataOccasion(mdata2) + mdata2 <- mdata2[mdata2$occasion %in% occasion, ] mdata3 <- mdata2[mdata2$evid == 1, c("id", "evid", "time", "out", "dose")] # combine post4 <- rbind(post3, mdata3) @@ -267,7 +281,7 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m if (!missing(exclude)) { mdata <- subset(mdata, !sub("[[:space:]]+", "", as.character(mdata$id)) %in% as.character(exclude)) } - dataList <- conv_mdata(mdata, input = input, outeq = outeq, block = block, start = start, end = end, first = first, last = last) + dataList <- conv_mdata(mdata, input = input, outeq = outeq, occasion = occasion, start = start, end = end, first = first, last = last) } if (!is.null(post)) { # using NPAG @@ -291,9 +305,9 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m post <- subset(post, !sub("[[:space:]]+", "", as.character(post$id)) %in% as.character(missing_from_post)) if (length(unique(mdata$id)) == 0) stop("No subjects left to analyze.", call. = FALSE) } - dataList <- conv_post(post = post, mdata = mdata, input = input, outeq = outeq, block = block, icen = icen, start = start, end = end, first = first, last = last) + dataList <- conv_post(post = post, mdata = mdata, input = input, outeq = outeq, occasion = occasion, icen = icen, start = start, end = end, first = first, last = last) } else { - dataList <- conv_mdata(mdata, input = input, outeq = outeq, block = block, start = start, end = end, first = first, last = last) + dataList <- conv_mdata(mdata, input = input, outeq = outeq, occasion = occasion, start = start, end = end, first = first, last = last) } } @@ -329,9 +343,9 @@ make_NCA <- function(x, postPred = FALSE, include, exclude, input = 1, icen = "m NCA[i, 10] <- max(temp$out) # cmax NCA[i, 11] <- temp$tad[which(temp$out == NCA[i, 10])][1] # tmax - NCA[i, 2] <- as.numeric(make_AUC(temp, out ~ tad, icen = icen, outeq = outeq, block = block)[, 2]) # auc + NCA[i, 2] <- as.numeric(make_AUC(temp, out ~ tad, icen = icen, outeq = outeq, occasion = occasion)[, 2]) # auc temp2 <- data.frame(id = temp$id, tad = temp$tad, out = temp$tad * temp$out) - NCA[i, 3] <- as.numeric(make_AUC(temp2, out ~ tad, icen = icen, outeq = outeq, block = block)[, 2]) # aumc + NCA[i, 3] <- as.numeric(make_AUC(temp2, out ~ tad, icen = icen, outeq = outeq, occasion = occasion)[, 2]) # aumc if (nrow(temp) >= 5) { temp <- tail(temp, terminal) diff --git a/_pkgdown.yml b/_pkgdown.yml index b3a9865df..7000f7163 100755 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -131,6 +131,7 @@ reference: - title: Utility desc: Utility functions - contents: + - PM_upgrade - PM_build - PM_help - PMcheck diff --git a/data-raw/errors.xlsx b/data-raw/errors.xlsx deleted file mode 100755 index cafbab4df..000000000 Binary files a/data-raw/errors.xlsx and /dev/null differ diff --git a/data/NPex.rda b/data/NPex.rda index 93d67b885..be0103957 100755 Binary files a/data/NPex.rda and b/data/NPex.rda differ diff --git a/data/badData.rda b/data/badData.rda index a58f4b6dc..39d67dbca 100755 Binary files a/data/badData.rda and b/data/badData.rda differ diff --git a/data/dataEx.rda b/data/dataEx.rda index 11247f766..0fe3decaa 100755 Binary files a/data/dataEx.rda and b/data/dataEx.rda differ diff --git a/data/modEx.rda b/data/modEx.rda index 2b531835a..98583c3be 100755 Binary files a/data/modEx.rda and b/data/modEx.rda differ diff --git a/data/simEx.rda b/data/simEx.rda index f8e9de69c..de2f20c36 100755 Binary files a/data/simEx.rda and b/data/simEx.rda differ diff --git a/inst/report/templates/ggplot.Rmd b/inst/report/templates/ggplot.Rmd index 65ed191b1..fc78c91b8 100755 --- a/inst/report/templates/ggplot.Rmd +++ b/inst/report/templates/ggplot.Rmd @@ -32,7 +32,7 @@ if (is.null(res$final$data) & is.null(res$op$data) & is.null(res$cycle$data)) { nsub <- nobs <- numeqt <- icyctot <- NULL # declare for CRAN check nsub <- res$final$nsub -nobs <- if (is.null(res$op$data)) 0 else nrow(dplyr::distinct(res$op$data, id, time, outeq, block)) +nobs <- if (is.null(res$op$data)) 0 else nrow(dplyr::distinct(res$op$data, id, time, outeq, occasion)) numeqt <- if (is.null(res$op$data)) 1 else max(res$op$data$outeq, na.rm = TRUE) icyctot <- if (is.data.frame(res$cycle$objective) && nrow(res$cycle$objective) > 0) { max(res$cycle$objective$cycle) diff --git a/inst/template/Cargo.toml b/inst/template/Cargo.toml new file mode 100644 index 000000000..2342bf7c7 --- /dev/null +++ b/inst/template/Cargo.toml @@ -0,0 +1,4 @@ + [package] + name = "template" + version = "0.1.0" + edition = "2021" \ No newline at end of file diff --git a/man-roxygen/block.R b/man-roxygen/block.R deleted file mode 100755 index 6dc3fde1e..000000000 --- a/man-roxygen/block.R +++ /dev/null @@ -1,2 +0,0 @@ -#' Which block to plot, where blocks are defined -#' by dose reset events (EVID = 4) in the data. diff --git a/man-roxygen/occasion.R b/man-roxygen/occasion.R new file mode 100644 index 000000000..5daf38e97 --- /dev/null +++ b/man-roxygen/occasion.R @@ -0,0 +1,2 @@ +#' Which observation occasion to use. Occasions are numbered +#' within each subject and increment at dose reset events (`EVID = 4`). diff --git a/man/PM_data.Rd b/man/PM_data.Rd index 7d21fc9bc..3eec566d2 100755 --- a/man/PM_data.Rd +++ b/man/PM_data.Rd @@ -12,7 +12,9 @@ to process the data \details{ \emph{PM_data} objects are passed to the \verb{$fit} method of compiled \link{PM_model} objects to initiate a population analysis. The object is created by reading a delimited file in -the current working directory. The data will be transformed into the standard +the current working directory. The format of the file is detailed in the online +\href{https://lapkb.github.io/PM_tutorial/data.html}{Pmetrics in R book}. +The data will be transformed into the standard format which is the same for all engines, with a report of any assumptions that were necessary to standardize the data. \link{PMcheck} is called on the standard data to evaluate for errors. If dates and times are converted diff --git a/man/PM_op.Rd b/man/PM_op.Rd index 28554c0f9..c6d1dd57f 100755 --- a/man/PM_op.Rd +++ b/man/PM_op.Rd @@ -52,7 +52,8 @@ or individual predictions based on Bayesian posterior parameter value distributi \item{\code{outeq}}{output equation number} - \item{\code{block}}{dosing block number for each subject, as defined by dose resets (evid=4).} + \item{\code{occasion}}{Observation occasion number for each subject; occasions are +delimited by dose reset events (\code{EVID = 4}).} \item{\code{obsSD}}{standard deviation of the observation based on the assay error polynomial} diff --git a/man/PM_pop.Rd b/man/PM_pop.Rd index 58b8c6945..84882fb9b 100755 --- a/man/PM_pop.Rd +++ b/man/PM_pop.Rd @@ -45,7 +45,8 @@ Michael Neely, Julian Otalvaro \item \strong{icen} Prediction based on mean or median of Bayesian posterior parameter distribution \item \strong{outeq} Output equation number \item \strong{pred} Predicted output for each outeq -\item \strong{block} Observation blocks within subjects as defined by \emph{EVID=4} dosing events +\item \strong{occasion} Observation occasion number within subjects; occasions are +delimited by dose reset events (\code{EVID = 4}) }} } \if{html}{\out{}} diff --git a/man/PM_post.Rd b/man/PM_post.Rd index b23e913db..3e148f4a2 100755 --- a/man/PM_post.Rd +++ b/man/PM_post.Rd @@ -45,7 +45,8 @@ Michael Neely, Julian Otalvaro \item \strong{icen} Prediction based on mean or median of Bayesian posterior parameter distribution \item \strong{outeq} Output equation number \item \strong{pred} Predicted output for each outeq -\item \strong{block} Observation blocks within subjects as defined by \emph{EVID=4} dosing events +\item \strong{occasion} Observation occasion number within subjects; occasions are +delimited by dose reset events (\code{EVID = 4}) }} } \if{html}{\out{}} diff --git a/man/PM_pta.Rd b/man/PM_pta.Rd index 330261d8f..b2b6a64d3 100755 --- a/man/PM_pta.Rd +++ b/man/PM_pta.Rd @@ -108,8 +108,9 @@ Michael Neely and Jan Strojil start = 0, end = Inf, icen = "median", - block = 1, - ... + occasion = 1, + ..., + block = lifecycle::deprecated() )} \if{html}{\out{}} } @@ -172,8 +173,9 @@ as necessary. Subjects with insufficient data (fewer than 5 simulated observatio Ideally then, the simulated datset should contain sufficient observations within the interval specified by \code{start} and \code{end}.} \item{\code{icen}}{Can be either "median" for the predictions based on medians of \code{pred.type} parameter value distributions, or "mean". Default is "median".} - \item{\code{block}}{Which block to plot, where a new block is defined by dose resets (evid = 4); default is 1.} + \item{\code{occasion}}{Which observation occasion to use, where a new occasion is defined by dose resets (\code{EVID = 4}); default is 1.} \item{\code{...}}{Not currently used} + \item{\code{block}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \if{html}{\out{}} } diff --git a/man/PM_upgrade.Rd b/man/PM_upgrade.Rd new file mode 100644 index 000000000..771b4894a --- /dev/null +++ b/man/PM_upgrade.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PM_upgrade.R +\name{PM_upgrade} +\alias{PM_upgrade} +\title{Upgrade legacy Pmetrics objects} +\usage{ +PM_upgrade(x, warn = TRUE) +} +\arguments{ +\item{x}{A data frame, list, or Pmetrics R6 object to upgrade.} + +\item{warn}{Whether to warn when a legacy \code{block} column is converted.} +} +\value{ +An upgraded copy of \code{x}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Upgrades data created by older Pmetrics versions to the current schema. +In particular, the former observation-occasion column, \code{block}, is renamed +to \code{occasion} throughout data frames embedded in the supplied object. + +\code{PM_upgrade()} is called automatically by Pmetrics object constructors, so +most users only need it when working directly with an older saved data frame +or list. Re-save an upgraded object to make the conversion permanent. +} +\examples{ +old_data <- data.frame(id = 1, block = 1) +PM_upgrade(old_data) +} diff --git a/man/PMmatrixRelTime.Rd b/man/PMmatrixRelTime.Rd index a22546a2c..50467c046 100755 --- a/man/PMmatrixRelTime.Rd +++ b/man/PMmatrixRelTime.Rd @@ -39,7 +39,8 @@ or two digits, but time is in 24-hour format, and \emph{s} is required to avoid ambiguity.} \item{split}{If \emph{true}, \code{PMmatrixRelTime} will split every \code{id} -into id.block, where block is defined by a dose reset, or evid=4, +into pseudo-subject IDs suffixed by the observation occasion number. Occasions +are delimited by dose reset events (\code{EVID = 4}), e.g. \code{id} 1.1, 1.2, 1.3, 2.1, 3.1, 3.2.} } \value{ @@ -57,7 +58,7 @@ any longer. \details{ \code{PMmatrixRelTime} will convert absolute dates and times in a dataset into relative hours, suitable for Pmetrics analysis. Additionally, the user has -the option to split subjects into pseudosubjects every time a dose reset (evid=4) +the option to split subjects into pseudosubjects every time a dose reset (\code{EVID = 4}) is encountered. } \seealso{ diff --git a/man/make_AUC.Rd b/man/make_AUC.Rd index 07abd2573..56d7c4e9c 100644 --- a/man/make_AUC.Rd +++ b/man/make_AUC.Rd @@ -13,9 +13,10 @@ make_AUC( end = Inf, icen = "median", outeq = 1, - block = 1, + occasion = 1, method = "linear", - addZero = FALSE + addZero = FALSE, + block = lifecycle::deprecated() ) } \arguments{ @@ -45,12 +46,14 @@ Only relevant for PMpost or PMpop objects.} \item{outeq}{Which output equation to plot. Default is 1.} -\item{block}{Which block to plot, where blocks are defined by dose reset events (EVID = 4) in the data.} +\item{occasion}{Which observation occasion to use. Occasions are numbered within each subject and increment at dose reset events (\code{EVID = 4}).} \item{method}{Default is "linear" for AUC trapezoidal calculation. Any other value will result in linear up, log down.} \item{addZero}{Boolean to add a zero concentration at time 0. Default is \code{FALSE}.} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ A dataframe of class \emph{PMauc}, which has 2 columns: diff --git a/man/make_NCA.Rd b/man/make_NCA.Rd index f5fe1ac57..5eb468801 100755 --- a/man/make_NCA.Rd +++ b/man/make_NCA.Rd @@ -12,12 +12,13 @@ make_NCA( input = 1, icen = "median", outeq = 1, - block = 1, + occasion = 1, start = 0, end = Inf, first = NA, last = NA, - terminal = 3 + terminal = 3, + block = lifecycle::deprecated() ) } \arguments{ @@ -39,8 +40,8 @@ subject's Bayesian posterior parameter distribution. Default is "median", but c \item{outeq}{The number of the output equation to analyze; default 1} -\item{block}{The number of the observation block within subjects, -with each block delimited by EVID=4 in the data file; default 1} +\item{occasion}{The number of the observation occasion within subjects, +with each occasion delimited by \code{EVID = 4} in the data file; default 1.} \item{start}{The beginning of the time interval to look for doses and observations, e.g. 120. It can be a vector to allow for individual start times per subject, @@ -67,6 +68,8 @@ to signify maximum time for that subject.} \item{terminal}{Number of observations to use for terminal curve fitting (i.e. to estimate \emph{k}). Default is 3.} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ A dataframe of class \emph{PMnca} with columns diff --git a/man/plot.PM_data.Rd b/man/plot.PM_data.Rd index 30c4dc428..52d5641fd 100755 --- a/man/plot.PM_data.Rd +++ b/man/plot.PM_data.Rd @@ -15,7 +15,7 @@ mult = 1, outeq = 1, out_names = NULL, - block = 1, + occasion = 1, tad = FALSE, overlay = TRUE, legend, @@ -27,7 +27,8 @@ xlim, ylim, print = TRUE, - ... + ..., + block = lifecycle::deprecated() ) } \arguments{ @@ -114,7 +115,7 @@ In the case of multiple outputs, \code{group_colors} will be used to color the l \item{out_names}{Character vector of names to label the outputs if \code{legend = TRUE}. These can be combined with \code{group_names}. The number must match the number of outputs in \code{outeq}. If missing, the default is "Output 1", "Output 2", etc.} -\item{block}{Which block to plot, where blocks are defined by dose reset events (EVID = 4) in the data. +\item{occasion}{Which observation occasion to use. Occasions are numbered within each subject and increment at dose reset events (\code{EVID = 4}). Default is 1, but can be multiple if present in the data, as for \code{outeq}.} \item{tad}{Boolean operator to use time after dose rather than time after start. Default is \code{FALSE}.} @@ -164,6 +165,8 @@ Example: \code{ylim = c(0,100)}} \item{\dots}{Other attributes which can be passed to the layout > xaxis/yaxis in a plotly plot to further control formatting. Note that \code{log}, \code{xlab}, \code{ylab}, \code{xlim}, and \code{ylim} are all controlled by the layout object, but are provided throughout Pmetrics plotly function arguments as shortcuts that map to layout elements. Therefore, the dots argument should be used to specify other aspects of the x axis, y axis, or both. See \code{plotly::schema()} layout > layoutAttributes > xaxis/yaxis for options. To add to single axis, name it as a list. If attributes are specified without an enclosing xaxis or yaxis list, they will be applied to both axes. Examples: \itemize{ \item{\code{NPex$data$plot(xaxis = list(tickcolor = "black", tickfont = list(family = "Arial", size = 14, color = "black"))) #applies to x axis only}} \item{\code{NPex$data$plot(linecolor = "red", ticks = "inside") #applies to both axes}} } .} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ Plots the object. diff --git a/man/plot.PM_op.Rd b/man/plot.PM_op.Rd index bf86c132f..ddd18af7c 100755 --- a/man/plot.PM_op.Rd +++ b/man/plot.PM_op.Rd @@ -12,7 +12,7 @@ icen = "median", pred.type = "post", outeq = 1, - block, + occasion, include, exclude, mult = 1, @@ -26,7 +26,8 @@ print = TRUE, xlim, ylim, - ... + ..., + block = lifecycle::deprecated() ) } \arguments{ @@ -95,8 +96,8 @@ zero prediction error.} \item{outeq}{Which output equation to plot. Default is 1.} -\item{block}{Which block to plot, where blocks are defined by dose reset events (EVID = 4) in the data. -Default is missing, which results in all blocks included.} +\item{occasion}{Which observation occasion to use. Occasions are numbered within each subject and increment at dose reset events (\code{EVID = 4}). +Default is missing, which results in all occasions included.} \item{include}{A vector of subject IDs to include in the plot, e.g. c(1:3,5,15)} @@ -151,6 +152,8 @@ Example: \code{ylim = c(0,100)}} \item{...}{Other attributes which can be passed to the layout > xaxis/yaxis in a plotly plot to further control formatting. Note that \code{log}, \code{xlab}, \code{ylab}, \code{xlim}, and \code{ylim} are all controlled by the layout object, but are provided throughout Pmetrics plotly function arguments as shortcuts that map to layout elements. Therefore, the dots argument should be used to specify other aspects of the x axis, y axis, or both. See \code{plotly::schema()} layout > layoutAttributes > xaxis/yaxis for options. To add to single axis, name it as a list. If attributes are specified without an enclosing xaxis or yaxis list, they will be applied to both axes. Examples: \itemize{ \item{\code{NPex$data$plot(xaxis = list(tickcolor = "black", tickfont = list(family = "Arial", size = 14, color = "black"))) #applies to x axis only}} \item{\code{NPex$data$plot(linecolor = "red", ticks = "inside") #applies to both axes}} } .} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ Plots the object. diff --git a/man/plot.PM_pop.Rd b/man/plot.PM_pop.Rd index 2563128f5..b65a0d0ea 100755 --- a/man/plot.PM_pop.Rd +++ b/man/plot.PM_pop.Rd @@ -14,7 +14,7 @@ mult = 1, icen = "median", outeq = 1, - block = 1, + occasion = 1, overlay = TRUE, legend = FALSE, log = FALSE, @@ -25,7 +25,8 @@ xlim, ylim, print = TRUE, - ... + ..., + block = lifecycle::deprecated() ) } \arguments{ @@ -70,7 +71,7 @@ Only a single value is accepted; \code{outeq} is the sole grouping dimension.} \item{outeq}{Which output equation to plot. Default is 1. Default is 1, but can be multiple if present in the data, e.g. \code{1:2} or \code{c(1, 3)}.} -\item{block}{Which block to plot, where blocks are defined by dose reset events (EVID = 4) in the data. +\item{occasion}{Which observation occasion to use. Occasions are numbered within each subject and increment at dose reset events (\code{EVID = 4}). Default is 1, but can be multiple if present in the data, as for \code{outeq}.} \item{overlay}{Operator to overlay all time prediction profiles in a single plot. @@ -115,6 +116,8 @@ Example: \code{ylim = c(0,100)}} \item{...}{Other attributes which can be passed to the layout > xaxis/yaxis in a plotly plot to further control formatting. Note that \code{log}, \code{xlab}, \code{ylab}, \code{xlim}, and \code{ylim} are all controlled by the layout object, but are provided throughout Pmetrics plotly function arguments as shortcuts that map to layout elements. Therefore, the dots argument should be used to specify other aspects of the x axis, y axis, or both. See \code{plotly::schema()} layout > layoutAttributes > xaxis/yaxis for options. To add to single axis, name it as a list. If attributes are specified without an enclosing xaxis or yaxis list, they will be applied to both axes. Examples: \itemize{ \item{\code{NPex$data$plot(xaxis = list(tickcolor = "black", tickfont = list(family = "Arial", size = 14, color = "black"))) #applies to x axis only}} \item{\code{NPex$data$plot(linecolor = "red", ticks = "inside") #applies to both axes}} } .} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ Plots the object. diff --git a/man/plot.PM_post.Rd b/man/plot.PM_post.Rd index fab0d3b30..e6cca8874 100755 --- a/man/plot.PM_post.Rd +++ b/man/plot.PM_post.Rd @@ -14,7 +14,7 @@ mult = 1, icen = "median", outeq = 1, - block = 1, + occasion = 1, overlay = TRUE, legend = FALSE, log = FALSE, @@ -25,7 +25,8 @@ print = TRUE, xlim, ylim, - ... + ..., + block = lifecycle::deprecated() ) } \arguments{ @@ -70,7 +71,7 @@ Only a single value is accepted; \code{outeq} is the sole grouping dimension.} \item{outeq}{Which output equation to plot. Default is 1. Default is 1, but can be multiple if present in the data, e.g. \code{1:2} or \code{c(1, 3)}.} -\item{block}{Which block to plot, where blocks are defined by dose reset events (EVID = 4) in the data. +\item{occasion}{Which observation occasion to use. Occasions are numbered within each subject and increment at dose reset events (\code{EVID = 4}). Default is 1, but can be multiple if present in the data, as for \code{outeq}.} \item{overlay}{Operator to overlay all time prediction profiles in a single plot. @@ -115,6 +116,8 @@ Example: \code{ylim = c(0,100)}} \item{...}{Other attributes which can be passed to the layout > xaxis/yaxis in a plotly plot to further control formatting. Note that \code{log}, \code{xlab}, \code{ylab}, \code{xlim}, and \code{ylim} are all controlled by the layout object, but are provided throughout Pmetrics plotly function arguments as shortcuts that map to layout elements. Therefore, the dots argument should be used to specify other aspects of the x axis, y axis, or both. See \code{plotly::schema()} layout > layoutAttributes > xaxis/yaxis for options. To add to single axis, name it as a list. If attributes are specified without an enclosing xaxis or yaxis list, they will be applied to both axes. Examples: \itemize{ \item{\code{NPex$data$plot(xaxis = list(tickcolor = "black", tickfont = list(family = "Arial", size = 14, color = "black"))) #applies to x axis only}} \item{\code{NPex$data$plot(linecolor = "red", ticks = "inside") #applies to both axes}} } .} + +\item{block}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{occasion} instead.} } \value{ Plots the object. diff --git a/pkgdown/assets/Data/ObjectsLegacy.csv b/pkgdown/assets/Data/ObjectsLegacy.csv index 1fee0e65b..9591132d4 100755 --- a/pkgdown/assets/Data/ObjectsLegacy.csv +++ b/pkgdown/assets/Data/ObjectsLegacy.csv @@ -1,5 +1,5 @@ Objects,Variables,Comments -"op (class: PMop, list)",\$block,"Dosing block, usually 1 unless data file contains EVID=4 dose reset events, in which case each such reset within a given ID will increment the dosing block by 1 for that ID" +"op (class: PMop, list)",\$occasion,"Stored observation occasion number, usually 1; each EVID=4 dose reset event increments the occasion number within a subject" ,\$d,Difference between pred and obs ,\$ds,Squared difference between pred and obs ,\$icen,Median (default) or mean of the parameter distributions used to calculate the predicted values. @@ -52,7 +52,7 @@ NPAG only,\$icen,Median (default) or mean of the parameter distributions used to calculate the predicted values. ,\$pred,Population prior (PMpop) or Bayesian posterior (PMpost) predictions for each output equation ,\$outeq,Output equation for each prediction -,\$block,Same as for PMop objects above +,\$occasion,Same as for PMop objects above "NPdata (class: NPAG, list) ITdata (class: IT2B, list",,Raw data used to make the above objects. Please use ?NPparse or ?ITparse in R for discussion of the data contained in these objects "mdata (class: PMmatrix, data.frame)",See Pmetrics Input Files.,Your original raw data file. "valid (class: PMvalid, list)","Use the command str(valid.x) in R, where x is the run number",This is a list containing the information to perform graphical and numerical analysis of prediction checks and normalized prediction distribution errors. It is a method of internal model validation. @@ -70,7 +70,7 @@ valid\$timeBinMedian (class: data frame),\$bin,Time bin number ,\$time,Median time for each bin valid\$tadBinMedian (class: data frame),\$bin,Time after dose bin number ,\$time,Median time after dose for each bin -valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \$block, \$obsSD, \$ds, \$wd, \$wds",See op above. +valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \$occasion, \$obsSD, \$ds, \$wd, \$wds",See op above. ,\$tad,Time after dose ,\$PRED_bin,Median prediction for each bin ,\$pcObs,Prediction corrected observation (based on bin) @@ -78,4 +78,4 @@ valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \ ,\$timeBinMedian,Median time for each bin ,\$tadBinNum,Number of each time after dose bin ,\$tadBinMedian,Median time after dose for each bin -valid\$npde (class: NpdeObject),,A list of object suitable for plotting an npde. \ No newline at end of file +valid\$npde (class: NpdeObject),,A list of object suitable for plotting an npde. diff --git a/pkgdown/assets/Data/ObjectsR6.csv b/pkgdown/assets/Data/ObjectsR6.csv index 269df071b..d0c012f35 100755 --- a/pkgdown/assets/Data/ObjectsR6.csv +++ b/pkgdown/assets/Data/ObjectsR6.csv @@ -50,7 +50,7 @@ ,\$shrinkage,Shrinkage values for each random population parameter ,\$summary,"Method: summarize the PM_final object with summary.PMfinal(), same function as for Legacy" "op (class: PM_op, R6)",\$auc,Method: make_AUC() to calculate area under time concentration curve -,\$block,"Dosing block, usually 1 unless data file contains EVID=4 dose reset events, in which case each such reset within a given ID will increment the dosing block by 1 for that ID" +,\$occasion,"Stored observation occasion number, usually 1; each EVID=4 dose reset event increments the occasion number within a subject" ,\$clone,Method: Create copy of PM_op object ,\$d,Difference between pred and obs ,\$data,"Data frame with all data fields, class: PM_op_data" @@ -69,7 +69,7 @@ ,\$wd,"\$d, weighted by the \$obsSD" ,\$wds,"\$ds, weighted by the \$obsSD" "pop (class: PM_pop, R6)",\$auc,Method: make_AUC() to calculate area under time concentration curve -"post (class: PM_post, R6)",\$block,Same as for PMop objects above +"post (class: PM_post, R6)",\$occasion,Same as for PMop objects above NPAG only,\$clone,Method: Create copy of PM_pop or PM_post object ,\$data,"Data frame with all data fields, class: PM_pop_data or PM_post_data" ,\$icen,Median (default) or mean of the parameter distributions used to calculate the predicted values. @@ -95,7 +95,7 @@ valid\$timeBinMedian (class: data frame),\$bin,Time bin number ,\$time,Median time for each bin valid\$tadBinMedian (class: data frame),\$bin,Time after dose bin number ,\$time,Median time after dose for each bin -valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \$block, \$obsSD, \$ds, \$wd, \$wds",See op above. +valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \$occasion, \$obsSD, \$ds, \$wd, \$wds",See op above. ,\$tad,Time after dose ,\$PRED_bin,Median prediction for each bin ,\$pcObs,Prediction corrected observation (based on bin) @@ -103,4 +103,4 @@ valid\$opDF (class: data frame),"\$id, \$time, \$obs, \$pred, \$icen, \$outeq, \ ,\$timeBinMedian,Median time for each bin ,\$tadBinNum,Number of each time after dose bin ,\$tadBinMedian,Median time after dose for each bin -valid\$npde (class: NpdeObject),,A list of object suitable for plotting an npde. \ No newline at end of file +valid\$npde (class: NpdeObject),,A list of object suitable for plotting an npde. diff --git a/src/Makevars b/src/Makevars index 895e887d4..506563bb6 100644 --- a/src/Makevars +++ b/src/Makevars @@ -21,9 +21,9 @@ $(STATLIB): export PATH="$(PATH):$(HOME)/.cargo/bin" && \ cargo build --lib --release --manifest-path=./rust/Cargo.toml --target-dir $(TARGET_DIR) if [ "$(NOT_CRAN)" != "true" ]; then \ - if [ "$(CARGOHOME_IS_FALLBACK)" = "1" ]; then rm -Rf $(CARGOTMP); fi && \ - rm -Rf $(LIBDIR)/build; \ + if [ "$(CARGOHOME_IS_FALLBACK)" = "1" ]; then rm -Rf $(CARGOTMP); fi; \ fi + rm -Rf $(LIBDIR)/build C_clean: rm -Rf $(SHLIB) $(STATLIB) $(OBJECTS) diff --git a/src/Makevars.in b/src/Makevars.in index a168fbe69..506563bb6 100755 --- a/src/Makevars.in +++ b/src/Makevars.in @@ -21,12 +21,12 @@ $(STATLIB): export PATH="$(PATH):$(HOME)/.cargo/bin" && \ cargo build --lib --release --manifest-path=./rust/Cargo.toml --target-dir $(TARGET_DIR) if [ "$(NOT_CRAN)" != "true" ]; then \ - if [ "$(CARGOHOME_IS_FALLBACK)" = "1" ]; then rm -Rf $(CARGOTMP); fi && \ - rm -Rf $(LIBDIR)/build; \ + if [ "$(CARGOHOME_IS_FALLBACK)" = "1" ]; then rm -Rf $(CARGOTMP); fi; \ fi + rm -Rf $(LIBDIR)/build C_clean: rm -Rf $(SHLIB) $(STATLIB) $(OBJECTS) clean: - rm -Rf $(SHLIB) $(STATLIB) $(OBJECTS) rust/target \ No newline at end of file + rm -Rf $(SHLIB) $(STATLIB) $(OBJECTS) rust/target diff --git a/src/rust/Cargo.toml b/src/rust/Cargo.toml index 5377a2cc0..43df0b1bb 100755 --- a/src/rust/Cargo.toml +++ b/src/rust/Cargo.toml @@ -14,4 +14,3 @@ rayon = "1.12.0" anyhow = "1.0.103" tracing = "0.1.44" tracing-subscriber = "0.3.23" -mimalloc = { version = "0.1.43", features = ["local_dynamic_tls"] } diff --git a/src/rust/src/lib.rs b/src/rust/src/lib.rs index 89e99f4f2..e56da9346 100644 --- a/src/rust/src/lib.rs +++ b/src/rust/src/lib.rs @@ -3,13 +3,6 @@ mod logs; mod settings; mod simulation; -use mimalloc::MiMalloc; - -/// Use mimalloc as the global allocator for improved allocation performance -/// across Windows, macOS, and Linux. -#[global_allocator] -static GLOBAL: MiMalloc = MiMalloc; - use anyhow::Result; use extendr_api::prelude::*; use pmcore::prelude::data::{read_pmetrics, Data}; diff --git a/tests/testthat/test-makeAUC.R b/tests/testthat/test-makeAUC.R index 291cec9be..4b5d669f4 100755 --- a/tests/testthat/test-makeAUC.R +++ b/tests/testthat/test-makeAUC.R @@ -44,10 +44,10 @@ test_that("make_AUC works for NPex PM_result object components", { auc_post_data <- make_AUC(NPex$post$data) auc_pm_data <- make_AUC(NPex$data) - expect_equal(names(auc_op_obj), c("id", "outeq", "block", "tau")) - expect_equal(names(auc_pop_obj), c("id", "outeq", "block", "tau")) - expect_equal(names(auc_post_obj), c("id", "outeq", "block", "tau")) - expect_equal(names(auc_pm_data), c("id", "outeq", "block", "tau")) + expect_equal(names(auc_op_obj), c("id", "outeq", "occasion", "tau")) + expect_equal(names(auc_pop_obj), c("id", "outeq", "occasion", "tau")) + expect_equal(names(auc_post_obj), c("id", "outeq", "occasion", "tau")) + expect_equal(names(auc_pm_data), c("id", "outeq", "occasion", "tau")) expect_equal(auc_op_obj, auc_op_data) expect_equal(auc_pop_obj, auc_pop_data) expect_equal(auc_post_obj, auc_post_data) @@ -77,7 +77,7 @@ test_that("make_AUC supports Theoph as external data with formula inputs", { time >= 120, time <= 132, outeq == 1, - block == 1, + occasion == 1, !is.na(obs) ) |> dplyr::mutate(out = obs) |> @@ -102,7 +102,7 @@ testthat::test_that("make_AUC works with Theoph data and formula inputs", { dplyr::group_by(id) |> dplyr::summarise(tau = trap_auc_linear(dplyr::pick(time, out)), .groups = "drop") - expect_equal(names(auc_grouped), c("Subject", "outeq", "block", "tau")) + expect_equal(names(auc_grouped), c("Subject", "outeq", "occasion", "tau")) joined_grouped <- auc_grouped |> dplyr::rename(id = Subject, tau_calc = tau) |> dplyr::left_join(manual_grouped |> dplyr::rename(tau_manual = tau), by = "id") diff --git a/tests/testthat/test-occasion-deprecation.R b/tests/testthat/test-occasion-deprecation.R new file mode 100644 index 000000000..9bee72b94 --- /dev/null +++ b/tests/testthat/test-occasion-deprecation.R @@ -0,0 +1,145 @@ +test_that("make_AUC deprecates block in favor of occasion", { + dat <- data.frame( + id = rep(1:2, each = 3), + time = rep(0:2, 2), + out = 1:6, + occasion = rep(1:2, each = 3) + ) + + by_occasion <- make_AUC(dat, out ~ time, occasion = 2) + lifecycle::expect_deprecated( + make_AUC(dat, out ~ time, block = 2), + "block" + ) + by_block <- suppressWarnings(make_AUC(dat, out ~ time, block = 2)) + by_position <- make_AUC(dat, out ~ time, NULL, NULL, 0, Inf, "median", 1, 2) + + expect_equal(by_block, by_occasion) + expect_equal(by_position, by_occasion) + expect_error( + make_AUC(dat, out ~ time, occasion = 1, block = 2), + "Supply only.*occasion" + ) +}) + +test_that("plot methods deprecate block in favor of occasion", { + plot_cases <- list( + data = function(...) plot(NPex$data, print = FALSE, ...), + op = function(...) plot(NPex$op, print = FALSE, ...), + pop = function(...) plot(NPex$pop, print = FALSE, ...), + post = function(...) plot(NPex$post, print = FALSE, ...) + ) + + for (plot_case in plot_cases) { + expect_no_error(plot_case(occasion = 1)) + lifecycle::expect_deprecated(plot_case(block = 1), "block") + expect_error(plot_case(occasion = 1, block = 1), "Supply only.*occasion") + } +}) + +test_that("make_NCA and PM_pta deprecate block in favor of occasion", { + nca_by_occasion <- suppressWarnings(make_NCA(NPex, occasion = 1)) + lifecycle::expect_deprecated( + withCallingHandlers( + make_NCA(NPex, block = 1), + warning = function(w) { + if (!inherits(w, "lifecycle_warning_deprecated")) { + invokeRestart("muffleWarning") + } + } + ), + "block" + ) + nca_by_block <- suppressWarnings(make_NCA(NPex, block = 1)) + expect_equal(nca_by_block, nca_by_occasion) + expect_error( + make_NCA(NULL, occasion = 1, block = 1), + "Supply only.*occasion" + ) + + pta_args <- list( + simdata = simEx, + target = list(5), + target_type = "min", + success = 1, + start = 120, + end = 144 + ) + expect_no_error(rlang::exec(PM_pta$new, !!!pta_args, occasion = 1)) + lifecycle::expect_deprecated( + rlang::exec(PM_pta$new, !!!pta_args, block = 1), + "block" + ) + expect_error( + PM_pta$new(occasion = 1, block = 1), + "Supply only.*occasion" + ) +}) + +test_that("all affected public entry points expose occasion and deprecated block", { + entry_points <- list( + make_AUC = make_AUC, + make_NCA = make_NCA, + plot.PM_data = getS3method("plot", "PM_data"), + plot.PM_op = getS3method("plot", "PM_op"), + plot.PM_pop = getS3method("plot", "PM_pop"), + plot.PM_post = getS3method("plot", "PM_post"), + `PM_pta$new` = PM_pta$public_methods$initialize + ) + + for (entry_point in entry_points) { + fmls <- formals(entry_point) + expect_true("occasion" %in% names(fmls)) + expect_true("block" %in% names(fmls)) + expect_identical(fmls$block, quote(lifecycle::deprecated())) + } +}) + +test_that("PM_upgrade converts legacy occasion columns safely", { + old <- data.frame(id = 1:2, block = c(1L, 2L)) + lifecycle::expect_deprecated(upgraded <- PM_upgrade(old), "block") + expect_named(upgraded, c("id", "occasion")) + expect_identical(upgraded$occasion, old$block) + + both <- transform(old, occasion = block) + expect_named(suppressWarnings(PM_upgrade(both)), c("id", "occasion")) + + conflicting <- transform(old, occasion = c(2L, 1L)) + expect_error(PM_upgrade(conflicting), "conflicting") +}) + +test_that("occasion is a reserved PMcheck header", { + expect_error( + PMcheck(data.frame(occasion = 1)), + "reserved Pmetrics data header" + ) + expect_no_error(PMcheck(dataEx$standard_data, quiet = TRUE)) +}) + +test_that("Pmetrics data constructors upgrade legacy block columns", { + missing_output_path <- file.path(tempdir(), "pmetrics-upgrade-no-output-files") + constructors <- list( + op = PM_op, + pop = PM_pop, + post = PM_post, + cov = PM_cov + ) + + for (component in names(constructors)) { + legacy <- NPex[[component]]$clone(deep = TRUE) + names(legacy$data)[names(legacy$data) == "occasion"] <- "block" + rebuilt <- suppressWarnings(constructors[[component]]$new( + legacy, + path = missing_output_path + )) + expect_true("occasion" %in% names(rebuilt$data), info = component) + expect_false("block" %in% names(rebuilt$data), info = component) + } + + legacy_data <- dataEx$clone(deep = TRUE) + legacy_data$data$block <- legacy_data$standard_data$occasion + rebuilt_data <- suppressWarnings(PM_data$new(legacy_data, quiet = TRUE)) + expect_true("occasion" %in% names(rebuilt_data$data)) + expect_false("block" %in% names(rebuilt_data$data)) + expect_true("occasion" %in% names(rebuilt_data$standard_data)) +})