diff --git a/.gitignore b/.gitignore index ed5327c28..d76efe5c2 100755 --- a/.gitignore +++ b/.gitignore @@ -63,14 +63,17 @@ inst/Learn/_freeze/ data-raw/Runs/ tests/testthat/Runs/ Examples +!inst/Examples/ Experimental other/ 1 2 3 +errors.xlsx # Misc project outputs *_test.R +!inst/Examples/Rscript/*_test.R docs/ docs src/rust/vendor @@ -79,3 +82,6 @@ src/Makevars.win /.quarto/ **/*.quarto_ipynb + +# Old files +Archived diff --git a/Archived/.gitignore b/Archived/.gitignore deleted file mode 100755 index 8191a6abc..000000000 --- a/Archived/.gitignore +++ /dev/null @@ -1 +0,0 @@ -PmetricsManual diff --git a/Archived/ArchivedFunctions.R b/Archived/ArchivedFunctions.R deleted file mode 100755 index ef5d29094..000000000 --- a/Archived/ArchivedFunctions.R +++ /dev/null @@ -1,891 +0,0 @@ -#' @title Load Pmetrics NPAG or IT2B output -#' @description -#' `r lifecycle::badge("superseded")` -#' -#' Loads all the data from an \emph{NPAG} or \emph{IT2B} run. -#' This function has been superseded by [PM_load], which returns objects. -#' In contrast, *PMload* loads them directly into the Global environment, which -#' is not best-practice programming. -#' @param run The numerical value of the folder number containing the run results. This -#' number will also be used to name objects uniquely by appending \dQuote{.\code{run}}, -#' e.g. NPdata.1 or ITdata.1 if run=1. This parameter is \code{1} by default. -#' @param \dots Additional runs to load if desired. -#' @param remote Default is \code{FALSE}. Set to \code{TRUE} if loading results of an NPAG run on remote server. -#' See \code{\link{NPrun}}. Currently remote runs are not configured for IT2B or the Simulator. -#' @param server_address If missing, will use the default server address returned by getPMoptions(). -#' Pmetrics will prompt the user to set this address the first time the \code{remote} argument is set to \code{TRUE} -#' in \code{\link{NPrun}}. -#' @return The following objects are loaded into R. -#' \item{NPdata/ITdata }{List with all output from NPAG/IT2B} -#' \item{pop }{ NPAG only: Population predictions for each output equation} -#' \item{post }{ NPAG only: Individual posterior predictions for each output equation} -#' \item{final }{Final cycle population support points and parameter summary statistics} -#' \item{cycle }{Cycle log-likelihood, AIC, BIC, Gamma/lambda, and normalized parameter means, medians and SDs} -#' \item{op }{List of observed vs. population and posterior predicted plots for each output equation} -#' \item{cov }{Data frame of subject ID, covariate values, and Bayesian posterior parameter estimates} -#' \item{mdata }{The original .csv data file used in the run} -#' \item{valid }{If \code{\link{makeValid}} has been executed after a run, this object will be added to -#' the save data. It contains the information required to plot visual predictive checks and normalized prediction -#' error discrepancies via the npde code developed by Comets et al} -#' @author Michael Neely -#' @seealso \code{\link{NPparse}}, \code{\link{ITparse}}, -#' \code{\link{makeFinal}}, \code{\link{makeCycle}}, \code{\link{makeOP}}, \code{\link{makeCov}}, -#' \code{\link{makePop}}, \code{\link{makePost}} -#' @export - -PMload <- function(run = 1, ..., remote = F, server_address) { - cat("This function is for legacy Pmetrics.\nPlease see documentation for R6 Pmetrics - and PM_load\n") - # declare variables to avoid R CMD Check flag - NPAGout <- NULL - IT2Bout <- NULL - - if (missing(server_address)) server_address <- getPMoptions("server_address") - addlruns <- list(...) - if (length(addlruns) > 0) { - allruns <- c(run, unlist(addlruns)) - } else { - allruns <- run - } - - for (thisrun in allruns) { - # check for NPAG output file - filename <- "NPAGout.Rdata" - outfile <- paste(thisrun, "outputs", filename, sep = "/") - - if (remote) { # only look on server - status <- .remoteLoad(thisrun, server_address) - if (status == "finished") { - .splitOut(thisrun, NPAGout) - } else { - sprintf("Warning: Remote run #%d has not finished yet.\nCurrent status: \"%s\"\n", thisrun, status) %>% - cat() - } - } else if (file.exists(outfile)) { # remote F, so look locally - # load(outfile, .GlobalEnv) - load(outfile) - .splitOut(thisrun, get("NPAGout")) - } else { - # check for IT2B output file - filename <- "IT2Bout.Rdata" - outfile <- paste(thisrun, "outputs", filename, sep = "/") - if (file.exists(outfile)) { - load(outfile) - .splitOut(thisrun, get("IT2Bout")) - } else { - cat(paste(outfile, " not found in ", getwd(), "/", thisrun, "/outputs or ", getwd(), ".\n", sep = "")) - return(invisible(F)) # error, abort - } - } - } - # end thisrun loop - - - return(invisible(T)) # no errors -} - - -.splitOut <- function(run, Out) { - newNames <- paste(names(Out), ".", as.character(run), sep = "") - for (i in 1:length(newNames)) { - assign(newNames[i], Out[[i]], pos = .GlobalEnv) - } -} - -.remoteLoad <- function(run, server_address) { - status <- "" - rid <- .getRemoteId(run) - status <- .PMremote_check(rid = rid, server_address = server_address) - if (status == "finished") { - sprintf("Remote run #%d finished successfuly.\n", run) %>% - cat() - .PMremote_outdata(run, server_address) - } - return(status) -} - -.getRemoteId <- function(run) { - run <- toString(run) - fileName <- paste(run, "inputs", "id.txt", sep = "/") - if (file.exists(fileName)) { - return(readChar(fileName, file.info(fileName)$size) %>% gsub("\n", "", .data)) - } else { - stop(sprintf("File id.txt not found in /%s/outputs.\n", run)) - return(NULL) - } -} - - -#' @title Compare NPAG or IT2B runs -#' @description -#' `r lifecycle::badge("superseded")` -#' -#' Compare NPAG or IT2B runs. This function is superseded by [PM_compare]. -#' @details -#' For backwards compatibility, objects can be specified separated by commas, e.g. PMcompare(1,2,3) followed by -#' any arguments you wish to \code{\link{plot.PMop}}, \code{\link{mtsknn.eq}}. P-values are based on comparison using the nearest neighbors -#' approach if all models are non-parametrics. Models may only be compared on parameters that are included -#' in the first model. The P-value is the comparison between each model and the first model in -#' the list. Missing P-values are when a model has no parameter names in common with the first -#' model, and for the first model compared to itself, or when models from IT2B runs are included. Significant P-values indicate that the null -#' hypothesis should be rejected, i.e. the joint distributions between the two compared models are -#' significantly different. -#' -#' @param x The run number of the first object you wish to compare. This should be a folder in your -#' working directory. To avoid confusion, this function does not use objects -#' already loaded with \code{\link{PMload}}. -#' This will serve as the reference output for P-value testing (see details). -#' @param y The run number of the second object to compare. -#' @param \dots Additional run numbers to compare. See details. Also, parameters to be passed to \code{\link{plot.PMop}} -#' if \code{plot} is true as well as to \code{\link{mtsknn.eq}}. Order does not matter. -#' @param icen Can be either "median" for the predictions based on medians of \code{pred.type} parameter value -#' distributions, or "mean". Default is "median". -#' @param outeq Number of the output equation to compare; default is 1 -#' @param plot Boolean operator selecting whether to generate observed vs. predicted plots for each data object -#' as in \code{\link{plot.PMop}} -#' @return A data frame with the following objects for each model to analyze: -#' \item{run }{The run number of the data} -#' \item{type }{NPAG or IT2B data} -#' \item{nsub }{Number of subjects in the model} -#' \item{nvar }{Number of random parameters in the model} -#' \item{par }{Names of random parameters} -#' \item{cycles }{Number of cycles run} -#' \item{converge }{Boolean value if convergence occurred.} -#' \item{ll }{Final cycle -2*Log-likelihood } -#' \item{aic }{Final cycle Akaike Information Criterion} -#' \item{bic }{Final cycle Bayesian (Schwartz) Information Criterion } -#' \item{popBias }{Bias, or mean weighted prediction error of predictions based on population parameters minus observations} -#' \item{popImp }{Imprecision, or bias-adjusted mean weighted squared error of predictions based on population parameters minus observations } -#' \item{popPerRMSE}{Percent root mean squared error of predictions based on population parameters minus observations} -#' \item{postBias }{Bias, or mean weighted prediction error of predictions - observations based on posterior parameters} -#' \item{postImp }{Imprecision, or bias-adjusted mean weighted squared error of predictions - observations based on posterior parameters} -#' \item{postPerRMSE}{Percent root mean squared error of predictions based on posterior parameters minus observations} -#' \item{pval }{P-value for each model compared to the first. See details.} -#' @author Michael Neely -#' @seealso \code{\link{PMload}}, \code{\link{plot.PMop}}, \code{\link{mtsknn.eq}} -#' @export - - -PMcompare <- function(x, y, ..., icen = "median", outeq = 1, plot = F) { - if (missing(x) | missing(y)) stop("You must specify at least two run numbers for PMcompare.\n") - if (inherits(x, c("NPdata", "ITdata"))) stop("You should specify your objects by run number. See help.\n") - - # parse dots - arglist <- list(...) - namesPlot <- names(formals(plot.PMop)) - namesMTSKNN <- names(formals(mtsknn.eq)) - # get the args to plot.PMop and set defaults if missing - plotArgs <- which(names(arglist) %in% namesPlot) - argsPlot <- arglist[plotArgs] - if (!"cex.stat" %in% names(argsPlot)) argsPlot$cex.stat <- 0.8 - if (!"x.stat" %in% names(argsPlot)) argsPlot$x.stat <- 0.5 - # get the args to mtsknn.eq and set defaults if missing - MTSKNNargs <- which(names(arglist) %in% namesMTSKNN) - argsMTSKNN <- arglist[MTSKNNargs] - if (!"k" %in% names(argsMTSKNN)) argsMTSKNN$k <- 3 - if (!"print" %in% names(argsMTSKNN)) argsMTSKNN$print <- FALSE - # get the others if there and assume that they are PMdata objects for now - if ((length(arglist) - length(c(plotArgs, MTSKNNargs))) > 0) { - if (length(c(plotArgs, MTSKNNargs)) == 0) { - argsPM <- 1:length(arglist) - } else { - argsPM <- (1:length(arglist))[-c(plotArgs, MTSKNNargs)] - } - } else { - argsPM <- NULL - } - - if (length(argsPM) == 0) obj <- list(x, y) - if (length(argsPM) >= 1) obj <- c(list(x, y), arglist[argsPM]) - - # declare global variables to avoid problems with R CMD Check - NPAGout <- NULL - IT2Bout <- NULL - - # get each obj - nobj <- length(obj) - allObj <- list() - for (thisobj in 1:nobj) { - # find objects - if (!file.exists(as.character(obj[thisobj]))) { - cat(paste(obj[thisobj], " is not a folder in the current working directory.\n", sep = "")) - } else { - ITfile <- list.files(paste(obj[thisobj], "outputs", sep = "/"), pattern = "IT2Bout.Rdata", full.names = T) - NPfile <- list.files(paste(obj[thisobj], "outputs", sep = "/"), pattern = "NPAGout.Rdata", full.names = T) - load(c(ITfile, NPfile)) - if (length(ITfile) > 0) { - allObj[[thisobj]] <- IT2Bout$ITdata - } else { - allObj[[thisobj]] <- NPAGout$NPdata - } - } - } - - - - - objClass <- mapply(class, allObj) - # check for non-Pmetrics data objects and remove them if found - yesPM <- which(objClass %in% c("NPAG", "IT2B")) - allObj <- allObj[yesPM] - objClass <- objClass[yesPM] - - - # check for zero cycle objects - cycles <- unlist(sapply(allObj, function(x) x$icyctot)) - if (any(cycles == 0)) stop(paste("Do not include 0-cycle runs: item(s) ", paste(which(cycles == 0), collapse = ", "), "\n", sep = "")) - op <- apply(mapply(makeOP, allObj), 2, function(x) { - data.frame(x) - }) - op <- lapply(op, function(x) { - class(x) <- c("PMop", "data.frame") - x - }) - if (plot) { - if (!"resid" %in% names(argsPlot)) { - if (nobj <= 3) { - par(mfrow = c(nobj, 2)) - } else { - par(mfrow = c(3, 2)) - devAskNewPage(ask = T) - } - for (i in 1:length(op)) { - do.call(plot.PMop, args = c(list( - x = op[[i]], pred.type = "pop", icen = icen, outeq = outeq, - main = paste("Model", i, "Population") - ), argsPlot)) - do.call(plot.PMop, args = c(list( - x = op[[i]], pred.type = "post", icen = icen, outeq = outeq, - main = paste("Model", i, "Posterior") - ), argsPlot)) - } - } else { - devAskNewPage(ask = T) - for (i in 1:length(op)) { - do.call(plot.PMop, args = c(list( - x = op[[i]], pred.type = "post", icen = icen, outeq = outeq, - main = paste("Model", i) - ), argsPlot)) - } - } - par(mfrow = c(1, 1)) - devAskNewPage(ask = F) - } - - - # get summaries of op for outeq - sumobjPop <- mapply(summary.PMop, op, MoreArgs = list(outeq = outeq, pred.type = "pop", icen = icen), SIMPLIFY = F) - sumobjPost <- mapply(summary.PMop, op, MoreArgs = list(outeq = outeq, pred.type = "post", icen = icen), SIMPLIFY = F) - - - popBias <- sapply(sumobjPop, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$mwpe)) - postBias <- sapply(sumobjPost, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$mwpe)) - popImp <- sapply(sumobjPop, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$bamwspe)) - postImp <- sapply(sumobjPost, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$bamwspe)) - popPercent_RMSE <- sapply(sumobjPop, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$percent_rmse)) - postPercent_RMSE <- sapply(sumobjPost, function(x) ifelse(is.na(x$pe[1]), NA, x$pe$percent_rmse)) - - # if all NPAG, calculate nearest neighbors p-value compared to first - if (all(sapply(allObj, function(x) inherits(x, "NPAG")))) { - # get population points - final <- mapply(makeFinal, allObj) - # find intersecting parameters - popPointsRef <- final[, 1]$popPoints - namesRef <- names(popPointsRef) - popPointsOther <- lapply(2:nobj, function(x) final[, x]$popPoints) - t <- sapply(2:nobj, function(x) { - thisPopPoints <- popPointsOther[[x - 1]] - namesThis <- names(thisPopPoints) - intersect <- namesRef[namesRef %in% namesThis] - if (length(intersect) > 0) { - popPoints1 <- popPointsRef[, intersect] - popPoints2 <- thisPopPoints[, intersect] - t <- do.call(mtsknn.eq, args = c(list(x = popPoints1, y = popPoints2), argsMTSKNN))$pval - } else { - t <- NA - } - signif(t, 3) - }) - - t <- c(NA, t) - } else { - t <- NA - } - - results <- data.frame( - run = unlist(obj), - type = objClass, - nsub = mapply(function(x) x$nsub, allObj), - nvar = mapply(function(x) x$nvar, allObj), - par = mapply(function(x) paste(x$par, collapse = " "), allObj), - converge = mapply(function(x) x$converge == 1, allObj), - ll = mapply(function(x) -2 * x$ilog[length(x$ilog)], allObj), - aic = mapply(function(x) tail(x$iic[, 1], 1), allObj), - bic = mapply(function(x) tail(x$iic[, 2], 1), allObj), - popBias = popBias, - popImp = popImp, - popPer_RMSE = popPercent_RMSE, - postBias = postBias, - postImp = postImp, - postPer_RMSE = postPercent_RMSE, - pval = t - ) - names(results)[7] <- "-2*LL" - results[, 7:15] <- format(results[, 7:15], digits = 4) - row.names(results) <- 1:nobj - results -} - - - -#' @title Create a Pmetrics validation object -#' @description -#' `r lifecycle::badge("superseded")` -#' -#' This function is largely a legacy function, replaced by [make_valid], which is -#' typically called with the `$validate` method for a [PM_result] object. -#' -#' @details -#' `makeValid` will create an object suitable for plotting visual predictive -#' checks (VPCs) and prediction-corrected visual -#' predictive checks (pcVPCs). The function will guide the user -#' through appropriate clustering of doses, covariates and sample times for -#' prediction correction using the methods of Bergstrand et al (2011). -#' *NOTE:* Including TAD is only -#' valid if steady state conditions exist for each patient. This means that dosing is stable and regular -#' for each patient, without changes in amount or timing, and that sampling occurs after the average concentrations -#' are the same from dose to dose. Otherwise observations are *NOT* superimposable and `tad` should -#' *NOT* be used, i.e. should be set to `FALSE`. -#' -#' @param run When the current working directory is the Runs folder, the folder name of a previous run that you wish to use for the npde, -#' which will typically be a number, e.g. 1. -#' @param tad `r template("tad")` -#' @param binCov A character vector of the names of covariates which are included in the model, i.e. in the -#' model equations and which need to be binned. For example `binCov='wt'` if "wt" is included in a -#' model equation like V=V0*wt, or `binCov=c( 'wt', 'crcl')` if both "wt" and "crcl" -#' are included in model equations. -#' @param doseC An integer with the number of dose/covariate bins to cluster, if known from a previous run of -#' this function. Including this value will skip the clustering portion for doses/covariates. -#' @param timeC An integer with the number of observation time bins to cluster, if known from a previous run of -#' this function. Including this value will skip the clustering portion for observation times. -#' @param tadC An integer with the number of time after dose bins to cluster, if known from a previous run of -#' this function. Including this value will skip the clustering portion for time after dose. This argument -#' will be ignored if `tad=FALSE`. -#' @param limits Limits on simulated parameters. See [SIMrun]. -#' @param \dots Other parameters to be passed to [SIMrun], especially `limits`. -#' @return The output of `makeValid` is a list of class `PMvalid`, which is a list with the following. -#' * simdata The combined, simulated files for all subjects using the population mean values and each subject -#' as a template. See [SIMparse]. This object will be automatically saved to the run, to be loaded with -#' [PMload] next time. -#' * timeBinMedian A data frame with the median times for each cluster bin. -#' * tadBinMedian A data frame with the median time after dose (tad) for each cluster bin. This will be `NA` if -#' `tad = FALSE`. -#' * opDF A data frame with observations, predicitons, and bin-corrected predictions for each subject. -#' @author Michael Neely -#' @seealso [SIMrun], [plot.PMvalid] -#' @export - -makeValid <- function(run, tad = F, binCov, doseC, timeC, tadC, limits, ...) { - # verify packages used in this function - if(!requireNamespace("mclust", quietly = TRUE)){ - stop("Install mclust package to perform clustering for validation.\n") - } - - # save current wd - currwd <- getwd() - - # get the run - if (missing(run)) run <- readline("Enter the run number: ") - PMload(run) - - getName <- function(x) { - return(get(paste(x, run, sep = "."))) - } - - # parse dots - arglist <- list(...) - namesSIM <- names(formals(SIMrun)) - # namesNPDE <- names(formals(autonpde)) - argsSIM <- arglist[which(names(arglist) %in% namesSIM)] - - # Cluster raw data -------------------------------------------------------- - - # grab raw data file - mdata <- getName("data") - # remove missing observations - missObs <- obsStatus(mdata$out)$missing - if (length(missObs) > 0) mdata <- mdata[-missObs, ] - - # #get input and output max - # maxInput <- max(mdata$input,na.rm=T) - # maxOuteq <- max(mdata$outeq,na.rm=T) - # if(outeq > maxOuteq){ - # stop("You entered an output equation number greater than the number of output equations.\n") - # } - # if(input > maxInput){ - # stop("You entered a drug input number greater than the number of drug inputs.\n") - # } - # - # filter to include/exclude subjects - if ("include" %in% names(argsSIM)) { - includeID <- argsSIM$include - mdata <- mdata[mdata$id %in% includeID, ] - argsSIM[[which(names(argsSIM) == "include")]] <- NULL - } else { - includeID <- NA - } - if ("exclude" %in% names(argsSIM)) { - excludeID <- argsSIM$exclude - mdata <- mdata[!mdata$id %in% excludeID, ] - argsSIM[[which(names(argsSIM) == "exclude")]] <- NULL - } else { - excludeID <- NA - } - - # get time after dose - if (tad) { - valTAD <- calcTAD(mdata) - } - - # number of subjects - nsub <- length(unique(mdata$id)) - - # define covariates in model to be binned - covData <- getCov(mdata) - if (covData$ncov > 0) { # if there are any covariates... - if (missing(binCov)) { - covInData <- getCov(mdata)$covnames - cat(paste("Covariates in your data file: ", paste(getCov(mdata)$covnames, collapse = ", "))) - binCov <- readline("Enter any covariates to be binned, separated by commas ( for none): ") - binCov <- unlist(strsplit(binCov, ",")) - # remove leading/trailing spaces - binCov <- gsub("^[[:space:]]|[[:space:]]$", "", binCov) - } - if (!all(binCov %in% names(mdata))) { - stop("You have entered covariates which are not valid covariates in your data.") - } - # ensure binCov has covariates in same order as data file - covSub <- covData$covnames[covData$covnames %in% binCov] - binCov <- covSub - } else { # there are no covariates - binCov <- NULL - } - - # set up data for clustering - # fill in gaps for cluster analysis only for binning variables (always dose and time) - dataSub <- mdata[, c("id", "evid", "time", "out", "dose", "out", binCov)] - # add time after dose - if (tad) { - dataSub$tad <- valTAD - } else { - dataSub$tad <- NA - } - dataSub <- dataSub %>% select(c("id", "evid", "time", "tad", "out", "dose", binCov)) - - - # restrict to doses for dose/covariate clustering (since covariates applied on doses) - dataSubDC <- dataSub %>% - filter(evid > 0) %>% - select(c("id", "dose", binCov)) - - # set zero doses (covariate changes) as missing - dataSubDC$dose[dataSubDC$dose == 0] <- NA - for (i in 1:nrow(dataSubDC)) { - missingVal <- which(is.na(dataSubDC[i, ])) - if (2 %in% missingVal) { # dose is missing - if (i == 1 | (dataSubDC$id[i - 1] != dataSubDC$id[i])) { # first record for patient has zero dose - j <- 0 - while (is.na(dataSubDC$dose[i + j])) { # increment until non-zero dose is found - j <- j + 1 - } - dataSubDC$dose[i] <- dataSubDC$dose[i + j] # set dose equal to first non-zero dose - missingVal <- missingVal[-which(missingVal == 3)] # take out missing flag for dose as it has been dealt with - } - } - dataSubDC[i, missingVal] <- dataSubDC[i - 1, missingVal] - } - # restrict to observations for time clustering - dataSubTime <- dataSub$time[dataSub$evid == 0] - # restrict to observations for tad clustering - if (tad) { - dataSubTad <- dataSub$tad[dataSub$evid == 0] - } - - # ELBOW PLOT for clustering if used - elbow <- function(x) { - set.seed(123) - # Compute and plot wss for k = 2 to k = 15. - # set k.max - if (is.null(dim(x))) { - k.max <- min(length(unique(x)), 15) - } else { - k.max <- min(nrow(unique(x)), 15) - } - - wss <- sapply( - 2:k.max, - function(k) { - val <- kmeans(x, k, nstart = 50, iter.max = 15) - val$tot.withinss - } - ) - wss - plot(2:k.max, wss, - type = "b", pch = 19, frame = FALSE, - xlab = "Number of clusters", - ylab = "Total within-clusters sum of squares (WSS)" - ) - } - - - if (missing(doseC)) { - # DOSE/COVARIATES - cat("Now optimizing clusters for dose/covariates.\n") - cat("First step is a Gaussian mixture model analysis, followed by an elbow plot.\n") - readline(paste("Press to start cluster analysis for ", - paste(c("dose", binCov), collapse = ", ", sep = ""), ": ", - sep = "" - )) - cat("Now performing Gaussian mixture model analysis.") - mod1 <- mclust::Mclust(dataSubDC) - cat(paste("Most likely number of clusters is ", mod1$G, ".", sep = "")) - readline("Press to see classification plot: ") - plot(mod1, "classification") - readline("Press to see elbow plot: ") - elbow(dataSubDC) - doseC <- as.numeric(readline(paste("Specify your dose/covariate cluster number, for ", mod1$G, ": ", sep = ""))) - if (is.na(doseC)) doseC <- mod1$G - } # end if missing doseC - - # function to cluster by time or tad - timeCluster <- function(timevar) { - if (timevar == "time") { - use.data <- dataSubTime - timeLabel <- "Time" - timePlot <- as.formula(out ~ time) - } else { - use.data <- dataSubTad - timeLabel <- "Time after dose" - timePlot <- as.formula(out ~ tad) - } - readline("Press to start cluster analysis for sample times: ") - mod <- mclust::Mclust(use.data) - cat(paste("Most likely number of clusters is ", mod$G, ".\n", sep = "")) - readline("Press to see classification plot: ") - plot(mod, "classification") - readline("Press to see cluster plot: ") - - timeClusterPlot <- function() { - plot(timePlot, dataSub, xlab = timeLabel, ylab = "Observation", xlim = c(min(use.data), max(use.data))) - } - - # plot for user to see - timeClusterPlot() - timeClusters <- stats::kmeans(use.data, centers = mod$G, nstart = 50) - abline(v = timeClusters$centers, col = "red") - - # allow user to override - readline("Press to see elbow plot: ") - elbow(use.data) - ans <- readline(cat(paste("Enter:\n<1> for ", mod$G, " clusters\n<2> for a different number of automatically placed clusters\n<3> to manually specify cluster centers ", sep = ""))) - if (ans == 1) { - TclustNum <- mod$G - } - if (ans == 2) { - confirm <- 2 - while (confirm != 1) { - TclustNum <- readline("Specify your sample time cluster number \n") - mod <- mclust::Mclust(use.data, G = TclustNum) - timeClusterPlot() - timeClusters <- kmeans(use.data, centers = mod$G, nstart = 50) - abline(v = timeClusters$centers, col = "red") - confirm <- readline(cat("Enter:\n<1> to confirm times\n<2> to revise number of times\n<3> to manually enter times")) - if (confirm == 3) { - ans <- 3 - confirm <- 1 - } - } - } - if (ans == 3) { - confirm <- 2 - while (confirm != 1) { - timeClusterPlot() - timeVec <- readline("Specify a comma-separated list of times, e.g. 1,2,8,10: ") - timeVec <- as.numeric(strsplit(timeVec, ",")[[1]]) - abline(v = timeVec, col = "red") - confirm <- readline(cat("Enter:\n<1> to confirm times\n<2> to revise times ")) - } - TclustNum <- timeVec - } - if (all(is.na(TclustNum))) TclustNum <- mod$G - return(as.numeric(TclustNum)) - } # end timeCluster function - - # cluster by time and tad if appropriate - if (missing(timeC)) { - cat("Now clustering for actual sample times...\n") - timeC <- timeCluster("time") - } # end if missing timeC - if (tad & missing(tadC)) { - cat("Now clustering for time after dose...\n") - tadC <- timeCluster("tad") - } - - # now set the cluster bins - dcClusters <- stats::kmeans(dataSubDC, centers = doseC, nstart = 50) - dataSub$dcBin[dataSub$evid > 0] <- dcClusters$cluster # m=dose,covariate bins - - timeClusters <- stats::kmeans(dataSubTime, centers = timeC, nstart = 50) - dataSub$timeBin[dataSub$evid == 0] <- sapply(timeClusters$cluster, function(x) which(order(timeClusters$centers) == x)) # n=ordered time bins - - if (tad) { - tadClusters <- stats::kmeans(dataSubTad, centers = tadC, nstart = 50) - dataSub$tadBin[dataSub$evid == 0] <- sapply(tadClusters$cluster, function(x) which(order(tadClusters$centers) == x)) # n=ordered time bins - } else { - dataSub$tadBin <- NA - } - - # Simulations ------------------------------------------------------------- - - # create /vpc - if (!file.exists(paste(run, "/vpc", sep = ""))) dir.create(paste(run, "/vpc", sep = "")) - - # get model file - instrfile <- suppressWarnings(tryCatch(readLines(paste(run, "etc/instr.inx", sep = "/")), error = function(e) NULL)) - if (length(grep("IVERIFY", instrfile)) == 0) { # not updated instruction file - modelfile <- readline("Your run used an old instruction file. Enter model name: ") - } else { # ok we are using updated instruction file - if (length(instrfile) > 0) { # ok we got one - # model.for file name - modelfile <- instrfile[5] - # convert to original name - modelfile <- basename(Sys.glob(paste(run, "/inputs/", strsplit(modelfile, "\\.")[[1]][1], "*", sep = ""))) - if (length(modelfile) > 1) { - modelfile <- modelfile[grep(".txt", modelfile)] - } - } else { - stop("Model file not found.\n") - } - } - - # copy this modelfile to new /vpc folder - invisible(file.copy(from = paste(run, "/inputs/", modelfile, sep = ""), to = paste(run, "/vpc", sep = ""))) - - # now get the data file - RFfile <- suppressWarnings(tryCatch(readLines(Sys.glob(paste(run, "outputs/??_RF0001.TXT", sep = "/"))), error = function(e) NULL)) - if (length(RFfile) > 0) { - datafileName <- tail(RFfile, 1) - # remove trailing spaces - datafileName <- sub(" +$", "", datafileName) - file.copy(from = paste(run, "inputs", datafileName, sep = "/"), to = paste(run, "/vpc", sep = "")) - datafile <- datafileName - } else { - stop("Data file not found\n") - } - - # change wd to new /vpc folder which now contains data and model files - setwd(paste(run, "/vpc", sep = "")) - - # simulate PRED_bin from pop icen parameter values and median of each bin for each subject - # first, calculate median of each bin - dcMedian <- aggregate(dataSub[, c("dose", binCov)], by = list(dataSub$dcBin), FUN = median, na.rm = T) - names(dcMedian)[1] <- "bin" - timeMedian <- aggregate(dataSub$time, by = list(dataSub$timeBin), FUN = median) - names(timeMedian) <- c("bin", "time") - - if (tad) { - tadMedian <- aggregate(dataSub$tad, by = list(dataSub$tadBin), FUN = median) - names(tadMedian) <- c("bin", "time") - } else { - tadMedian <- NA - } - - # create datafile based on mdata, but with covariates and doses replaced by medians - # and sample times by bin times - mdataMedian <- mdata - mdataMedian$dcBin <- dataSub$dcBin - mdataMedian$timeBin <- dataSub$timeBin - # no need for tadBin as we don't simulate with tad - mdataMedian$dose <- dcMedian$x[match(mdataMedian$dcBin, dcMedian$bin)] - mdataMedian$time[mdataMedian$evid == 0] <- timeMedian$time[match(mdataMedian$timeBin[mdataMedian$evid == 0], timeMedian$bin)] - covCols <- which(names(mdataMedian) %in% binCov) - if (length(covCols) > 0) { - for (i in covCols) { - dcMedianCol <- which(names(dcMedian) == names(mdataMedian[i])) - mdataMedian[, i] <- dcMedian[match(mdataMedian$dcBin, dcMedian$bin), dcMedianCol] - } - } - # write median file - MedianDataFileName <- paste(substr(paste("m_", strsplit(datafileName, "\\.")[[1]][1], sep = ""), 0, 8), ".csv", sep = "") - PMwriteMatrix(mdataMedian[, 1:(ncol(mdataMedian) - 2)], MedianDataFileName, override = T) - - # remove old files - invisible(file.remove(Sys.glob("sim*.txt"))) - - # get poppar and make one with zero covariance - poppar <- getName("final") - popparZero <- poppar - popparZero$popCov[popparZero$popCov != 0] <- 0 - # do the simulation for each subject using the median dose, median covariates and pop parameters - if ("seed" %in% names(argsSIM)) { - seed.start <- argsSIM$seed - argsSIM[[which(names(argsSIM) == "seed")]] <- NULL - } else { - seed.start <- -17 - } - set.seed(seed.start) - if ("nsim" %in% names(argsSIM)) { - nsim <- argsSIM$nsim - argsSIM[[which(names(argsSIM) == "nsim")]] <- NULL - } else { - nsim <- 1000 - } - if ("limits" %in% names(argsSIM)) { - limits <- argsSIM$limits - argsSIM[[which(names(argsSIM) == "limits")]] <- NULL - } else { - limits <- NA - } - argsSIM1 <- c(list( - poppar = popparZero, data = MedianDataFileName, model = modelfile, nsim = 1, - seed = runif(nsub, -100, 100), outname = "simMed" - ), limits = limits, argsSIM) - cat("Simulating outputs for each subject using population means...\n") - flush.console() - do.call("SIMrun", argsSIM1) - - # read and format the results of the simulation - PRED_bin <- SIMparse("simMed*", combine = T, quiet = T) - - # make tempDF subset of PMop for subject, time, non-missing obs, outeq, pop predictions (PREDij) - tempDF <- getName("op") - tempDF <- tempDF[tempDF$pred.type == "pop", ] - tempDF <- tempDF[obsStatus(tempDF$obs)$present, ] %>% filter(time > 0) - if (!is.na(includeID[1])) { - tempDF <- tempDF[tempDF$id %in% includeID, ] - } - if (!is.na(excludeID[1])) { - tempDF <- tempDF[!tempDF$id %in% excludeID, ] - } - - if (tad) { - tempDF$tad <- rep(dataSub$tad[dataSub$evid == 0], 2) - } else { - tempDF$tad <- NA - } - - - # add PRED_bin to tempDF - tempDF$PRED_bin <- rep(PRED_bin$obs$out[!is.na(PRED_bin$obs$out)], times = 2) # one for icen="median" and icen="mean" - - # add pcYij column to tempDF as obs * PREDbin/PREDij - tempDF$pcObs <- tempDF$obs * tempDF$PRED_bin / tempDF$pred - - # #take out observations at time 0 (from evid=4 events) - # tempDF <- tempDF[tempDF$time>0,] - - # bin pcYij by time and add to tempDF - tempDF$timeBinNum <- rep(dataSub$timeBin[dataSub$evid == 0], times = 2) # one for each icen - tempDF$timeBinMedian <- timeMedian$time[match(tempDF$timeBinNum, timeMedian$bin)] - if (tad) { - tempDF$tadBinNum <- rep(dataSub$tadBin[dataSub$evid == 0], times = 2) - tempDF$tadBinMedian <- tadMedian$time[match(tempDF$tadBinNum, tadMedian$bin)] - } else { - tempDF$tadBinNum <- NA - tempDF$tadBinMedian <- NA - } - - - # Now, simulate using full pop model - # write the adjusted mdata file first - PMwriteMatrix(mdata, datafileName, override = T) - - set.seed(seed.start) - argsSIM2 <- c(list( - poppar = poppar, data = datafileName, model = modelfile, nsim = nsim, - seed = runif(nsub, -100, 100), outname = "full" - ), limits = limits, argsSIM) - if (!is.na(includeID[1])) { - argsSIM2$include <- includeID - } - if (!is.na(excludeID[1])) { - argsSIM2$exclude <- excludeID - } - do.call("SIMrun", argsSIM2) - # read and format the results of the simulation - simFull <- SIMparse("full*", combine = T, quiet = T) - # take out observations at time 0 from evid=4 - simFull$obs <- simFull$obs[simFull$obs$time > 0, ] - # add TAD for plotting options - if (tad) { - simFull$obs$tad <- unlist(tapply(dataSub$tad[dataSub$evid == 0], dataSub$id[dataSub$evid == 0], function(x) rep(x, nsim))) - } - - - - # pull in time bins from tempDF; only need median as tempDF contains median and mean, - # but simulation is only from pop means - - simFull$obs$timeBinNum <- unlist(tapply(tempDF$timeBinNum[tempDF$icen == "median"], tempDF$id[tempDF$icen == "median"], function(x) rep(x, nsim))) - # pull in tad bins from tempDF - simFull$obs$tadBinNum <- unlist(tapply(tempDF$tadBinNum[tempDF$icen == "median"], tempDF$id[tempDF$icen == "median"], function(x) rep(x, nsim))) - # make simulation number 1:nsim - simFull$obs$simnum <- as.numeric(sapply(strsplit(simFull$obs$id, "\\."), function(x) x[1])) - class(simFull) <- c("PMsim", "list") - - # NPDE -------------------------------------------------------------------- - - - # get npde from github - checkRequiredPackages("npde", repos = "LAPKB/npde") - - # prepare data for npde - obs <- tempDF[tempDF$icen == "mean", c("id", "time", "obs")] - - # remove missing obs - obs <- obs[obs$obs != -99, ] - names(obs)[3] <- "out" - - simobs <- simFull$obs - # remove missing simulations - simobs <- simobs[simobs$out != -99, ] - simobs$id <- rep(obs$id, each = nsim) - - # get NPDE - assign("thisobs", obs, pos = 1) - assign("thissim", simobs, pos = 1) - npdeRes <- tryCatch(npde::autonpde(namobs = thisobs, namsim = thissim, 1, 2, 3, verbose = T), error = function(e) { - e - return(NA) - }) - - - - - - - # Clean Up ---------------------------------------------------------------- - - valRes <- list(simdata = simFull, timeBinMedian = timeMedian, tadBinMedian = tadMedian, opDF = tempDF, npde = npdeRes) - class(valRes) <- c("PMvalid", "list") - - # save it back to run so it can be loaded in the future - NPAGout <- list( - NPdata = getName("NPdata"), - pop = getName("pop"), - post = getName("post"), - final = getName("final"), - cycle = getName("cycle"), - op = getName("op"), - cov = getName("cov"), - mdata = getName("data"), - valid = valRes - ) - save(NPAGout, file = "../outputs/NPAGout.Rdata") - - # #put sim in global environment - # assign(paste("sim",as.character(run),sep="."),simFull,pos=1) - - setwd(currwd) - return(valRes) -} \ No newline at end of file diff --git a/Archived/ERRrepScript.R b/Archived/ERRrepScript.R deleted file mode 100755 index 713bb5421..000000000 --- a/Archived/ERRrepScript.R +++ /dev/null @@ -1,6 +0,0 @@ -require(Pmetrics) -wd <- commandArgs()[6] -setwd(wd) -ERRreport(wd,icen=NULL,type="ERR") - - diff --git a/Archived/LICENSE b/Archived/LICENSE deleted file mode 100644 index f288702d2..000000000 --- a/Archived/LICENSE +++ /dev/null @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff --git a/Archived/LegacyPlots.R b/Archived/LegacyPlots.R deleted file mode 100755 index f6efe8c44..000000000 --- a/Archived/LegacyPlots.R +++ /dev/null @@ -1,321 +0,0 @@ -#' Plots \emph{PMsim} objects with the option to perform a visual and numerical predictive check -#' -#' Simulated observations are plotted as quantiles on the y-axis vs. time on the x.axis. If measured -#' observations are included, a visual and numerical predictive check will be performed. -#' -#' @title Plot Pmetrics Simulation Objects -#' @method plot PMsim -#' @param x The name of an \emph{PMsim} data object generated by \code{\link{SIMparse}} -#' @param mult Multiplication factor for y axis, e.g. to convert mg/L to ng/mL -#' @param log Boolean operator to plot in log-log space; the default is \code{False} -#' @param probs Vector of quantiles to plot; if set to \code{NA}, all simulated profiles will be plotted, -#' and numerical predictive checking will be suppressed -#' @param binSize Width of binning interval for simulated concentrations, in time units, e.g. hours. For example, -#' a \code{binSize} of 0.5 will pull all simulated concentrations +/- 0.5 hours into the same time. This is useful -#' for plotting PMsim objects made during \code{\link{makeValid}}. The default is 0, i.e. no binning. -#' @param outeq Which output equation to plot if more than 1 -#' @param pch Controls the plotting symbol for observations; default is NA which results in no symbol. -#' Use 0 for open square, 1 for open circle, 2 for open triangle, 3 for cross, 4 for X, or 5 for a diamond. -#' Other alternatives are \dQuote{*} for asterisks, \dQuote{.} for tiny dots, or \dQuote{+} for a smaller, -#' bolder cross. These plotting symbols are standard for R (see \code{\link{par}}). -#' @param join Boolean operator to join observations by a straight line; the default is \code{True}. -#' @param x.qlab Proportionate value of x-axis at which to draw the quantile labels; 0 is left, 1 is right. -#' The default is 0.4. -#' @param pos.qlab This allows more refined positioning of the quantile labels. It takes standard R -#' values: 1, below; 2, left; 3, above; 4, right. -#' @param cex.qlab Size of the quantile labels. -#' @param ci Width of confidence interval bands around simulated quantiles, from 0 to 1. If 0, or \emph{nsim}<100, will not plot. -#' Default is 0.95, i.e. 95th percentile with tails of 2.5 percent above and below excluded. -#' @param cex.lab Size of the plot labels. -#' @param xlab Label for x-axis; default is \dQuote{Time} -#' @param ylab Label for y-axis; default is \dQuote{Output} -#' @param xlim Limits of the x-axis as a vector, e.g. \code{c(0,1)}. It does not need to be specified, but can be. -#' @param ylim Analogous to \code{xlim} -#' @param obs The name of an \emph{makeOP} data object generated by \code{\link{makeOP}}. If specified, -#' the observations will be overlaid upon the simulation plot enabling a visual predicitve check. In this case, -#' a list object will be returned with two items: $npc containing the quantiles and probability that the observations -#' are below each quantile (binomial test); and $simsum, the times of each observation and the -#' value of the simulated quantile with upper and lower confidence intervals at that time. -#' @param grid Either a boolean operator to plot a reference grid, or a list with elements x and y, -#' each of which is a vector specifying the native coordinates to plot grid lines; the default is \code{False}. -#' For example, grid=list(x=seq(0,24,2),y=1:10). Defaults for missing x or y will be calculated by \code{\link{axTicks}}. -#' @param ocol Color for observations -#' @param add Boolean operator, if \code{True} will add lines to existing plot -#' @param out Direct output to a PDF, EPS or image file. Format is a named list whose first argument, -#' \code{type} is one of the following character vectors: \dQuote{pdf}, \dQuote{eps} (maps to \code{postscript}), -#' \dQuote{\code{png}}, \dQuote{\code{tiff}}, \dQuote{\code{jpeg}}, or \dQuote{\code{bmp}}. Other named items in the list -#' are the arguments to each graphic device. PDF and EPS are vector images acceptable to most journals -#' in a very small file size, with scalable (i.e. infinite) resolution. The others are raster images which may be very -#' large files at publication quality dots per inch (DPI), e.g. 800 or 1200. Default value is \code{NA} which means the -#' output will go to the current graphic device (usually the monitor). For example, to output an eps file, -#' out=list(\dQuote{eps}) will generate a 7x7 inch (default) graphic. -#' @param \dots Other parameters as found in \code{\link{plot.default}}. -#' @return Plots the simulation object. If \code{obs} is included, a list will be returned with -#' the folowing items: -#' \item{npc}{A dataframe with three columns: quantile, prop.less, pval. \emph{quantile} are those specified -#' by the \code{prob} argument to the plot call; \emph{prop.less} are the proportion of simulated -#' observations at all times less than the quantile; \emph{pval} is the P-value of the difference in the -#' prop.less and quantile by the beta-binomial test.} -#' \item{simsum}{A dataframe with the quantile concentration at each simulated time, -#' with lower and upper confidence intervals} -#' \item{obs}{A dataframe similar to an PMop object made by \code{\link{makeOP}} -#' with the addition of the quantile for each observation} -#' @author Michael Neely -#' @seealso \code{\link{SIMparse}}, \code{\link{plot}}, \code{\link{par}}, \code{\link{axis}} -#' @export - -plot.PMsim <- function(x,mult=1,log=T,probs=c(0.05,0.25,0.5,0.75,0.95),binSize=0,outeq=1, - pch=NA,join=T,x.qlab=0.4,cex.qlab=0.8,pos.qlab=1,ci=0.95, - cex.lab=1.2,xlab="Time (h)",ylab="Output",xlim,ylim,obs, - grid,ocol="blue",add=F,out=NA,...){ - - #choose output - if(inherits(out,"list")){ - if(out$type=="eps") {setEPS();out$type <- "postscript"} - if(length(out)>1) {do.call(out$type,args=out[-1])} else {do.call(out$type,list())} - } - #get other args - otherArgs <- list(...) - - - #numerical check function - NPsimInterp <- function(time,out,sim.sum,probs){ - if (min(sim.sum$time)<=time){ - lower.time <- max(sim.sum$time[sim.sum$time<=time],na.rm=T) - } else return(NA) - if (max(sim.sum$time>=time)){ - upper.time <- min(sim.sum$time[sim.sum$time>=time],na.rm=T) - } else return(NA) - sim.quantile <- 0 - for (i in probs){ - if (lower.time != upper.time){ - lower.sim <- sim.sum$out[sim.sum$time==lower.time & sim.sum$quantile==i] - upper.sim <- sim.sum$out[sim.sum$time==upper.time & sim.sum$quantile==i] - slope <- (upper.sim - lower.sim) / (upper.time - lower.time) - calc.sim <- lower.sim + slope*(time-lower.time) - } else calc.sim <- sim.sum$out[sim.sum$time==lower.time & sim.sum$quantile==i] - if (out >= calc.sim){ - sim.quantile <- i - } - } - return(sim.quantile) - } - - simout <- x - - if(!(inherits(simout,"PMsim") || inherits(simout,"PM_sim"))){stop("Use SIMparse() to make object of class Psim.\n")} - if(!missing(obs)){ - if(!inherits(obs,"PMop")){stop("Use makeOP() to make object of class PMop.\n")} - if(inherits(obs,"list")){ - #we are dealing with old PMop - obs <- obs[[2*outeq]] - } else { obs <- obs[obs$outeq==outeq & obs$icen=="median" & obs$pred.type=="post",]} - } else {obs <- data.frame(time=NA,obs=NA)} - if (log){ - logplot <- "y" - yaxt <- "n" - if(all(is.na(obs$obs))){ - if(any(simout$obs<=0,na.rm=T)){ - cat("Values <= 0 omitted from log plot.\n") - simout$obs[simout$obs <= 0] <- NA - } - } else { - if(any(obs$obs<=0,na.rm=T) | any(simout$obs<=0,na.rm=T)){ - cat("Values <= 0 omitted from log plot.\n") - obs$obs[obs$obs <= 0] <- NA - simout$obs[simout$obs <= 0] <- NA - } - } - - } else { - logplot <- "" - yaxt <- "s" - } - if(join){jointype <- "o"} else {jointype <- "p"} - - simout$obs$out <- simout$obs$out * mult - obs$obs <- obs$obs * mult - - sim.out <- simout$obs[!is.na(simout$obs$out),] - #bin times if requested - if(binSize > 0){ - binnedTimes <- seq(floor(min(sim.out$time,na.rm=T)),ceiling(max(sim.out$time,na.rm=T)),binSize) - sim.out$time <- binnedTimes[.bincode(sim.out$time,binnedTimes)] - } - - nout <- max(sim.out$outeq) - nsim <- nrow(simout$parValues) - - - sim <- sim.out[sim.out$outeq==outeq,] - times <- sort(unique(sim$time)) - nobs <- length(times) - - if(!all(is.na(probs)) & nsim>=10){ - sim.quant <- tapply(sim$out,sim$time,quantile,probs=probs,na.rm=T) - lower.confint <- function(nsim) { - l.ci <- ceiling(nsim*probs - qnorm(1-(1-ci)/2)*sqrt(nsim*probs*(1-probs))) - l.ci[l.ci==0] <- NA - return(l.ci) - } - - upper.confint <- function(nsim) { - u.ci <- ceiling(nsim*probs + qnorm(1-(1-ci)/2)*sqrt(nsim*probs*(1-probs))) - return(u.ci) - } - - sim.lconfint <- tapply(sim$out,sim$time,function(x) sort(x)[lower.confint(length(x))]) - sim.uconfint <- tapply(sim$out,sim$time,function(x) sort(x)[upper.confint(length(x))]) - sim.sum <- data.frame(time=rep(times,each=length(probs)),out=unlist(sim.quant), - lower.confint=unlist(sim.lconfint),upper.confint=unlist(sim.uconfint),quantile=rep(probs,nobs)) - row.names(sim.sum) <- 1:nrow(sim.sum) - - if (missing(ylim)){ylim <- c(min(c(sim.sum$out,obs$obs),na.rm=T),max(c(sim.sum$out,obs$obs),na.rm=T))} - if (missing(xlim)){xlim <- c(min(c(sim.sum$time,obs$time),na.rm=T),max(c(sim.sum$time,obs$time),na.rm=T))} - - if(!add){ - do.call("plot",args=c(list(out~time,data=sim.sum,type="n",log=logplot,xlab=xlab,ylab=ylab,cex.lab=cex.lab,xlim=xlim,ylim=ylim,yaxt=yaxt),otherArgs)) - #plot(out~time,data=sim.sum,type="n",log=logplot,xlab=xlab,ylab=ylab,cex.lab=cex.lab,xlim=xlim,ylim=ylim,yaxt=yaxt,otherArgs2) - if(missing(grid)){ - grid <- list(x=NA,y=NA) - } else { - if(inherits(grid,"logical")){ - if(grid){ - grid <- list(x=axTicks(1),y=axTicks(2)) - } else { - grid <- list(x=NA,y=NA) - } - } - if(inherits(grid,"list")){ - if(is.null(grid$x)) grid$x <- axTicks(1) - if(is.null(grid$y)) grid$y <- axTicks(2) - } - } - if(yaxt=="n") logAxis(2,grid=!all(is.na(grid$y))) - abline(v=grid$x,lty=1,col="lightgray") - abline(h=grid$y,lty=1,col="lightgray") - } - if(nsim<100) {cat("\nNote: Confidence intervals for simulation quantiles omitted when nsim < 100\n")} - - if(!is.na(probs[1])){ - if("lwd" %in% names(otherArgs)){ - lwd <- rep(otherArgs$lwd,length(probs)) - otherArgs[[which(names(otherArgs)=="lwd")]] <- NULL - } else {lwd <- rep(1,length(probs))} - if("col" %in% names(otherArgs)){ - col <- rep(otherArgs$col,length(probs)) - otherArgs[[which(names(otherArgs)=="col")]] <- NULL - } else {col <- rep("gray50",length(probs))} - } - - for (i in 1:length(probs)){ - if(nsim>=100 & ci>0){ - temp <- data.frame(x=c(sim.sum$time[sim.sum$quantile==probs[i]],rev(sim.sum$time[sim.sum$quantile==probs[i]])), - y=c(sim.sum$lower.confint[sim.sum$quantile==probs[i]],rev(sim.sum$upper.confint[sim.sum$quantile==probs[i]]))) - polygon(x=temp$x,y=temp$y,col="lightgrey",border=NA) - } - #points(out~time,subset(sim.sum,sim.sum$quantile==probs[i]),pch=pch,lwd=lwd[i],col=col[i],otherArgs) - do.call("points",args=c(list(out~time,data=subset(sim.sum,sim.sum$quantile==probs[i]),pch=pch,lwd=lwd[i],col=col[i]),otherArgs)) - - if(jointype=="o") do.call(lines,args=c(list(out~time,data=subset(sim.sum,sim.sum$quantile==probs[i]),pch=pch,lwd=lwd[i],col=col[i]),otherArgs)) - - hpos.text <- xlim[1] + x.qlab*(xlim[2]-xlim[1]) - if (!hpos.text %in% sim.sum$time){ - lower.time <- tail(sim.sum$time[sim.sum$time < hpos.text],1) - upper.time <- head(sim.sum$time[sim.sum$time > hpos.text],1) - lower.sim <- sim.sum$out[sim.sum$time==lower.time & sim.sum$quantile==probs[i]] - upper.sim <- sim.sum$out[sim.sum$time==upper.time & sim.sum$quantile==probs[i]] - if(!log){ - slope <- (upper.sim - lower.sim) / (upper.time - lower.time) - vpos.text <- lower.sim + slope*(hpos.text-lower.time) - } else { - slope <- (log10(upper.sim) - log10(lower.sim)) / (log10(upper.time) - log10(lower.time)) - vpos.text <- 10**(log10(lower.sim) + slope*(log10(hpos.text)-log10(lower.time))) - } - } else vpos.text <- sim.sum$out[sim.sum$time==hpos.text & sim.sum$quantile==probs[i]] - text(x=hpos.text,y=vpos.text,labels=probs[i],cex=cex.qlab,pos=pos.qlab) - } - - if(!all(is.na(obs))){ - # #bin times if requested - # if(binSize > 0){ - # binnedTimes <- seq(floor(min(obs$time)),ceiling(max(obs$time)),binSize) - # obs$time <- binnedTimes[.bincode(obs$time,binnedTimes)] - # } - do.call("points",args=c(list(obs$obs~obs$time,col=ocol),otherArgs)) - for (i in 1:nrow(obs)){ - obs$sim.quant[i] <- ifelse(is.na(obs$obs[i]),NA,NPsimInterp(obs$time[i],obs$obs[i],sim.sum,probs=probs)) - } - not.miss <- sum(!is.na(obs$sim.quant)) - npc <- data.frame(quantile=probs,prop.less=rep(NA,length(probs)),pval=rep(NA,length(probs))) - for (i in 1:nrow(npc)){ - success <- sum(as.numeric(obs$sim.quant=0.05 & between<0.95),na.rm=T) - attr(npc,"05-95") <- success90/not.miss - attr(npc,"P-90") <- binom.test(success90,not.miss,0.9,"two")$p.value - - if (not.miss Jump To... for rapid navigation -# Keyboard Option+Command+O (Mac) or Alt+O (Windows) to fold all - - -# R6 ---------------------------------------------------------------------- - - -#' @title -#' Defines the PM_model class -#' -#' @description -#' `r lifecycle::badge("stable")` -#' -#' PM_model objects contain the variables, covariates, equations and error models -#' necessary to run a population analysis. -#' -#' @details -#' PM_model objects are one of two fundamental objects in Pmetrics, along with -#' [PM_data()] objects. Defining a PM_model allows for fitting it to the data -#' via the `$fit()` method to conduct a -#' population analysis, i.e. estimating the probability distribution of model equation -#' paramter values in the population. The PM_model object is created using the -#' [build_model()] function, by defining a list of lists -#' directly in R, or by reading a model text file. See the vignette on models -#' for details. -#' -#' @export -PM_model <- R6::R6Class("PM_Vmodel", - public = list( - #' @description - #' Build a new PM_model from a variety of inputs. - #' @param model This can be a quoted name of a model text file in the - #' working directory which will be read and passed to Fortran engines. - #' It can be a list of lists that defines the model directly in R. It - #' can also be a [PM_model] object, which will simply rebuild it. See the user - #' manual for more help on directly defining models in R. - #' @param ... Not currently used. - - # the following functions are dummy to permit documentation - new = function(model, ...) { - return(invisible()) - }, - #' @description - #' This is the main method to run a population analysis. - #' @details - #' As of Pmetrics 3.0.0, models contain compiled code to fit - #' the model equations to the data, optimizing the parameter - #' value probability distributions in the population to - #' maximize their likelihood, or more precisely, minimize - #' the objective function, which is -2*log-likelihood. - #' - #' The `$fit` method is the means of running that compiled - #' code to conduct to fitting procedure. At a minimum, it requires - #' a [PM_data] object, which can be created with - #' [PM_data$new()]. There are a number of additional arguments - #' to control the fitting procedure, such as the number of cycles - #' to run, the initial number of support points, - #' and the algorithm to use, among others. - #' - #' The `$fit` method is the descendant of the legacy - #' [NPrun()] function, which is maintained as a wrapper to `$fit` - #' for backwards compatibility. - #' - #' @param data Either the name of a [PM_data] - #' object in memory or the quoted name of a Pmetrics - #' data file in the current working directory, which will crate a [PM_data] - #' object on the fly. However, if created on the fly, this object - #' will not be available to other - #' methods or other instances of [PM_fit]. - #' @param run Specify the run number of the output folder. Default if missing is the next available number. - #' @param include Vector of subject id values in the data file to include in the analysis. - #' The default (missing) is all. - #' @param exclude A vector of subject IDs to exclude in the analysis, e.g. `c(4,6:14,16:20)` - # #' @param ode Ordinary Differential Equation solver log tolerance or stiffness. - # Default is -4, i.e. 0.0001. Higher values will result in faster - # #' runs, but parameter estimates may not be as accurate. - # #' @param tol Tolerance for convergence of NPAG. Smaller numbers make it harder to converge. - # #' Default value is 0.01. - # #' @param salt Vector of salt fractions for each drug in the data file, default is 1 for each drug. This is not the same as bioavailability. - #' @param cycles Number of cycles to run. Default is 100. - #' @param prior The distribution for the initial support points, which can be - #' one of several options. - #' * The default is "sobol", which is a semi-random distribution. This is the distribution - #' typically used when fitting a new model to the data. An example of this is - #' on our [website](https://www.lapk.org/images/sobol_3d_plot.html). - #' - #' The following all specify non-random, informative prior distributions. They - #' are useful for either continuing a previous - #' run which did not converge or for fitting a model to new data, whether to simply - #' calculate Bayesian posteriors with `cycles = 0` or to revise the model to a new - #' covergence with the new data. - #' * The name of a suitable [PM_result] object from a prior run loaded with [PM_load]. - #' This starts from the non-uniform, informative distribution obtained at the end of a prior NPAG run. - #' Example: `run1 <- PM_load(1); fit1$run(prior = run1)`. - #' - #' * A character string with the filename of a csv file containing a prior distribution with - #' format as for 'theta.csv' in the output folder of a prior run: column headers are parameter - #' names, and rows are the support point values. A final column with probabilities - #' for each support point is not necessary, but if present will be ignored, as these - #' probabilities are calculated by the engine. Note that the parameter names must match the - #' names of the primary variables in the model. Example: `fit1$run(prior = "mytheta.csv")`. - #' * The number of a previous run with `theta.csv` in the output folder which will be read - #' as for the filename option above. Example: `fit1$run(prior = 2)`. - #' * A data frame obtained from reading an approriate file, such that the data frame - #' is in the required format described in the filename option above. Example: - #' `mytheta <- read_csv("mytheta.csv"); fit1$run(prior = mytheta)`. - #' - #' @param density0 The proportion of the volume of the model parameter - #' hyperspace used to calculate the initial number of support points if one of - #' the semi-random, uniform distributions are selected in the `prior` argument - #' above. The initial points are - #' spread through that hyperspace and begin the search for the optimal - #' parameter value distribution (support points) in the population. - #' The volume of the parameter space is the product of the ranges for all parameters. - #' For example if using two parameters `Ke` and `V`, with ranges of \[0, 5\] and \[10, 100\], - #' the volume is (5 - 0) x (100 - 10) = 450 The default value of `density0` is 0.01, so the initial - #' number of support points will be 0.01 x 450 = 4.5, increased to the nearest integer, - #' which is 5. The greater the initial number of points, the less chance of - #' missing the globally maximally likely parameter value distribution, - #' but the slower the run. - #' - #' @param seed Seed used if `prior = "sobol"`. Ignored otherwise. - #' @param intern Run NPAG in the R console without a batch script. Default is TRUE. - # #' @param quiet Boolean operator controlling whether a model summary report is given. Default is `TRUE`. - #' @param overwrite Boolean operator to overwrite existing run result folders. Default is `FALSE`. - # #' @param nocheck Suppress the automatic checking of the data file with [PM_data]. Default is `FALSE`. - # #' @param parallel Run NPAG in parallel. Default is `NA`, which will be set to `TRUE` for models that use - # #' differential equations, and `FALSE` for algebraic/explicit models. The majority of the benefit for parallelization comes - # #' in the first cycle, with a speed-up of approximately 80\% of the number of available cores on your machine, e.g. an 8-core machine - # #' will speed up the first cycle by 0.8 * 8 = 6.4-fold. Subsequent cycles approach about 50\%, e.g. 4-fold increase on an 8-core - # #' machine. Overall speed up for a run will therefore depend on the number of cycles run and the number of cores. - #' @param algorithm The algorithm to use for the run. Default is "NPAG". Alternatives: "NPOD". - #' @param report If missing, the default Pmetrics report template as specified in [getPMoptions] - #' is used. Otherwise can be "plotly", "ggplot", or "none". - #' @param artifacts Default is `TRUE`. Set to `FALSE` to suppress creating the `etc` folder. This folder - #' will contain all the compilation artifacts created during the compilation and run steps. - #' - #' @return A successful run will result in creation of a new folder in the working - #' directory with the results inside the folder. - #' - #' @author Michael Neely - #' @export - fit = function(data = NULL, run = NULL, include = NULL, - exclude = NULL, cycles = 100, prior = "sobol", - density0 = 0.01, seed = 23, overwrite = FALSE, - algorithm = "NPAG", report = getPMoptions("report_template")) { - return(invisible()) - }, - #' @description - #' Simulates multiple scenarios using the provided data and parameter values. - #' - #' @param data A `PM_data` object containing the data for the simulation. - #' @param theta A matrix of numeric values representing the parameter values for the simulation. - #' - #' @details - #' This function simulates multiple scenarios using the provided data and parameter values. - #' It requires the data to be a `PM_data` object and the parameter values to be a numeric matrix. - #' The number of columns in the parameter matrix must match the number of parameters in the model. - #' The function writes the data to a temporary CSV file and uses the Rust backend to perform the simulation. - #' If the model is not already compiled, it will be compiled before the simulation. - #' - #' @return A data frame with the following columns: id, time, out, outeq, state, state_index, spp_index. - #' - #' @examples - #' \dontrun{ - #' data <- PM_data$new(...) - #' theta <- matrix(c(1.0, 20.0, 2.0, 70.0), nrow = 2, byrow = TRUE) - #' result <- model$simulate_all(data, theta) - #' } - #' - #' @export - simulate_all = function(data, theta) { - return(invisible()) - }, - #' @description - #' Retrieves the list of model parameters from the compiled version of the model. - #' - #' @details - #' This function returns a list of the model parameters in the compiled version of the model. - #' It only works with the Rust backend. If the backend is not set to "rust", an error will be thrown. - #' - #' @return A list of model parameters. - #' - #' @examples - #' \dontrun{ - #' model$parameters() - #' } - #' - #' @export - parameters = function() { - return(invisible()) - }, - #' @description - #' Print a model object to the console in readable format - #' @param ... Not used currently. - print = function(...) { - return(invisible()) - }, - #' @description - #' Update selected elements of a model object - #' @param changes_list The named list containing elements and values to update. - #' Because R6 objects are mini-environments, using typical - #' R notation to copy an object like mod2 <- mod1 can lead to unexpected - #' results since this syntax simply creates a copied object in the same - #' environment. Therefore updating any one object (e.g., mod1 or mod2) - #' will update the other. To avoid this behavior, use the $clone() function - #' first if you want to create a copied, yet independent new model. - #' @examples - #' \dontrun{ - #' mod2 <- modEx$clone() #create an independent copy of modEx called mod2 - #' mod2$update(list( - #' pri = list( - #' Ke = ab(0, 1), #change the range - #' V = NULL, #this deletes the variable - #' V0 = ab(10, 100) #add a new variable - #' ), - #' sec = "V = V0 * WT" #add a new secondary equation - #' )) - #' #note that they are different now - #' mod2 - #' modEx - #' } - update = function(changes_list) { - return(invisible()) - }, - #' @description Write a `PM_model` object to a text file - #' @param model_path Full name of the file to be created, including the path - #' relative to the current working directory - #' @param engine Currently only "npag". - #' @examples - #' \dontrun{ - #' modEx$save("model.txt") - #' }, - write = function(model_path = "genmodel.txt", engine = "npag") { - return(invisible()) - }, - #' @description - #' Plot method - #' @details - #' See [plot.PM_model]. - #' @param ... Arguments passed to [plot.PM_model] - plot = function(...) { - return(invisible()) - } - ) -) - -#' @export -##### This function creates a new model depending on input given - -PM_model$new <- function(model, ...) { - # print(model) - # Now we have multiple options for the model: - # The model can be a... - # String -> legacy run - # List - # PM_model object - if (is.character(model) && length(model) == 1) { - model <- PM_model_file$new(model) - } else if (is.list(model)) { - model <- PM_model_list$new(model) - } else if (inherits(model, "PM_model")) { - # if not compiled, do that; otherwise model is already a PM_model - if (is.null(model$binary_path) || !file.exists(model$binary_path)) { - model <- PM_model_list$new(model$model_list) - } - } else { - cli::cli_abort(c("x" = "Non supported model type: {typeof(model)}")) - } - if (getPMoptions()$backend == "rust") { - model$compile() - } - return(model) -} - - - - - -# PM_model_list ----------------------------------------------------------- -# This creates the model from a model_list object -# -PM_model_list <- R6::R6Class("PM_model_list", - inherit = PM_Vmodel, - public = list( - model_list = NULL, - binary_path = NULL, - initialize = function(model_list) { - # guarantees primary keys are lowercase and max first 3 characters - orig_names <- names(model_list) - names(model_list) <- private$lower3(names(model_list)) - model_blocks <- names(model_list) - if (!identical(model_blocks, orig_names)) cli::cli_inform(c("i" = "Model block names standardized to 3 lowercase characters.\n")) - - # checks for minimal model requirements - if (!"pri" %in% model_blocks) cli::cli_abort(c("x" = "Model must have a PRImary block.")) - if (!"out" %in% model_blocks) cli::cli_abort(c("x" = "Model must have an OUTput block.")) - n_out <- length(names(model_list$out)) - for (i in 1:n_out) { - out_names <- private$lower3(names(model_list$out[[i]])) - names(model_list$out[[i]]) <- out_names - if (!"err" %in% out_names) { - cli::cli_abort(c("x" = "Ensure all outputs have an ERRor block.")) - } - if (!"model" %in% names(model_list$out[[i]]$err) || - !"assay" %in% names(model_list$out[[i]]$err)) { - cli::cli_abort(c("x" = "ERRor blocks need {.code model} and {.code assay} components.")) - } - if (!"proportional" %in% names(model_list$out[[i]]$err$model) || - !"additive" %in% names(model_list$out[[i]]$err$model)) { - cli::cli_abort(c("x" = "ERRor model block must be either {.code proportional} or {.code additive}.")) - } - } - - ### check template/equation blocks - - # TEMPLATE - tem <- model_list$tem %>% tolower() - - # EQUATIONS - eqs <- model_list$eqn %>% tolower() - - # no equations found - if (length(eqs) == 0) { - if (length(tem) > 0 && tem != "ode") { # found template, so get equations from model library - model_list$eqn <- model_lib(name = tem, show = FALSE) # these are only for plotting purposes - } else { # no equations or template, so try to parse like old Pmetrics and look for key variable names - key_vars <- c("ka", "ke", "v", "kcp", "kpc", "cl", "vc", "q", "vp") - pri <- names(model_list$pri) - found_pri_keys <- key_vars %in% tolower(pri) - - if (!is.null(model_list$sec)) { - found_sec_keys <- purrr::map_lgl(key_vars, \(x) { - any(stringr::str_detect( - model_list$sec, - stringr::regex(x, ignore_case = TRUE) - )) - }) - } else { - found_sec_keys <- rep(NA, 9) - } - - found_keys <- key_vars[found_pri_keys | found_sec_keys] %>% na.exclude() - - if (length(found_keys) > 0) { # we found key variable names - - model_list$tem <- tem <- dplyr::case_when( - all(found_keys %in% c("ke", "v")) ~ "one_comp_iv", - all(found_keys %in% c("cl", "v")) ~ "one_comp_iv_cl", - all(found_keys %in% c("ka", "ke", "v")) ~ "two_comp_bolus", - all(found_keys %in% c("ka", "cl", "v")) ~ "two_comp_bolus_cl", - all(found_keys %in% c("ke", "v", "kcp", "kpc")) ~ "two_comp_iv", - all(found_keys %in% c("cl", "vc", "q", "vp")) ~ "two_comp_iv_cl", - all(found_keys %in% c("ka", "ke", "v", "kcp", "kpc")) ~ "three_comp_bolus", - all(found_keys %in% c("ka", "cl", "vc", "q", "vp")) ~ "three_comp_bolus_cl", - .default = "error" - ) - } - - # if we didn't find any keys or match a template, then we need to abort - if (length(found_keys) == 0 || tem == "error") { - cli::cli_abort(c( - "x" = "Provide a valid {.code tem} or an {.code eqn} block to define the model equations.", - "i" = "See help for {.fn PM_model}." - )) - } - - # we found a template, then we need to get the equations from the model library - model_list$eqn <- model_lib(name = tem, show = FALSE) - } - } else { # length of equations > 0 - if (length(tem) == 0) { # equations present, but no template - model_list$tem <- tem <- "ode" - } - # otherwise don't need to do anything since model_list$tem is already set - } - - self$model_list <- private$order(model_list) - }, - write = function(model_path = "genmodel.txt", engine = "npag") { - engine <- tolower(engine) - keys <- names(self$model_list) - lines <- c() - for (i in 1:length(keys)) { - lines <- private$write_block(lines, keys[i], self$model_list[[i]], engine) - } - fileConn <- file(model_path) - writeLines(lines, fileConn) - close(fileConn) - - return(model_path) - }, - write_rust = function(file_name = "parsed_model.txt") { - model_file <- system.file("Rust/template.rs", package = "Pmetrics") - content <- readr::read_file(model_file) - - # PRIMARY - constant_parameter <- c() - random_parameter <- c() - for (i in 1:length(self$model_list$pri)) { - if (self$model_list$pri[[i]]$constant) { - constant_parameter <- c(constant_parameter, names(self$model_list$pri)[[i]]) - } else { - random_parameter <- c(random_parameter, names(self$model_list$pri)[[i]]) - } - } - - params <- c() - for (key in random_parameter) { - params <- append(params, sprintf("%s", tolower(key))) - } - content <- gsub("", params %>% paste(collapse = ","), content) - - constant <- c() - for (key in constant_parameter) { - constant <- append(constant, sprintf("let %s = %s;", tolower(key), private$rust_up(self$model_list$pri[key][[1]]$fixed))) - } - content <- gsub("", constant %>% paste(collapse = "\n"), content) - - # COVARIATE - covs <- c() - for (key in tolower(purrr::map_chr(self$model_list$cov, \(x) x$covariate))) { - covs <- append(covs, sprintf("%s", key)) - } - content <- gsub("", covs %>% paste(collapse = ","), content) - - # SECONDARY - sec <- self$model_list$sec %>% purrr::map(function(l) { - l <- private$rust_up(l) # convert fortran/R to rust - if (stringr::str_detect(l, regex("if|else|[{}]", ignore_case = TRUE))) { - return(l) # return the corrected line - } else { - # contruct the variable declaration - splitted <- stringr::str_split(l, "=")[[1]] - lhs <- splitted[1] %>% tolower() - rhs <- splitted[2] %>% tolower() - return(paste0(lhs, " = ", rhs, ";\n")) - } - }) # end line by line mapping of sec - content <- gsub("", sec %>% paste(collapse = ""), content) - - # TEMPLATE - tem <- self$model_list$tem %>% tolower() - # content <- gsub("", tem, content) - - # EQUATIONS - eqs <- self$model_list$eqn %>% tolower() - - # count the number of equations by looking for xp() or dx[] - eqs <- tolower(self$model_list$eqn) - neqs <- sum(sapply(stringr::str_extract_all(eqs, "xp\\(\\d+\\)|dx\\[\\d+\\]"), function(x) length(x) > 0)) - content <- gsub("", neqs, content) - - - eqs <- eqs %>% - stringr::str_replace_all("[\\(\\[](\\d+)[\\)\\]]", function(a) { - paste0("[", as.integer(substring(a, 2, 2)) - 1, "]") - }) %>% - stringr::str_replace_all("xp", "dx") %>% - purrr::map(\(l) private$rust_up(l)) %>% - trimws() %>% - paste(collapse = ";\n") %>% - paste0(";") - content <- gsub("", eqs, content) - - # LAG - lag <- "" - for (line in self$model_list$lag %>% tolower()) { - match <- stringr::str_match(line, "tlag[\\(\\[](\\d+)[\\)\\]]\\s*=\\s*(\\w+)") - lag <- append(lag, sprintf("%i=>%s,", strtoi(match[2]) - 1, private$rust_up(match[3]))) - } - content <- gsub("", lag %>% paste0(collapse = ""), content) - - # FA - fa <- "" - for (line in self$model_list$fa %>% tolower()) { - match <- stringr::str_match(line, "fa[\\(\\[]\\d+)[\\)\\]]\\s*=\\s*(\\w+)") - fa <- append(fa, sprintf("%i=>%s,", strtoi(match[2]), match[3])) - } - fa <- fa %>% purrr::map(\(l) private$rust_up(l)) - content <- gsub("", fa %>% paste0(collapse = ""), content) - - # INITIAL CONDITIONS - init <- self$model_list$ini %>% - stringr::str_split("\n") %>% - unlist() %>% - stringr::str_trim() %>% - purrr::discard(~ .x == "") %>% - purrr::map(function(x) { - aux <- x %>% - tolower() %>% - stringr::str_replace_all("[\\(\\[](\\d+)[\\)\\]]", function(a) { - paste0("[", as.integer(substring(a, 2, 2)) - 1, "]") - }) %>% - stringr::str_split("=") - lhs <- aux[[1]][1] - rhs <- aux[[1]][2] - paste0(lhs, "=", private$rust_up(rhs), ";") - }) %>% - unlist() %>% - paste0(collapse = "\n") - content <- gsub("", init, content) - - # OUTPUTS - out_eqs <- "" - for (key in names(self$model_list$out)) { - rhs <- self$model_list$out[[key]]$val %>% - tolower() %>% - stringr::str_replace_all("[\\(\\[](\\d+)[\\)\\]]", function(a) { - paste0("[", as.integer(substring(a, 2, 2)) - 1, "]") - }) %>% - purrr::map(\(l) private$rust_up(l)) - number <- as.numeric(stringr::str_extract(key, "\\d+")) - key <- paste0(tolower(stringr::str_sub(key, 1, 1)), "[", number - 1, "]") - out_eqs <- append(out_eqs, sprintf("%s = %s;\n", key, rhs)) - } - content <- gsub("", out_eqs %>% paste(collapse = ""), content) - - n_out <- length(self$model_list$out) - content <- gsub("", n_out, content) - - - self$model_list <- private$order(self$model_list) - # browser() - readr::write_file(content, file_name) - }, - update = function(changes_list) { - keys <- names(changes_list) - if (!private$lower3(keys) %in% c("pri", "sec", "tem", "dif", "eqn", "ini", "cov", "lag", "bol", "out", "err", "fa", "ext")) { - cli::cli_abort(c( - "x" = "Invalid block name: {keys}", - "i" = "See help for {.fn PM_model}." - )) - } - self$model_list <- modifyList(self$model_list, changes_list) - }, - compile = function() { - if (getPMoptions()$backend != "rust") { - cli::cli_abort(c("x" = "This function can only be used with the rust backend.")) - } - - if (!is.null(self$binary_path)) { - if (file.exists(self$binary_path)) { - return() - } - } - - - temp_model <- file.path(tempdir(), "temp_model.txt") - self$write_rust(temp_model) - model_path <- tempfile(pattern = "model_", fileext = ".pmx") - tryCatch( - { - compile_model( - temp_model, - model_path, private$get_primary() - ) - self$binary_path <- model_path - }, - error = function(e) { - cli::cli_abort(c("x" = "Model compilation failed: {e$message}")) - } - ) - file.remove(temp_model) - }, - fit = function(data = NULL, run = NULL, include = NULL, - exclude = NULL, cycles = 100, prior = "sobol", - density0 = 0.01, seed = 23, overwrite = FALSE, - algorithm = "NPAG", report = getPMoptions("report_template")) { - if (is.null(data)) { - cli::cli_abort(c("x" = " {.arg data} must be specified.")) - } - - if (is.null(self$model_list)) { - cli::cli_abort(c("x" = "Model is malformed.")) - } - - if (is.character(data)) { - data <- PM_data$new(data) - } - - if (!inherits(data, "PM_data")) { - data <- tryCatch( - { - PM_data$new(data) - }, - error = function(e) { - cli::cli_abort(c( - "x" = "{.code data} must be a {.cls PM_data} object or an appropriate data frame.", - "i" = "See help for {.fn Pmetrics::PM_data}." - )) - } - ) - } - - #### checks - - # covariates - dataCov <- tolower(getCov(data)$covnames) - modelCov <- tolower(sapply(self$model_list$cov, function(x) x$covariate)) - if (length(modelCov) == 0) { - modelCov <- NA - } - if (!all(is.na(dataCov)) && !all(is.na(modelCov))) { # if there are covariates - if (!identical(dataCov, modelCov)) { # if not identical, abort - msg <- glue::glue("Model covariates: {paste(modelCov, collapse = ', ')}; Data covariates: {paste(dataCov, collapse = ', ')}") - cli::cli_abort(c( - "x" = "Error: Covariates in data and model do not match.", - "i" = msg - )) - } - } - - # output equations - - if (!is.null(data$standard_data$outeq)) { - dataOut <- max(data$standard_data$outeq, na.rm = TRUE) - } else { - dataOut <- 1 - } - - modelOut <- length(self$model_list$out) - if (dataOut != modelOut) { - cli::cli_abort(c( - "x" = "Error: Number of output equations in data and model do not match.", - "i" = "Check the number of output equations in the data and model." - )) - } - - # check if model compiled and if not, do so - private$compile() - - - cwd <- getwd() - intern <- TRUE # always true until (if) rust can run separately from R - - - # make new output directory - if (is.null(run)) { - olddir <- list.dirs(recursive = FALSE) - olddir <- olddir[grep("^\\./[[:digit:]]+", olddir)] - olddir <- sub("^\\./", "", olddir) - if (length(olddir) > 0) { - newdir <- as.character(max(as.numeric(olddir)) + 1) - } else { - newdir <- "1" - } - } else { - if (!is.numeric(run)) { - cli::cli_abort(c("x" = " {.arg run} must be numeric.")) - } else { - newdir <- as.character(run) - } - } - - if (file.exists(newdir)) { - if (overwrite) { - unlink(newdir, recursive = TRUE) - cli::cli_inform(c( - "i" = "Overwriting the prior run in folder '{newdir}'." - )) - } else { - cli::cli_inform(c( - "x" = "The prior run from '{newdir}' was read.", - " " = "Set {.arg overwrite} to {.val TRUE} to overwrite prior run in '{newdir}'." - )) - return(invisible(PM_load(newdir))) - } - } - - dir.create(newdir) - setwd(newdir) - - algorithm <- tolower(algorithm) - - if (getPMoptions()$backend != "rust") { - setwd(cwd) - cli::cli_abort(c( - "x" = "Error: unsupported backend.", - "i" = "See help for {.fn setPMoptions}" - )) - } - - #### Include or exclude subjects #### - if (is.null(include)) include <- unique(data$standard_data$id) - if (is.null(exclude)) exclude <- NA - data_filtered <- data$standard_data %>% includeExclude(include, exclude) - - if (nrow(data_filtered) == 0) { - cli::cli_abort("x" = "No subjects remain after filtering.") - setwd(cwd) - return(invisible(NULL)) - } - - - #### Save objects #### - PM_data$new(data_filtered, quiet = TRUE)$save("gendata.csv", header = FALSE) - save(self, file = "fit.Rdata") - - # Get ranges and calculate points - - ranges <- lapply(self$model_list$pri, function(x) { - c(x$min, x$max) - }) - names(ranges) <- tolower(names(ranges)) - - # Set initial grid points (only applies for sobol) - - vol <- prod(sapply(ranges, function(x) x[2] - x[1])) - points <- max(ceiling(density0 * vol), 100) # at least 100 points - - - - # set prior - if (prior != "sobol") { - if (is.numeric(prior)) { # prior specified as a run number - if (!file.exists(glue::glue(prior, "/outputs/theta.csv"))) { - cli::cli_abort(c( - "x" = "Error: {.arg prior} file does not exist.", - "i" = "Check the file path." - )) - } - file.copy(glue::glue(prior, "/outputs/theta.csv"), "theta.csv") - prior <- "theta.csv" - } else if (is.character(prior)) { # prior specified as a filename - if (!file.exists(prior)) { - cli::cli_abort(c( - "x" = "Error: {.arg prior} file does not exist.", - "i" = "Check the file path." - )) - } - file.copy(prior, overwrite = TRUE) # ensure in current working directory - } else { - cli::cli_abort(c( - "x" = "Error: {.arg prior} must be a numeric run number or character filename.", - "i" = "Check the value." - )) - } - } else { - prior <- "sobol" - } - - if (intern) { - ### CALL RUST - out_path <- file.path(getwd(), "outputs") - - rlang::try_fetch( - fit_model( # defined in extendr-wrappers.R - self$binary_path, - "gendata.csv", - list( - ranges = ranges, - algorithm = algorithm, - gamlam = c(self$model_list$out$Y1$err$model$additive, self$model_list$out$Y1$err$model$proportional), - error_type = c("additive", "proportional")[1 + is.null(self$model_list$out$Y1$err$model$additive)], - error_coefficients = t(sapply(self$model_list$out, function(x) { - y <- x$err$assay$coefficients - if (length(y) < 6) { - y <- c(y, 0, 0) - } - y - })), # matrix numeqt x 6 - max_cycles = cycles, - prior = prior, - ind_points = points, - seed = seed - ), out_path - ), - error = function(e) { - cli::cli_warn("Unable to create {.cls PM_result} object", parent = e) - setwd(cwd) - return(NULL) - } - ) - - PM_parse("outputs") - res <- PM_load(file = "PMout.Rdata") - PM_report(res, outfile = "report.html", template = report) - setwd(cwd) - return(invisible(res)) - } else { - cli::cli_abort(c( - "x" = "Error: Currently, the rust engine only supports internal runs.", - "i" = "This is a temporary limitation." - )) - } - }, # end fit - - simulate_all = function(data, theta) { - if (!inherits(data, "PM_data")) { - cli::cli_abort(c("x" = "Data must be a PM_data object.")) - } - if (!is.matrix(theta)) { - cli::cli_abort(c("x" = "theta must be a matrix.")) - } - if (!is.numeric(theta)) { - cli::cli_abort(c("x" = "theta must be a matrix of numeric values.")) - } - if (ncol(theta) != length(self$parameters())) { - cli::cli_abort(c("x" = "theta must have the same number of columns as the number of parameters.")) - } - - temp_csv <- tempfile(fileext = ".csv") - data$save(temp_csv, header = FALSE) - if (getPMoptions()$backend == "rust") { - if (is.null(self$binary_path)) { - private$compile() - if (is.null(self$binary_path)) { - cli::cli_abort(c("x" = "Model must be compiled before simulating.")) - } - } - sim <- simulate_all(temp_csv, self$binary_path, theta) - } else { - cli::cli_abort(c("x" = "This function can only be used with the rust backend.")) - } - return(sim) - }, - parameters = function() { - if (getPMoptions()$backend != "rust") { - cli::cli_abort(c("x" = "This function can only be used with the rust backend.")) - } - model_parameters(self$binary_path) - } # end parameters method - ), # end public list - private = list( - # converts R to rust - rust_up = function(.l) { - ### TEMPORARY TO REMOVE BOLUS[X] UNTIL RUST HANDLES THIS KEYWORD - if (stringr::str_detect(.l, stringr::regex("bolus[\\[\\(]\\d+[\\]\\)]", ignore_case = TRUE))) { - .l <- stringr::str_replace(.l, stringr::regex("bolus[\\[\\(]\\d+[\\]\\)]", ignore_case = TRUE), "") - } - - - - ### - # sequentially modify for operators - pattern1 <- "(\\((?:[^)(]+|(?1))*+\\))" - # this pattern recursively finds nested parentheses - # and returns contents of outer - for (x in c("abs", "exp", "ln", "log10", "log", "sqrt")) { - .l <- gsub("dlog10", "log10", .l) - .l <- gsub( - pattern = paste0("(? -1) { # found something - found <- regmatches(x = .l, m = n_found) - repl <- paste(gsub("[()]", " ", regmatches(x = .l, m = n_found)), "{") - .l <- gsub(pattern = found, replacement = repl, x = .l, fixed = TRUE) - if (grepl("then", .l, ignore.case = TRUE)) { # remove 'then' - .l <- paste(gsub(pattern = "then", replacement = "", x = .l, ignore.case = TRUE), "\n") - } else { # single line if - .l <- paste(.l, "}\n") - } - } - } - if (code == "else") { - .l <- gsub( - pattern = "^&*else", - replacement = "\\} else \\{\n", - x = .l, ignore.case = TRUE - ) - } - if (code == "end if") { - .l <- gsub( - pattern = "^&*end if", - replacement = "}\n", - x = .l, ignore.case = TRUE - ) - } - return(.l) - } # end if_fix function - - # fix if and if-else blocks - for (i in c("if", "else if", "else", "end if")) { - .l <- if_fix(i, .l) - } - - # deal with secondary equations, which don't have xp or dx - .l2 <- stringr::str_replace_all(.l, "\\s*", "") # eliminate any spaces to make pattern matching easier - pattern4 <- "^[^=]*(? 0) { - newdir <- as.character(max(as.numeric(olddir)) + 1) - } else { - newdir <- "1" - } - } else { - if (!is.numeric(run)) { - endNicely("'run' must be numeric.\n") - } else { - newdir <- as.character(run) - } - } - if (file.exists(newdir)) { - if (overwrite) { - unlink(newdir, recursive = T) - } else { - endNicely(paste("\n", newdir, " exists already. Set overwrite=T to overwrite.\n")) - } - } - dir.create(newdir) - dir.create(paste(newdir, "inputs", sep = "/")) - dir.create(paste(newdir, "outputs", sep = "/")) - inputFiles <- c(model, data) # list.files(getwd(), "txt|csv") - file.copy(inputFiles, paste(newdir, "inputs", sep = "/")) - file.remove(inputFiles) - setwd(paste(newdir, "inputs", sep = "/")) - # END same code PMrun - sprintf("Remote run #%s started successfuly, You can access this run's id using: PMload(id).\n Id can be the full id string or the run number.\n", newdir, newdir) %>% - cat() - fileConn <- file("id.txt") - write(httr::content(r, "parsed")$id, fileConn) - close(fileConn) - setwd(currwd) - httr::content(r, "parsed")$id %>% - return() - } else { - cat("You need to be logged in to perform this operation.\n") - - if (PMlogin()) { - .PMremote_run(model, data, server_address, run) - } else { - cat("Authentication error\n") - } - } -} - -.PMremote_check <- function(rid, server_address) { - if (missing(server_address)) server_address <- getPMoptions("server_address") - api_url <- paste0(server_address, "/api") - request_url <- paste0(api_url, "/analysis/", rid, "/status") - r <- httr::GET(request_url, add_headers(api_key = .getApiKey())) - if (r$status == 200) { - status <- httr::content(r, "parsed")$status - return(status) - } else { - cat("You need to be logged in to perform this operation.\n") - stop("Authentication error") - } -} - -.PMremote_outdata <- function(run, server_address) { - # checkRequiredPackages("base64enc") - if (missing(server_address)) server_address <- getPMoptions("server_address") - - rid <- .getRemoteId(run) - wd <- getwd() - setwd(paste(run, "outputs", sep = "/")) - api_url <- paste0(server_address, "/api") - r <- httr::GET(paste0(api_url, "/analysis/", rid, "/outdata"), add_headers(api_key = .getApiKey())) - if (r$status == 200) { - cat("Results fetched, parsing...\n") - # fileConn <- file("enc_outdata.txt") - # writeLines(content(r, "parsed")$outdata, fileConn) - # close(fileConn) - # system("base64 --decode -i enc_outdata.txt -o NPAGout.Rdata") - # Windows : https://stackoverflow.com/questions/16945780/decoding-base64-in-batch - # Works! - if (file.exists("NPAGout.Rdata")) { - system("rm NPAGout.Rdata") - } - out <- file("NPAGout.Rdata", "wb") - httr::content(r, "parsed")$outdata %>% - base64enc::base64decode(output = out) - close(out) - # declare variable to avoid R CMD Check flag - NPAGout <- NULL - load("NPAGout.Rdata", .GlobalEnv) - PMreport(getwd(), rdata = NPAGout) # TODO: check if this works with multiple PMload inputs - OS <- getOS() # 1 Mac, 2 Windows, 3 Linux - command <- c("open", "start", "xdg-open")[OS] - system(paste(command, "NPAGreport.html")) - cat("Parsed! NPAGout object created.\n") - } else { - cat("You need to be logged in to perform this operation.\nUse PMlogin() and try again.") - } - setwd(wd) -} - -.PMremote_registerNewInstallation <- function() { - if (Sys.getenv("env") == "Developmet") { - cat("You are inside the development folder, skipping the registration of the current installation.") - return() - } - - current_version <- packageVersion("Pmetrics") - api_url <- "https://pmcount.siel.com.co/api/v0/count" - - safe_POST <- purrr::safely(httr::POST) - r <- safe_POST( - api_url, - body = list(version = paste0("v", current_version)), - encode = "json", - httr::content_type_json() - ) - - if (!is.null(r$error)) { - cat("Pmetrics was unable to register your installation.") - } -} diff --git a/Archived/PMreport.R b/Archived/PMreport.R deleted file mode 100755 index 667ac0c84..000000000 --- a/Archived/PMreport.R +++ /dev/null @@ -1,475 +0,0 @@ -#' @title Summarize NPAG or IT2B Run -#' @description -#' `r lifecycle::badge("stable")` -#' -#' Generates a summary of a Pmetrics NPAG or IT2B run -#' @details -#' Creates an HTML page and several files summarizing an NPAG or IT2B run. This report is generated -#' automatically at the end of a successful run. -#' -#' -#' @param wd The working directory containing the NP_RFxxxx.TXT or IT_RFxxxx.TXT file -#' @param rdata The processed output of an IT2B or NPAG run, depending on local or server runs. -#' @param icen Median (default), mean or mode of Bayesian posterior to be used to calculate predictions. -#' @param type \dQuote{NPAG} (default) or \dQuote{IT2B} report type -#' @param parallel Boolean parameter which indicates the type of run done. Default is \code{FALSE} for serial. -#' @return Several files are placed in the \code{wd} -#' \item{NPAGreport.html or IT2Breport.html }{An .html file containing a summary of all the results} -#' \item{poppoints.csv }{NPAG only: A .csv file containing the population support points and probabilities} -#' \item{poparam.csv }{A .csv file containing a summary of the population parameter values, including -#' mean, standard deviation, coefficient of variation, variance, and median} -#' \item{popcor.csv }{A .csv file containing the population parameter correlation matrix} -#' \item{popcov.csv }{A .csv file containing the population parameter covariance matrix} -#' \item{cycle.pdf }{A .pdf file containing the run cycle information (see \code{\link{plot.PMcycle}})} -#' \item{cycle.png }{A thumbnail of the run cycle information for the .html file} -#' \item{final.pdf }{A .pdf file containing the population final cycle information (see \code{\link{plot.PMfinal}})} -#' \item{final.png }{A thumbnail of the population final cycle information for the .html file} -#' \item{opx.pdf }{One or more .pdf files, where \emph{x} is the number of the output equation, each containing -#' two observed vs. predicted plots: population and individual Bayesian posterior predictions (see \code{\link{plot.PMop}})} -#' \item{opx.png }{One or more thumnails of the observed vs. predicted plots for the .html file} -#' \item{NPAGout.Rdata or IT2Bout.Rdata }{An R data file containing the output of \code{\link{NPparse}} or \code{\link{ITparse}}, \code{\link{makeFinal}}, -#' \code{\link{makeCycle}}, \code{\link{makeOP}}, \code{\link{makeCov}}, \code{\link{makePop}}, \code{\link{makePost}}, and -#' the data file for the run read by \code{\link{PMreadMatrix}}. -#' This file can be loaded using \code{\link{PMload}}.} -#' @author Michael Neely -#' @export - -PMreport <- function(wd, rdata, icen = "median", type = "NPAG", parallel = F) { - cwd <- getwd() - reportType <- which(c("NPAG", "IT2B") == type) - - if (missing(rdata)) rdata <- makeRdata(wd, remote = F, reportType) - # get elapsed time if available - if (file.exists("time.txt")) { - execTime <- readLines("time.txt") - OS <- switch(gsub("[[:blank:]]", "", execTime[1]), - Unix = 1, - Windows = 2, - Linux = 3 - ) - if (OS == 1 | OS == 3) { - elapsed <- difftime(as.POSIXct(execTime[3], format = "%s"), as.POSIXct(execTime[2], format = "%s")) - } - if (OS == 2) { - elapsed <- difftime(as.POSIXct(execTime[3], format = "%T"), as.POSIXct(execTime[2], format = "%T")) - } - } else { - elapsed <- NA - } - # check for error file - errfile <- rdata$errfile - # errfile <- list.files(pattern = "^ERROR") - error <- length(errfile) > 0 - # #see if NP_RF or IT_RF made anyway (i.e. is >1MB in size) - success <- rdata$success - # reportType <- 1 - # success <- file.info(c("NP_RF0001.TXT", "IT_RF0001.TXT")[reportType])$size >= 1000 - if (success) { - # TODO:create r6 object - - report_file <- system.file("report/report.html", package = "Pmetrics") - manual_file <- system.file("manual/index.html", package = "Pmetrics") - html <- readr::read_file(report_file) - html <- gsub("", manual_file, html) - - - # red Summary - if (error) { - html <- gsub("", "red", html) - } - # Generate plots - thisData <- switch(reportType, - rdata$NPdata, - rdata$ITdata - ) - for (i in 1:thisData$numeqt) { - tryCatch( - plot.PM_op(rdata$op, outeq = i, pred.type = "pop") %>% - plotly::as_widget() %>% - htmlwidgets::saveWidget(sprintf("op_pop%i.html", i), libdir = "deps", selfcontained = F), - error = function(e) { - message("Unable to generate obs vs. pop pred plot") - print(e) - return(invisible(NULL)) - } - ) - - tryCatch( - plot.PM_op(rdata$op, outeq = i) %>% - plotly::as_widget() %>% - htmlwidgets::saveWidget(sprintf("op_ind%i.html", i), libdir = "deps", selfcontained = F), - error = function(e) { - message("Unable to generate obs vs. post pred plot") - print(e) - return(invisible(NULL)) - } - ) - html <- gsub("", sprintf('
-
-

Output %i

-
-
-
-

Population

- -
-
-
-
-

Individual

- -
-
', i, i, i), html) - } - - - tryCatch( - plot.PMcycle(rdata$cycle) %>% - plotly::as_widget(height = "1060px", width = "500px") %>% - htmlwidgets::saveWidget("cycle.html", libdir = "deps", selfcontained = F), - error = function(e) { - message("Unable to generate cycle plot") - print(e) - return(invisible(NULL)) - } - ) - - pmfinal_height <- ((length(names(rdata$final$popMean)) - 1) %/% 2) * 500 - - tryCatch( - plot.PM_final(rdata$final) %>% - plotly::as_widget(final, height = sprintf("%ipx", pmfinal_height), width = "1420px") %>% - htmlwidgets::saveWidget("final.html", libdir = "deps", selfcontained = F), - error = function(e) { - message("Unable to generate final plot") - print(e) - return(invisible(NULL)) - } - ) - - html <- gsub("", sprintf("%ipx", pmfinal_height), html) - - # Edit HTML - - if (reportType == 1) { - html <- gsub("", paste0( - '

Support Points

', - makeHTMLdf(rdata$final$popPoints, 3), "
" - ), html) - } - report.table <- data.frame( - mean = t(rdata$final$popMean), - sd = t(rdata$final$popSD), - CV = t(rdata$final$popCV), - var = t(rdata$final$popVar), - median = t(rdata$final$popMedian), - shrink = t(100 * rdata$final$shrinkage) - ) - names(report.table) <- c("Mean", "SD", "CV%", "Var", "Median", "Shrink%") - html <- gsub("", paste0( - '

Parameter Values Summary

', - makeHTMLdf(report.table, 3), "
" - ), html) - - if (thisData$nranfix > 0) { - ranfixdf <- data.frame(Parameter = thisData$parranfix, Value = thisData$valranfix) - html <- gsub("", paste0( - '

Population Fixed (but Random) Values

', - makeHTMLdf(ranfixdf, 3), "
" - ), html) - } - if (thisData$nofix > 0) { - fixdf <- data.frame(Parameter = thisData$parfix, Value = thisData$valfix) - html <- gsub("", paste0( - '

Population Fixed (and Constant) Values

', - makeHTMLdf(fixdf, 3), "
" - ), html) - } - # covariance matrix - html <- gsub("", paste0( - '

Covariance Matrix

', - makeHTMLdf(rdata$final$popCov, 3), "
" - ), html) - - # correlation matrix - html <- gsub("", paste0( - '

Correlation Matrix

', - makeHTMLdf(rdata$final$popCor, 3), "
" - ), html) - - - - if (thisData$nofix == 0) { - parfix <- "There were no constant fixed parameters." - } else { - parfix <- paste("Constant fixed parameters:", paste(thisData$parfix, collapse = ", ")) - } - if (thisData$nranfix == 0) { - parranfix <- "There were no random fixed parameters." - } else { - parranfix <- paste("Random fixed parameters:", paste(thisData$parranfix, collapse = ", ")) - } - ilog <- thisData$ilog - if (is.null(thisData$converge)) { - same <- 0 - for (i in 2:length(ilog)) { - if ((ilog[i] - ilog[i - 1]) < 1e-04) same <- same + 1 - } - if (same %% 11 == 0) { - coninterp <- " - The run converged." - confor1 <- "" - confor2 <- "" - } else { - coninterp <- " *The run did not converge before the last cycle." - confor1 <- "" - confor2 <- "" - html <- gsub("", "red", html) - } - } else { - coninterp <- switch(1 + thisData$converge, - " *The run did not converge before the last cycle.", - " - The run converged.", - "", - " *The run ended with a Hessian Error." - ) - confor1 <- switch(1 + thisData$converge, - "", - "", - "", - "" - ) - confor2 <- switch(1 + thisData$converge, - "", - "", - "", - "" - ) - html <- gsub("", "red", html) - } - if (reportType == 1 && !is.null(thisData$prior)) { - # this will only be for NPAG - extra <- paste("Prior density: ", c("Non-uniform (prior.txt)", "Uniform")[1 + as.numeric(thisData$prior == "UNIFORM")], "
", - "Assay error model: ", switch(thisData$ERRmod, - "SD", - "SD, gamma", - "SD, lambda", - "gamma" - ), "
", - sep = "" - ) - } else { - extra <- "" - } - - # no error, but alert if no convergence - # TODO: This code detects if the run does not converged, how are we going to show that? - # writeHTML(ifelse(coninterp == " - The run converged.", - # "", - # "")) - - - fixedvar <- "" - html <- gsub("", paste("Engine: ", c("NPAG", "IT2B")[reportType], "
", - "Computation mode: ", c("Serial", "Parallel")[1 + as.numeric(parallel)], "
", - "Output file: ", "/IT_RF0001.TXT target=_blank>")[reportType], file.path(wd), c("/NP_RF0001.TXT
", "/IT_RF0001.TXT
")[reportType], - "Random parameters: ", paste(paste(thisData$par, collapse = ", "), fixedvar, sep = " "), "
", - parranfix, "
", parfix, "
", - "Number of analyzed subjects: ", thisData$nsub, "
", - "Number of output equations: ", thisData$numeqt, "
", - "Number of cycles: ", thisData$icyctot, " ", confor1, coninterp, confor2, "
", - "Additional covariates: ", paste(thisData$covnames, collapse = ", "), "
", extra, "", - sep = "" - ), html) - - - if (thisData$negflag) { - html <- gsub("", "WARNING: There were negative pop/post predictions.
", html) - } - if (!is.na(elapsed)) { - html <- gsub("", paste("Elapsed time for this run was", elapsed, attr(elapsed, "units"), "
"), html) - } - - # system(paste0("cp ",report_file," /NPAGreport.html")) - readr::write_file(html, c("NPAGreport.html", "IT2Breport.html")[reportType]) - } else { - error_file <- paste(path.package("Pmetrics"), "/report/error.html", sep = "") - html <- readr::read_file(error_file) - - errmessage <- readLines(errfile) - errmessage <- paste(errmessage, collapse = "") - errmessage <- gsub(" ", " ", errmessage) - errmessage <- sub("^ *", "", errmessage) - - html <- gsub("", paste0("

ERROR REPORT

", errmessage), html) - readr::write_file(html, c("NPAGreport.html", "IT2Breport.html")[reportType]) - } - setwd(cwd) -} - - -makeRdata <- function(wd, remote, reportType) { - setwd(wd) - errfile <- list.files(pattern = "^ERROR") - # error <- length(errfile) > 0 - # see if NP_RF or IT_RF made anyway (i.e. is >1MB in size) - success <- file.info(c("NP_RF0001.TXT", "IT_RF0001.TXT")[reportType])$size >= 1000 - - if (success) { - # run completed - # open and parse the output - if (reportType == 1) { - # NPAG - PMdata <- suppressWarnings(tryCatch(NPparse(), error = function(e) { - e <- NULL - cat("\nWARNING: The run did not complete successfully.\n") - })) - # make the posterior predictions - post <- suppressWarnings(tryCatch(makePost(NPdata = PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of posterior Bayesian predictions at time ttpred; 'PMpost' object not saved.\n\n") - })) - # make the population predictions - pop <- suppressWarnings(tryCatch(makePop(NPdata = PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of population predictions at time tpred; 'PMpop' object not saved.\n\n") - })) - } else { # IT2B - PMdata <- suppressWarnings(tryCatch(ITparse(), error = function(e) { - e <- NULL - cat("\nWARNING: The run did not complete successfully.\n") - })) - } - # both NPAG and IT2B - cat("\n\n") - flush.console() - if (is.null(PMdata$nranfix)) PMdata$nranfix <- 0 - op <- suppressWarnings(tryCatch(makeOP(PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of observed vs. population predicted data; 'PMop' object not saved.\n\n") - })) - cycle <- suppressWarnings(tryCatch(makeCycle(PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of cycle information; 'PMcycle' object not saved.\n\n") - })) - final <- suppressWarnings(tryCatch(makeFinal(PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of final cycle parameter values; 'PMfinal' object not saved.\n\n") - })) - if (PMdata$mdata != "NA") { - mdata <- PMreadMatrix(paste("../inputs/", PMdata$mdata, sep = ""), quiet = T) - } else { - mdata <- NA - } - cov <- suppressWarnings(tryCatch(makeCov(PMdata), error = function(e) { - e <- NULL - cat("\nWARNING: error in extraction of covariate-parameter data; 'PMcov' object not saved.\n\n") - })) - if (PMdata$mdata != "NA") { - mdata <- PMreadMatrix(paste("../inputs/", PMdata$mdata, sep = ""), quiet = T) - } else { - mdata <- NA - } - model <- list.files("../inputs") %>% - .[grepl(".txt$", .)] %>% - paste0("../inputs/", .) %>% - .[[1]] %>% - PM_model$new(.) - cat(paste("\n\n\nSaving R data objects to ", wd, "......\n\n", sep = "")) - cat("\nUse PM_load() to load them.\n") - cat("\nThe following objects have been saved:\n") - cat(c("\nNPdata: All output from NPAG\n", "\nITdata: All output from IT2B\n")[reportType]) - if (reportType == 1 && !all(is.null(pop))) cat("pop: Population predictions at regular, frequent intervals\n") - if (reportType == 1 && !all(is.null(post))) cat("post: Posterior predictions at regular, frequent inteverals\n") - if (!all(is.null(final))) cat("final: Final cycle parameters and summary statistics\n") - if (!all(is.null(cycle))) cat("cycle: Cycle information\n") - if (!all(is.null(op))) cat("op: Observed vs. population and posterior predicted\n") - if (!all(is.null(cov))) cat("cov: Individual covariates and Bayesian posterior parameters\n") - if (length(mdata) > 1) cat("mdata: The data file used for the run\n") - - - if (reportType == 1) { - NPAGout <- list(NPdata = PMdata, pop = pop, post = post, final = final, cycle = cycle, op = op, cov = cov, data = mdata, model = model, errfile = errfile, success = success) - save(NPAGout, file = "PMout.Rdata") - # Hacky return to deal with Rservex bug T.T - if (remote) { - return("ok") - } - return(NPAGout) - } - if (reportType == 2) { - IT2Bout <- list(ITdata = PMdata, final = final, cycle = cycle, op = op, cov = cov, data = mdata, model = model, errfile = errfile, success = success) - save(IT2Bout, file = "PMout.Rdata") - if (remote) { - return("ok") - } - return(IT2Bout) - } - } -} - -# HTML tools -------------------------------------------------------------- - -# function to process data.frames -makeHTMLdf <- function(df, ndigit) { - Nrow <- nrow(df) - Ncol <- ncol(df) - dfScript <- vector("character") - dfScript <- append(dfScript, '') - dfScript <- append(dfScript, "") - dfScript <- append(dfScript, "") - dfScript <- append(dfScript, "") - for (j in 1:Ncol) { - dfScript <- append(dfScript, paste('", sep = "")) - } - dfScript <- append(dfScript, "") # end first row headers - for (i in 1:Nrow) { - dfScript <- append(dfScript, "") - dfScript <- append(dfScript, paste("", sep = "")) - for (j in 1:Ncol) { - dfScript <- append(dfScript, ifelse(inherits(df[i, j], "numeric"), - paste("", sep = ""), - paste("") - } - dfScript <- append(dfScript, "") - dfScript <- append(dfScript, "
', colnames(df)[j], "
", rownames(df)[i], "", sprintf(paste("%.", ndigit, "f", sep = ""), round(as.numeric(df[i, j]), ndigit)), "", df[i, j]) - )) - } - dfScript <- append(dfScript, "
") - - return(paste(dfScript, collapse = "")) -} -# end makeHTMLdf function - -writeHTML <- function(x) { - .HTMLfile <- get(".HTMLfile", pos = parent.frame()) - cat(c(paste(x, collapse = "\n"), "\n"), file = .HTMLfile, append = T) -} - - -# Tex functions ----------------------------------------------------------- -# written by Alona Kryschenko - -TEX <- function(x) { - .TEXfile <- get(".TEXfile", pos = parent.frame()) - cat(paste(x, collapse = ""), "\n", file = .TEXfile, append = T) -} - -# TEXstart <- function(outdir, filename) { -# file <- file.path(outdir, paste(filename, ".tex", -# sep = "")) -# CurrentTEXfile <<- file -# s <- paste('\\documentclass{article} -# \\usepackage{graphicx} -# \\usepackage[colorlinks]{hyperref} -# \\usepackage{url} -# \\usepackage{float} -# \\usepackage[landscape]{geometry}') -# #\\begin{document}') -# cat(s, '\n', file = file, append = FALSE) -# -# CurrentTEXfile -# } - -# TEXend <- function() { -# cat('\\end{document}', '\n', file = CurrentTEXfile, append = TRUE) -# } diff --git a/Archived/PMsave.R b/Archived/PMsave.R deleted file mode 100755 index d1b6f5db5..000000000 --- a/Archived/PMsave.R +++ /dev/null @@ -1,64 +0,0 @@ -#' Saves Pmetrics objects -#' -#' Any objects that are made during the course of analysis in R can be added to the saved data -#' that are automatically generated at the end of an NPAG or IT2B run and loaded with \code{\link{PMload}}. -#' Objects with the same run number will be saved as a group. So if a user has made a new object called -#' lm.1 that contains regressions related to run 1, it will be saved with any other object -#' that also has .1 at the end. -#' -#' Additionally, other objects can be saved via the \dots argument. For exmaple PMsave(1,lm) will -#' save any object with .1 at the end, plus an object named "lm". All objects will be suffixed -#' with the run number when loaded back with \code{\link{PMload}}. -#' -#' @title Save Pmetrics objects -#' @param run The numerical value of the run number of the objects to be saved. -#' This parameter must be specified, as it also determines where to save the revised output. -#' @param \dots Additional objects to be saved, which do not need to be suffixed with the run number, -#' e.g. var1, var2, var3. -#' @param quiet Suppress written report. Default is \code{FALSE}. -#' @author Michael Neely -#' @seealso \code{\link{PMload}} -#' @export - - -PMsave <- function(run,...,quiet=F){ - if(missing(run)){ - stop("\nPlease specify a run number.") - } - if(!file.exists(as.character(run))) {stop(paste(run," is not a folder in the current working directory.\n",sep=""))} - #get the file name - npag <- length(list.files(paste(run,"outputs",sep="/"),pattern="NPAGout.Rdata"))>0 - it2b <- length(list.files(paste(run,"outputs",sep="/"),pattern="IT2Bout.Rdata"))>0 - - if(npag){file.name <- "NPAGout.Rdata" - } else { - if(it2b){ - file.name <- "IT2Bout.Rdata" - } else {stop(paste("Neither NPAGout.Rdata or IT2Bout.Rdata are in ",run,"/outputs",sep=""))} - } - - - obj <- ls(name=1,pattern=glob2rx(paste("*.",run,sep=""))) - otherObj <- unlist(deparse(substitute(...))) - - if(otherObj!="NULL"){ - allObj <- c(obj,otherObj) - } else {allObj <- obj } - - if(!quiet) {cat(paste("The following objects were saved to ",paste(run,"outputs",file.name,sep="/"),":\n",paste(allObj,collapse="\n"),sep=""))} - - #strip the numbers and save - if(npag){ - NPAGout <- lapply(allObj,get) - names(NPAGout) <- gsub(paste("\\.",run,sep=""),"",allObj) - save(NPAGout,file=paste(run,"outputs/NPAGout.Rdata",sep="/")) - } - if(it2b){ - IT2Bout <- lapply(allObj,get) - names(IT2Bout) <- gsub(paste("\\.",run,sep=""),"",allObj) - save(IT2Bout,file=paste(run,"outputs/IT2Bout.Rdata",sep="/")) - } - - -} - diff --git a/Archived/PMupdate.R b/Archived/PMupdate.R deleted file mode 100755 index 7b2ce528d..000000000 --- a/Archived/PMupdate.R +++ /dev/null @@ -1,101 +0,0 @@ -#' Download and install Pmetrics updates from LAPK website -#' -#' @title Download and install Pmetrics updates -#' @param force Boolean operator to force downloading and installing. Default is false. -#' @return The latest system-specific Pmetrics update will be downloaded to a temporary -#' folder and then installed. You need to restart R (Rstudio) and then reload Pmetrics with -#' the \code{library(Pmetrics)} command to complete the installation. -#' @author Michael Neely - - -PMupdate <- function(force = F) { - gitREST <- curl::curl(url = "https://api.github.com/repos/LAPKB/Pmetrics/releases") # github api - - currentVersion <- package_version(suppressWarnings( - tryCatch( - jsonlite::fromJSON(gitREST)$name[1] %>% - stringr::str_extract("\\d+\\.\\d+\\.\\d+$"), - error = function(e) e <- "0.1" - ) - )) - if (currentVersion == "0.1") { - cat("LAPKB github server not available. Check your internet connection.\n") - return(invisible(FALSE)) - } - installedVersion <- packageVersion("Pmetrics") - if (!force & installedVersion >= currentVersion) { - cat("You have the most current version of Pmetrics.\n") - return(invisible(FALSE)) - } else { - # check for remotes - remotes_installed <- requireNamespace("remotes", quietly = TRUE) - if (!remotes_installed) { - cat("The remotes package is required to install from github.\n") - cat(paste0( - "Enter ", crayon::blue("<1>"), " to install remotes or ", - crayon::blue("<2>"), " to abort.\n" - )) - ans <- "" - while (ans != "1" & ans != "2") { - ans <- readline("Response: ") - } - if (ans == "1") { - install.packages("remotes") - } else { - cat("Pmetrics update aborted.\n") - return(invisible(FALSE)) - } - } - - # check for options - opt_dir <- dplyr::case_when( - getOS() == 1 | getOS() == 3 ~ "~/.PMopts", # Mac, Linux - getOS() == 2 ~ file.path(Sys.getenv("APPDATA"), "PMopts") - ) - - if (!dir.exists(opt_dir)) { - cat(paste0(crayon::red("WARNING: "), "Your Pmetrics options appear to be stored within the package architecture.\n")) - cat("This means they will be reset to default values after the update.\n") - cat("If you wish to move them to a hidden external directory, use movePMoptions().\n") - cat(paste0( - "Enter ", crayon::blue("<1>"), " to proceed with update or ", - crayon::blue("<2>"), " to abort.\n" - )) - ans <- "" - while (ans != "1" & ans != "2") { - ans <- readline("Response: ") - } - if (ans == "2") { - cat("Pmetrics update aborted.\n") - return(invisible(FALSE)) - } - } - - # update - OS <- getOS() - if (OS != 2) { # Mac/Linux - Pmetrics_installed <- tryCatch(remotes::install_github(repo = "LAPKB/Pmetrics", force = force), - error = function(e) -1 - ) - if (Pmetrics_installed != -1) { - cat("\nInstallation was successful. You may need to restart R/Rstudio to complete the process.\n") - return(invisible(TRUE)) - } - } else { # Windows - cat(paste0(crayon::blue("NOTE: "), "Windows is unable to update loaded packages.\nPlease do the following.\n")) - cat("\n1. Paste the following into the R console: detach(\"package:Pmetrics\", unload = TRUE)\n") - if (force) { - cat("2. Paste the following into the R console: remotes::install_packages(repo = \"LAPKB/Pmetrics\", force = T)\n") - } else { - cat("2. Paste the following into the R console: remotes::install_packages(repo = \"LAPKB/Pmetrics\")\n") - } - cat("3. Allow Rstudio to restart session.\n") - cat("4. Rstudio will complete installation.\n") - cat("5. You may need to restart Rstudio when installation is complete.\n") - } - - - - return(invisible(TRUE)) - } -} diff --git a/Archived/Pmetrics.css b/Archived/Pmetrics.css deleted file mode 100755 index 1941011ae..000000000 --- a/Archived/Pmetrics.css +++ /dev/null @@ -1,194 +0,0 @@ - -body { font-family: "Helvetica Neue", Helvetica, "Arial Unicode MS", Arial, sans-serif; font-size: 16px; font-style: normal; -font-weight: 200; color: rgba(2,8,100,0.8); background-color: rgba(2,8,100,0.1); text-align: left} - -hr { - color:rgba(2,8,100,1); - background-color:rgba(2,8,100,1); - height:3px - } - -h1 { font-family: Georgia, serif; font-size: 24px; font-style: normal; font-weight: 300; -color: #FFFFFF; background-color: rgba(2,8,100,0.8); text-align: center; padding:7px} -h2 { font-size: 18px; font-style: normal; font-weight: 300; color: rgba(2,8,100,0.8);text-align: left} -h3 { font-size: 18px; font-style: normal; font-weight: 300; color: #808080} -h4 { font-size: 10px; font-style: normal; font-weight: 300; color: white; text-align: left} - -span.emphasize { - font-size:18px; - font-weight:300; - color:rgba(2,8,100,1); - border-radius: 10px; - padding:5px - } - -span.alert { - color:rgba(145,17,16,1); -} - -li { font-family: Arial, Helvetica, sans-serif; font-size: 14px; text-align:left } - -a { - text-decoration:none; - color:rgba(145,17,16,1); -} - -p { font-family: "Helvetica Neue", Helvetica, "Arial Unicode MS", Arial, sans-serif; font-size: 16px; color: rgba(2,8,100,0.8); background-color:transparent; text-align:left} - -div.highlight { - background-color:rgba(145,17,16,1); - border-radius: 20px; - margin: 48px auto; - width:400px; - padding:3px; -} - -div.center -{ - text-align: center; - background-color:transparent; -} -div.center table -{ - margin: 0 auto; - text-align: left; -} -div.center p -{ - margin:0 auto; - text-align: center; - padding:3px; -} - -div.container { - margin:auto; - overflow:auto; -} - -/* resize images */ -div.container img { - width: auto; - height: 65%; -} - -img.pmetrics { - height:50%; -} - - - -div.wrap { - width:100%; - left:auto -} - -div.leftcol { - float:left; - width : 50%; - font: inherit; - } - -div.rightcol { - float:right; - width:50%; - font: inherit; - } - -div.fullrightcol{ - float:right; - width:auto; - text-align:right; -} - -div.header -{ - width: 100%; - background-color: #808080; - height: 80px; - text-align: left; - position: relative; - top:0px; - padding:5px; -} - - -table -{ - border-collapse:collapse; - border-color:rgba(2,8,100,0.8); - border-width:1px; - border-style:solid; -} -th, td -{ - border-width:1px; - border-color:rgba(2,8,100,0.8); - border-style:solid -} - -tr {font-family: "Helvetica Neue", Helvetica, "Arial Unicode MS", Arial, sans-serif; font-size: 14px; font-style: normal ; padding:0 0} -tr.firstline {background-color:rgba(2,8,100,1); color:rgba(255,255,255,0.8);text-align:center; font-weight:200} -tr.ListBackTitle {color: #FFFFFF; background-color: #4F4F4F;text-align: left;font-weight:normal} -td {background-color: #FFFFFF; padding:0 0} -td.ListBackMain{background-color: #E0E0E0; padding:0 0} -td.firstcolumn{padding:5 10; color:#FFFFFF; background-color: #808080; text-align: right} -td.cellinside{padding:5 10; background-color: #FFFFFF; text-align: right} - -.tabs input[type=radio] { -position: absolute; -top: -9999px; -left: -9999px; -} -.tabs { -float: none; -list-style: none; -position: relative; -padding: 0; -/*margin: 75px auto;*/ -} -.tabs li{ -float: left; -} -.tabs label { -display: block; -padding: 10px 20px; -border-radius: 10px; -color: rgba(2,8,100,1); -font-size: 18px; -font-weight: 200; -font-family: "Helvetica Neue", Helvetica, "Arial Unicode MS", Arial, sans-serif; -cursor: pointer; -position: relative; -top: 3px; -} - - -.tabs label:hover { -background: rgba(255,255,255,0.5); -top: 0; -} - - -[id^=tab]:checked + label { -background: rgba(2,8,100,1); -color: white; -top: 0; -} - - -[id^=tab]:checked ~ [id^=tab-content] { -display: block; -} -.tab-content{ -z-index: 2; -display: none; -text-align: left; -width: 100%; -padding-top: 10px; -padding: 15px; -position: absolute; -top: 53px; -left: 0; -box-sizing: border-box; -} - diff --git a/Archived/Pmetrics_old.css b/Archived/Pmetrics_old.css deleted file mode 100755 index 049e1ef64..000000000 --- a/Archived/Pmetrics_old.css +++ /dev/null @@ -1,25 +0,0 @@ -body { font-family: Arial, Helvetica, sans-serif; font-size: 100%; font-style: normal; font-weight: normal; color: #000000; background-color: #FFFFFF; text-align: left} - -h1 { font-family: Arial, Helvetica, sans-serif; font-size: 1.8em; font-style: normal; font-weight: normal; color: #FFFFFF; background-color: #990000; text-align: center} -h2 { font-family: Arial, Helvetica, sans-serif; font-size: 1.2em; font-style: normal; font-weight: normal; color: #990000; background-color: #FFFFFF; text-align: left} -h3 { font-family: Arial, Helvetica, sans-serif; font-size: 1.2em; font-style: normal; font-weight: bold; color: #990000; background-color: #FFFFFF} -span, h4 { font-family: Arial, Helvetica, sans-serif; font-size: 0.8em; font-style: normal; font-weight: normal; color: #808080; text-align: center} - -li { font-family: Arial, Helvetica, sans-serif; font-size: 1em; text-align:left } - -a { text-decoration:none} - -p { font-family: Arial, Helvetica, sans-serif; font-size: 1em; font-weight:normal; color: #000000; background-color: #FFFFFF; text-align:left} - -table {border-collapse:collapse} -table, th, td {border: 1px solid black} -tr{font-family: Arial, Helvetica, sans-serif; font-size: 1em; font-style: normal ; padding:0 0} -tr.firstline{color: #FFFFFF; background-color: #000000;text-align: center; font-weight: bold} -tr.ListBackTitle{color: #FFFFFF; background-color: #000000;text-align: left;font-weight: bold} -td{background-color: #FFFFFF; padding:0 0} -td.ListBackMain{background-color: #E0E0E0; padding:0 0} -td.firstcolumn{padding:5px 10px; background-color: #C0C0C0; text-align: right} -td.cellinside{padding:5px 10px; background-color: #FFFFFF; text-align: right} - - - diff --git a/Archived/examples_old.R b/Archived/examples_old.R deleted file mode 100755 index 0872e43b7..000000000 --- a/Archived/examples_old.R +++ /dev/null @@ -1,785 +0,0 @@ -# INTRODUCTION ------------------------------------------------------------ - -# Lines that start with "#" are comments and ignored by R. Follow the -# directions in them. Execute each non-comment line in this script by -# putting your cursor on it and sending it to the R console. -# You can do this in several ways: -# Windows -# R-studio -# 1) The Run button at the top -# 2) Ctrl-Enter -# R GUI - when the script window is active -# 1) The Run line or selection button at the top -# 2) Ctrl-R -# Mac -# R-studio -# 1) The Run button at the top -# 2) Command-Enter -# R GUI -# 1) Command-Enter - -# This script also serves to introduce several R programming functions -# and techniques. For any function, you can get help by typing ?function_name -# in the R console (the lower left window pane in RStudio). - -# Load Pmetrics into memory. You must include this line at the beginning -# of every script. - -library(Pmetrics) - -# EXERCISE 1 - NPAG RUN ------------------------------------------------ - -# EXAMPLE NPAG RUN - tlag, ka, kel, vol - -# It is useful to annotate your runs as above, so that you can remember -# what you did later! - - -# Tell R where your working directory is going to be. -# Windows users: Make sure that you separate directories with a -# forward slash "/" or double backslashes "\\". Unfortunately, Windows is the only OS that uses -# backslashes "\", so R conforms to Unix/Linux style. - -wd <- "##WD##" - -wd <- glue::glue("{getwd()}/inst/Examples/Runs") - -# change to the working directory to the Examples folder -setwd(wd) - -# DATA OBJECT - -# Pmetrics always needs data and a model to run -# create our first data object - -# create a new data object by reading a file -# set the limit of quantification (loq) to 1: see ?PM_data for help -exData <- PM_data$new(data = "../src/ex.csv", loq = 1) - -# you can look at this file directly by opening it in -# a spreadsheet program like Excel, or a text editor - -# exData is an R6 object, which means that contains both data and methods to -# process that data, for example: -exData$data # contains your original datafile -exData$standard_data # contains the standardized and validated data, -exData$summary() # prints the summary of the data to the terminal, or - -# another way to do that is using the more common S3 framework in R: -summary(exData) - -# To look at the contents of an object: -names(exData) - -# other examples of things that can be done with this object are -exData # view the original data in the viewer -exData$print(standard = TRUE) # view the standardized data in the viewer -exData$print(viewer = FALSE) # view original data in console -exData$plot() # plot the raw data; more on that later - -# MODEL OBJECT -# You can specify a model by reading a file or directly as an object. We'll do both. -# The following code creates the same model as in /src/model.txt file. -# See PMmanual() for details on creating models in R compared to text files. -# The advantage of creating them in R is that one does not need to copy model -# files into folders to provide necessary inputs. - -mod1 <- PM_model$new( - pri = list( - Ka = ab(0.1, 0.9), - Ke = ab(0.001, 0.1), - V = ab(30, 120), - lag1 = ab(0, 4) - ), - cov = list( - wt = interp(), - africa = interp("none"), - age = interp(), - gender = interp("none"), - height = interp() - ), - eqn = function() { - two_comp_bolus - }, - lag = function() { - lag[1] <- lag1 - }, - out = function() { - Y[1] <- X[2] / V - }, - err = list( - proportional(5, c(0.02, 0.05, -0.0002, 0)) - ) -) - - -# look at it -mod1 - -# plot it -mod1$plot() - - -# in the working directory we have another file "model.txt" that contains the old -# representation of the same model we previously presented, let's take a look at it. -system("cat ../src/model.txt") - -# PM_model$new() also accepts the path to a model file -# create the same model using this file -mod1b <- PM_model$new("../src/model.txt") -mod1b - -# PM_model provides a method to update the different elements of a model, for example: -mod1b$update( - pri = list( - ka = ab(0.001, 5) - ) -) - -# It is case sensitive, so ka is different from Ka. To remove a parameter, set it to NULL. - - -mod1b$arg_list$pri - -# to copy a model use the $clone() method. -mod1b <- mod1$clone() - -# simply using mod1b <- mod1 will cause mod1b to be changed if mod1 is changed, -# as R6 objects use reference semantics. For more details you can refer to -# https://adv-r.hadley.nz/r6.html, Section 14.4. - -# lastly, use the app! PMmanual() and the article on models for details on this. -build_model() # start from scratch -build_model(exData) # start with data to match covariates -build_model(mod1) # start with a model and update it - - - -# To keep everything tidy, we are working in a folder specific to store the runs - - -run1 <- mod1$fit(data = exData, run = 1, overwrite = TRUE) # execute the fit and return the results to run1 - - -# -# After the run is complete the results are returned to the assigned object, here 'run1' - -# you need get the extracted information back into R. -# They will be sequentially numbered as /1, /2, /3,... in your working directory. - -# One benefit of having this fit object is that it is possible to run multiple -# fittings without needing to move data files around - -getwd() -list.files() - -# Result Object - the result is already returned to run1 above, but if you need to load it later, -# you can use PM_load() -run1 <- PM_load(1) - -# Create a PM_result object by reading a run folder. The "1" in the parentheses tells Pmetrics to -# look in the /1 folder. - -# Plot the raw data using R6 with various options. Type ?plot.PM_data in the R console for help. -run1$data$plot() -run1$data$plot(overlay = FALSE, xlim = c(119, 145)) -run1$data$plot( - xlim = c(119, 146), group = "gender", group_names = c("Male", "Female"), - marker = list(color = c("blue", "red"), symbol = c("circle", "triangle-up")) -) - -run1$data$plot(xlim = c(119, 146), group = "gender", group_names = c("Male", "Female"), marker = list(color = "Set2")) - - -# The following are the older S3 method with plot(...) for the first two examples -# You can use R6 or S3 for any Pmetrics object -# We will focus on R6 as the more modern way. -plot(run1$data) - -# here's a summary of the original data file; ?summary.PMmatrix for help -run1$data$summary() - -# Plot some observed vs. predicted data. Type ?plot.PMop in the R console for help. -# Click on points to highlight all points from the same subject. -run1$op$plot() -run1$op$plot(pred.type = "pop") -run1$op$plot(line = list(lm = list(ci = 0, color = "red"), loess = FALSE)) - -# the original op object data can be accessed via -run1$op$data - -# get a summary with bias and imprecision of the population predictions; -# ?summary.PMop for help -run1$op$summary(pred.type = "pop") - -# the S3 way -summary(run1$op, pred.type = "pop") - -# look at the summary for the posterior predictions (default pred.type) based -# on means of parameter values -run1$op$summary(icen = "mean") - -# The OP plot can be disaggregated into a Tidy compatible format from $data (see https://www.tidyverse.org/) -# This allow pre processing in ways more flexible than the default plot method. -library(tidyverse) -run1$op$data %>% plot() -run1$op$data %>% - filter(pred > 5) %>% - filter(pred < 10) %>% - summary() - -# see a header with the first 10 rows of the op object -head(run1$op$data, 10) - - -# Plot final population joint density information. Type ?plot.PMfinal in the R console for help. -run1$final$plot() - -# add a kernel density curve -run1$final$plot(line = list(density = list(color = "red"))) -run1$final$data %>% plot() - - -# A bivariate plot. Plotting formulae in R are of the form 'y~x' -run1$final$plot(ke ~ v, - marker = list(color = "red", symbol = "diamond") -) - - - -# or the S3 way -plot(run1$final) - -# The original final object can be accessed using -run1$final$data -names(run1$final$data) - -# see the population points -run1$final$popPoints - -# or -run1$final$data$popPoints - -# see the population mean parameter values -run1$final$popMean - -# see a summary with confidence intervals around the medians -# and the Median Absolute Weighted Difference (MAWD); -# ?summary.PMfinal for help -run1$final$summary() - -# summarize the cycle information; ?summary.PM_cycle for help -run1$cycle$summary() -run1$cycle$data %>% summary() - - -# Plot cycle information -# Type ?plot.PM_cycle in the R console for help. -run1$cycle$plot() - -# names of the cycle object; ?makeCycle for help -names(run1$cycle$data) - -# gamma/lamda value on last 6 cycles -tail(run1$cycle$data$gamlam) - -# Plot covariate information. Type ?plot.PMcov in the R console for help. -# Recall that plotting formulae in R are of the form 'y~x' -run1$cov$plot(v ~ wt) - -run1$cov$data %>% - filter(age > 25) %>% - plot(v ~ wt) - -# Plot -run1$cov$plot(ke ~ age, - line = list(loess = FALSE, lm = TRUE), - marker = list(symbol = 3) -) - -# Another plot with mean Bayesian posterior parameter and covariate values... -# Remember the 'icen' argument? -run1$cov$plot(v ~ wt, icen = "mean") - -# When time is the x variable, the y variable is aggregated by subject. -# In R plot formulae, calculations on the fly can be included using the I() function -run1$cov$plot(I(v * wt) ~ time) - -# The previous cov object can be seen via: -run1$cov - -# but to access individual elements, use: -run1$cov$data[, 1:3] # for example -names(run1$cov) - -# summarize with mean covariates; ?summary.PMcov for help -run1$cov$summary(icen = "mean") - - -# Look at all possible covariate-parameter relationships by multiple linear regression with forward -# and backward elimination - type ?PM_step in the R console for help. -run1$step() -# or on the cov object directly -run1$cov$step() -# icen works here too.... -run1$step(icen = "mean") -# forward elimination only -run1$step(direction = "forward") - - -# EXERCISE 2 - NPAG WITH COVARIATES --------------------------------------- - -# Again, without copying files, let's create another run object, this time using -# a model that include covariates - -# First clone mod1 -mod2 <- mod1$clone() - -# Then update it -mod2 <- mod2$update( - pri = list( - V0 = ab(30, 120), - V = NULL - ), - sec = function(x) { - V <- V0 * (WT / 55) - }, - err = list( - proportional(2.39, c(0.02, 0.05, -0.0002, 0), fixed = TRUE) - ) -) -# we can also make a model object by loading a file -mod2b <- PM_model$new("../src/model2.txt") - - -run2 <- mod2$fit(data = exData, run = 2, overwrite = TRUE) - -# for future loading -run2 <- PM_load(2) - - - - -# EXERCISE 3 - COMPARING MODELS ------------------------------------------- - - -# Let's compare model 1 and model 2. You can compare any number of models. -# Type ?PM_compare for help. -PM_compare(run1, run2) - - - -# EXERCISE 4 - MODEL VALIDATION ------------------------------------------- - -# MODEL VALIDATION EXAMPLES -# Example of Pmetrics visual predictive check and prediction-corrected visual predictive check -# for model validation - be sure to have executed the NPAG run above -# Type ?makeValid in the R console for help. -# Choose wt as the covariate to bin. Accept all default bin sizes. -run2$validate(limits = c(0, 3)) - -# To see what it contains, use: -run2$valid - -# Default visual predictive check; ?plot.PM_valid for help -run2$valid$plot() - -# or old S3 -plot(run2$valid) - - -# Generate a prediction-corrected visual predictive check; type ?plot.PMvalid in the R console for help. -run2$valid$plot(type = "pcvpc") - -# Create an npde plot -run2$valid$plot(type = "npde") - -# Here is another way to generate a visual predicive check... -npc_2 <- run2$valid$simdata$plot(obs = run2$op, log = FALSE, binSize = 0.5) - -# The jagged appearance of the plot when binSize=0 is because different subjects have -# different doses, covariates, and observation times, which are all combined in one simulation. -# Collapsing simulation times within 1 hour bins (binSize=1) smooths -# the plot, but can change the P-values in the numerical predictive check below. - -npc_2 -# ...and here is a numerical predictive check -# P-values are binomial test of proportion of observations less than -# the respective quantile - - -# EXERCISE 5 - SIMULATOR RUN ---------------------------------------------- - -setwd(wd) -dir.create("../Sim") -setwd("../Sim") - -# The following will simulate 100 sets of parameters/concentrations using the -# first subject in the data file as a template. -# Limits are put on the simulated parameter ranges to be the same as in the model. -# The population parameter values from the NPAG run in exercise 2 are used for the Monte Carlo Simulation. -simdata <- run2$sim(include = 1, limits = NA, nsim = 100) - -# Below is the alternate way to simulate, which is particularly useful if you define -# your own population parameters. See ?SIMrun for details on this as well as -# the article on simulation linked by PMmanual(). -poppar <- list( - wt = 1, - mean = c(0.6, 0.05, 77.8, 1.2), - cov = diag(c(0.07, 0.0004, 830, 0.45)) -) - -simOther <- PM_sim$new( - poppar = poppar, data = exData, model = mod1, - include = 1, limits = NA, nsim = 100 -) - - -# simulate from a model with new data -sim_new <- run2$sim( - data = "../src/ptaex1.csv", - include = 2, limits = NA, - predInt = c(120, 144, 0.5) -) - - - -# Plot them; ?plot.PM_sim for help -simdata$plot() -simOther$plot() -sim_new$plot(log = FALSE) - -# Simulate using multiple subjects as templates -simdata <- run2$sim(include = 1:4, limits = NA, nsim = 100) - -# Plot the third simulation; use include/exclude to specify the ID numbers, -# which are the same as the ID numbers in the template data file -simdata$plot(include = 2) - -# or in S3 -plot(simdata$data, include = 3) - -# Parse and combine multiple files and plot them. Note that combining simulations from templates -# with different simulated observation times can lead to unpredictable plots -simdata2 <- run2$sim(include = 1:4, limits = NA, nsim = 100) -simdata2$plot() - -# simulate with covariates -# in this case we use the covariate-parameter correlations from run 2, which -# are found in the cov.2 object; we re-define the mean weight to be 50 with -# SD of 20, and limits of 10 to 70 kg. We fix africa, gender and height covariates, -# but allow age (the last covariate) to be simulated, using the mean, sd, and -# limits in the original population, since we didn't specify them. -# See ?SIMrun for more help on this and the Pmetrics manual. - -covariate <- list( - cov = run2$cov, - mean = list(wt = 50), - sd = list(wt = 20), - limits = list(wt = c(10, 70)), - fix = c("africa", "gender", "height") -) - -# now simulate with this covariate list object -simdata3 <- run2$sim(include = 1:4, limits = NA, nsim = 100, covariate = covariate) - -# compare difference in simulations without covariates simulated... -# PM_sim's plot function defaults to the first simulation if there -# are multiple simulations and "at" is not specified. -simdata$plot() - -# ...and with covariates simulated -simdata3$plot() - -# Here are the simulated parameters and covariates for the first subject's -# template; note that both wt and age are simulated, using proper covariances -# with simulated PK parameters -simdata3$data$parValues - -# We can summarize simulations too. See ?summary.PM_sim for help. -simdata3$summary(field = "obs", include = 3) - -# look in the working directory and find the "c_simdata.csv" and "c_simmodel.txt" files -# which were made when you simulated with covariates. Compare to original -# "simdata.csv" and "simmoddel.txt" files to note that simulated covariates become -# Primary block variables, and are removed from the template data file. - -# EXERCISE 6 - SAVING PMETRICS OBJECTS ------------------------------------ - -setwd(wd) - -# The following objects have methods to save them to or load them from files: -# PM_fit -# PM_result -# PM_sim -# PM_pta - -# Example - save the PM_result (run2) to the "2" folder -run2$save(file = "2/outputs/run2.rds") # rds is the recommended file extension -list.files("2/outputs") -copy_run2 <- PM_load(file = "2/outputs/run2.rds") -copy_run2 - -# If you want to save multiple objects into one single file, R provides the -# following functionality - -save(exData, mod1, run1, simdata, file = "2/test_drug.Rdata") -list.files("2") -load("2/test_drug.Rdata") - -# or -save.image("2/workspace.Rdata") # This will save all variables in your environment -list.files("2") -load("2/workspace.Rdata") - - -# EXERCISE 7 - CONTINUING RUNS OR EXTERNAL VALIDATIONS -------------------- - -# Example of a run with a non-uniform density -# This is a good way to continue a previous run, -# in this case it continues where run 1 left off - -# note that we can supply a run number to model, data, and prior arguments. The numbers do not -# have to be the same. This will copy the appropriate files from the specified run to be used -# in the current run. By specifying a prior, we are starting with the non-uniform density from the -# end of the specified fun. -run3 <- mod2$fit(data = exData, prior = 2) -run3 <- PM_load(3) - -# We could also generate Bayesian posterior parameter estimates for a new population this way: -# run3 <- mod2$fit(data=PM_data("newPop.csv"), prior = 2, cycles = 0) -# This won't run because we don't have a newPop.csv file, -# but shows you how it could be done. - - - -# EXERCISE 8 - PROBABILITY OF TARGET ATTAINMENT --------------------------- - -# Note: these can be computationally intense and take some time. - -# Examples of probability of target attainment analysis -# Be sure to have executed the NPAG run above and used PM_load(2) in EXERCISE 2 -# Type ?PM_sim, ?PM_pta, or ?plot.PM_pta into the R console for help. - - -# simulate with the template data file that contains different doses -# Look at PM_sim for help on arguments to this function, including predInt, -# seed, limits, nsim. - -simlist1 <- run1$sim( - limits = c(0, 3), data = "../src/ptaex1.csv", - predInt = c(120, 144, 0.5), seed = rep(-17, 4) -) - -# now simulate with covariates; make sure that you defined the covariate -# object first in Exercise 5 above and have loaded the results of Exercise 2 -# with PM_load(2) -simlist2 <- run2$sim( - limits = 5, data = "../src/ptaex1.csv", - predInt = c(120, 144, 0.5), seed = rep(-17, 4), - covariate = covariate -) - -# make the first PMpta object to calculate the time above each target for at -# least 60% of the dosing -# interval from 120 to 144 hours. Include labels for the simulations. -# ?makePTA for help -# define simulation labels first - -simlabels <- c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid") - -pta1_2 <- PM_pta$new( - simdata = simlist1, - target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), target_type = "time", - success = 0.6, start = 120, end = 144 -) - -pta1b_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, - target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), target_type = "time", - success = 0.6, start = 120, end = 144 -) - -# summarize the results -pta1_2$summary() - -# in the summary()$pta, reg_num is the simulation template ID number; -# target in this case is the MIC; prop_success is the proportion of the simulated -# profiles for each dose/MIC that are above the success threshold (0.6); pdi.mean and pdi.sd -# are the mean and standard deviation of the pharmacodynamic index (PDI), in this case proportion of the interval > MIC. -# In the $pdi, target and simnum are the same, but now the median and confidence -# intervals (default 95%) PDI are shown. -# ?summary.PMpta for help - -# Plot the first without covariates. We didn't include simulation -# labels in the makePTA command, so generics are used here, but we move it to -# the bottom left; ?legend for help on arguments to supply to the -# legend list argument to plot.PMpta. -pta1_2$plot(ylab = "Proportion with %T>MIC of at least 60%", grid = TRUE, legend = list(x = "bottomleft")) - -pta1b_2$summary() - -# Plot the second with covariates simulated. Note the regimen labels are included, but we move -# the legend to the bottom left. -pta1b_2$plot( - ylab = "Proportion with %T>MIC of at least 60%", grid = TRUE, - legend = list(x = "bottomleft") -) - -# Now we'll define success as free auc:mic > 100 with a free drug fraction of 50% -pta2_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), - free_fraction = 0.7, - target_type = "auc", success = 100, start = 120, end = 144 -) -summary(pta2_2) -pta2_2$plot( - ylab = "Proportion with AUC/MIC of at least 100", grid = TRUE, - legend = list(x = "bottomleft") -) - -# success is Cmax/MIC >=10 -pta3_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, - target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), - target_type = "peak", success = 10, start = 120, end = 144 -) -pta3_2$summary() -pta3_2$plot(ylab = "Proportion with peak/MIC of at least 10", grid = TRUE) - -# success = Cmin:MIC > 1 -pta4_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, - target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), - target_type = "min", success = 1, start = 120, end = 144 -) -pta4_2$summary() -pta4_2$plot(ylab = "Proportion with Cmin/MIC of at least 1", grid = TRUE, legend = list(x = "bottomleft")) - -# now plot the PDI (pharmacodynamic index) of each regimen, rather than the proportion -# of successful profiles. A PDI plot is always available for PMpta objects. -pta4_2$plot(at = 1, type = "pdi", ylab = "Cmin:MIC", grid = TRUE) - -# Each regimen has the 90% confidence interval PDI around the median curve, -# in the corresponding, semi-transparent color. Make the CI much narrower... -pta4_2$plot(at = 1, type = "pdi", ci = 0.1) - -# ...or gone altogether, put back the grid, redefine the colors, and make lines narrower -pta4_2$plot( - at = 1, type = "pdi", ci = 0, grid = TRUE, - line = list( - color = c("blue", "purple", "black", "brown"), - width = 1 - ) -) - -# now let's repeat the analysis but simulate the distribution of MICs -# using susceptibility of Staphylococcus aureus to vancomycin contained -# in the mic1 dataset within Pmetrics (?mic1) - -# see the source with ?mic1 -pta4b_2 <- PM_pta$new( - simdata = simlist2, - simlabels = c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid"), - target = makePTAtarget(mic1), target_type = "min", success = 1, start = 120, end = 144 -) - -pta4b_2$summary() -# plot it -pta4b_2$plot( - grid = TRUE, ylab = "Proportion with Cmin/MIC of at least 1", - marker = list(color = "red"), line = list(color = "black") -) -pta4b_2$plot(type = "pdi", grid = TRUE, ylab = "Proportion with Cmin/MIC of at least 1") - -# note that the plot changes since target MICs are no longer discrete -# since most of the MICs are very low, the regimens all look very similar - -# success = concentration at time 3 hours:MIC > 2 -pta5_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, - target = c(0.25, 0.5, 1, 2, 4, 8, 16, 32), target_type = 123, success = 2, start = 120, end = 144 -) -pta5_2$summary() -pta5_2$plot(ylab = "Proportion with C3/MIC of at least 1", grid = TRUE, legend = list(x = .3, y = 0.1)) - - -# success is trough >10 -pta6_2 <- PM_pta$new( - simdata = simlist2, - simlabels = simlabels, - target = 10, target_type = 144, success = 1, start = 120, end = 144 -) -plot(pta6_2) -pta6_2$summary() - -# EXERCISE 10 - OPTIMAL SAMPLE TIMES -------------------------------------- - -setwd(wd) -dir.create("../MMopt") -setwd("../MMopt") - -# calculate MM-optimal sample times for Run 2, and the 1200 mg once daily dose in the PTA -# By specifying the predInt to start and stop at 120 and 144 hours, with an interval of 1 hour, -# we are sampling at steady state. Including "subject 2", means only the 1200 mg once daily dose -# will serve as a simulation template. - -run2$opt( - data = "../src/ptaex1.csv", - nsamp = 2, predInt = c(120, 140, 1), - limits = NA, - include = 2 -) -# see the optimal sample times and the Bayes Risk of misclassification, -# which is only useful to compare optimal sampling regimens, i.e. the -# absolute value is less helpful, but is the statistic minimized by the -# selected optimal sample times for a given model - -mmopt_2 <- PM_opt$new( - poppar = run2$final, - model = run2$model, - data = "../src/ptaex1.csv", - nsamp = 2, predInt = c(120, 140, 1), - include = 2 -) - -# plot it, with the red lines indicating the optimal sample times. -# see ?plot.MMopt for help -mmopt_2$plot() -plot(mmopt_2) -plot(mmopt_2, line = list(color = "slategrey"), times = list(color = "orange")) - -# EXERCISE 11 - ASSAY ERROR ----------------------------------------------- -# see ?makeErrorPoly for more help -# This will let you choose the best set of C0, C1, C2, C3 for your modeling, -# based on assay validation data which includes the "obs", which are the -# nominal concentrations of the standards, and "sd", which is the standard -# deviation of replicate measurements of each of the standards, i.e. the -# inter-day and/or intra-day standard deviation - -obs <- c(0, 25, 50, 100, 250, 500, 1000, 2000, 5000) -sd <- c(0.5, 6.4, 8.6, 12, 8.6, 37.2, 60.1, 165.7, 483) - -# See plots.pdf, page 50 -makeErrorPoly(obs = obs, sd = sd) - -# choose the one with the best R-squared that will never result in a -# negative value for the SD - - - -# Ancillary functions ----------------------------------------------------- - -# Be sure to check out the help files for the following functions: -# -# makeAUC() - calculate AUC from a variety of inputs -# makeNCA() - non-compartmental analysis -# NM2PM() - convert NONMEM data files to Pmetrics data files -# qgrowth() - CDC growth charts -# zBMI() - CDC Pediatric BMI z-scores and percentiles -# ss.PK() - sample size for Phase 1 PK studies diff --git a/Archived/genAlquimiaData.R b/Archived/genAlquimiaData.R deleted file mode 100755 index b3c9f0440..000000000 --- a/Archived/genAlquimiaData.R +++ /dev/null @@ -1,4 +0,0 @@ -require(Pmetrics) -wd <- commandArgs()[6] -setwd(wd) -Pmetrics:::GenAlData(wd) diff --git a/Archived/makePTA2.R b/Archived/makePTA2.R deleted file mode 100755 index 731b70537..000000000 --- a/Archived/makePTA2.R +++ /dev/null @@ -1,448 +0,0 @@ - -target <- list(2^(-2:6), 1, 50) -target <- list(2^(-2:6)) -target_type <- c("time", 144, "-max") -target_type <- "time" -sim_num <- 1:4 -success <- c(0.6, 1, 1) -success <- c(0.6) -simlabels <- c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid") -simdata <- simEx - -pta1 <- makePTA2(simEx, - simlabels = c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid"), - target = list(2^(-2:6), 1, 50), - target_type = c("time", 144, "-max"), - success = c(0.6, 1, 1), - start = 120, end = 144) - -pta2 <- makePTA2(simEx, - target = c(2^(-2:6)), - target_type = "time", - success = 0.6, - start = 120, end = 144) - -pta3 <- makePTA2(simEx, - simlabels = c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid"), - target = list(5,10), - target_type = c("min", "-min"), - success = c(1,1), - start = 120, end = 144) - -pta4 <- makePTA2(simEx, - simlabels = c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid"), - target = makePTAtarget(mic1), - target_type = "auc", - success = 200, - start = 120, end = 144) - -pta5 <- makePTA2(simdata = simEx, - simlabels = c("600 mg daily", "1200 mg daily", "300 mg bid", "600 mg bid"), - target = list(makePTAtarget(mic1),5), - target_type = c("auc","min"), - success = c(200,1), - start = 120, end = 144) - - -makePTA2 <- function(simdata, simlabels, target, target_type, success, outeq = 1, - free_fraction = 1, start = 0, end = Inf, icen = "median", block = 1){ - - # initial check - if (missing(simdata) | missing(target) | missing(target_type) | missing(success)){ - stop("Simulation output (simdata), target, target_type, and success are all mandatory.\n") - } - - #what kind of object is simdata? - #lists, characters are assumed to be simulations - dataType <- switch(EXPR=class(simdata)[1], PM_sim = 0, PMsim = 1, PM_simlist = 2, - list = 3, character = 4, PMpost = 5, PMmatrix = 6 , - PMpta = 7, PM_data = 8, -1) - if(dataType==-1){ - stop("You must specify a PM_sim, PMsim (legacy), list of simulations, character vector of simulator output files, PMpost, PMmatrix (legacy), or PM_data object\n") - } - - if (dataType!=7) { #if simdata is not already a PMpta object - - ########### new PTA calculation ################## - #need to get it into a list of PMsim objects - if (dataType==0) { #PM_sim object - if(inherits(simdata$data, "PM_simlist")){ #multiple sims - simdata <- simdata$data - } else { #just one sim - simdata <- list(simdata$data) - } - } - - if (dataType==1) { #PMsim object - simdata <- list(simdata) - } - - if(dataType == 2){ #PM_simlist - simdata <- purrr::map(simdata$data, \(x) x$data) #extract data - } - - #nothing to do for dataType=3 already in right format - - if (dataType==4) { #character vector of simulator output files - simfiles <- Sys.glob(simdata) - if (length(simfiles) == 0) - stop("There are no files matching \"", simdata, "\".\n", sep = "") - simdata <- list() - for (i in 1:length(simfiles)) { - simdata[[i]] <- tryCatch(SIMparse(simfiles[i]), error = function(e) stop(paste(simfiles[i], "is not a PMsim object.\n"))) - } - } - - if(dataType==5){ #PMpost object - simdata <- simdata %>% filter(icen == !!icen & block == !!block) - #simdata <- simdata[simdata$icen==icen & simdata$block==block,] - temp <- list(obs=data.frame(id=simdata$id,time=simdata$time,out=simdata$pred,outeq=simdata$outeq)) - simdata <- list(temp) - } - - if(dataType == 6 | dataType == 8){ #PMmatrix or PM_data object - if(dataType == 8){ - simdata <- simdata$data - } - simdata <- makePMmatrixBlock(simdata) - simdata <- simdata %>% filter(evid==0 & block== !!block) - temp <- list(obs=data.frame(id=simdata$id,time=simdata$time,out=simdata$out,outeq=simdata$outeq)) - simdata <- list(temp) - } - } - - if (is.numeric(target) | inherits(target,"PMpta.targ")){ - target <- list(target) #make a list - } - - #define some global variables - n_sim <- length(simdata) # number of regimens - n_id <- max(sapply(simdata,function(x) nrow(x$parValues))) #number of simulated id per regimen (usually 1000) - n_type <- length(target_type) - n_success <- length(success) - n_target <- length(target) #length of the whole list, should correspond with n_type, success - if (inherits(target[[1]], "PMpta.targ")) { - simTarg <- T - } else { - simTarg <- F - } - - #fill in start and end times for each regimen - if(length(start) < n_sim){ - start <- rep(start, n_sim)[1:n_sim] - } - if(length(end) < n_sim){ - end <- rep(end, n_sim)[1:n_sim] - } - - #check for valid arguments - invalid_types <- purrr::map_lgl(target_type, \(x){ - !x %in% c("time", "auc", "max", "peak", "min", "-max", "-peak", "-min") && - suppressWarnings(is.na(as.numeric(x))) - }) - - if (any(invalid_types)){ - stop("Please specify target_type as a numerical value corresponding to a common\ntime in all simulated datasets, or a character value of 'time', 'auc', 'max' or 'min'.\n") - } - - #adjust start and end for any specific times - start <- unlist(map(1:n_type, \(x) { - if(suppressWarnings(!is.na(as.numeric(target_type[x])))) { - abs(as.numeric(target_type[x])) - } else { - start[x] - }})) - end <- unlist(map(1:n_type, \(x) { - if(suppressWarnings(!is.na(as.numeric(target_type[x])))) { - abs(as.numeric(target_type[x])) - } else { - end[x] - }})) - - - #check to make sure secondary targets are only length 1 - if (n_type > 1){ - invalid_sec_type <- purrr::map_lgl(target[2:n_target], \(x){ - length(x) > 1 - }) - if (any(invalid_sec_type)){ - stop("For multiple target_types, types after the first cannot have more than one target, i.e., they are typically are min, max, or specific.\n") - } - } - - if (!identical(n_target, n_type, n_success)){ - stop("Target, target_type, and success vectors must all be the same length for discrete targets.\n") - } - - if (stringr::str_detect(free_fraction,"%")){ # if passed as percents convert to a number - free_fraction <- as.numeric(stringr::str_replace(free_fraction,"%",""))/100 - } - while(free_fraction <= 0 | free_fraction > 1) { - free_fraction <- as.numeric(readline(cat("Invalid free fraction, please specify a fraction > 0 and <= 1.\n"))) - } - if (stringr::str_detect(success[1],"%")){ # if passed as percents convert to a number - success[1] <- as.numeric(stringr::str_replace(success[1],"%",""))/100 - } - if (success[1] <= 0 | (target_type[1] == "time" & success[1] > 100)) stop("Invalid success threshold value. Aborting.", call.=F) - if (target_type[1] =="time" & success[1] > 1 & success[1] <= 100) { - cat("Your specified success threshold for time above target of ", success[1], " is bigger than 1.", sep="") - ans <- readline(cat("\nWhat would you like to do?\n1) set success to ",success[1]/100," (i.e. ",success[1],"% of time above target)\n2) end ", sep="")) - if (ans == 1) { - success[1] = success[1]/100 - cat("Success threshold for time was set to ",success[1],".",sep="") - } else stop("Function aborted.", call.=F) - } - - #### PREPARE DATA - - #check outeq - if (!outeq %in% simdata[[1]]$obs$outeq) { - stop("There are no simulated outputs for output equation ", outeq, ". Aborting.", call. = F) - } - - #filter and multiply free fraction - simdata <- purrr::map(1:n_sim, \(x) { - simdata[[x]]$obs <- simdata[[x]]$obs %>% filter(outeq == !!outeq, !is.na(out)) %>% - mutate(outeq = 1) #after filter, change to 1 - simdata[[x]]$obs$out <- simdata[[x]]$obs$out * free_fraction - simdata[[x]] - }) - - - #Check the simulation labels - sim_labels <- paste("Regimen", 1:n_sim) - - if (!missing(simlabels)) { #replace generic labels with user labels - n_simlabels <- length(simlabels) - if (n_simlabels < n_sim) warning("There are more simulated regimens (n=",n_sim,") than labels (n=",n_simlabels,").", call.=FALSE, immediate. = TRUE) - if (n_simlabels > n_sim) warning("There are fewer simulated regimens (n=",n_sim,") than labels (n=",n_simlabels,"); some labels will be ignored.", call.=FALSE, immediate. = TRUE) - sim_labels[1:min(n_simlabels, n_sim)] <- simlabels[1:min(n_simlabels, n_sim)] - } - - #calculate number of iterations for progress bar - if (!simTarg) { - cat("\nCalculating PTA for each simulated regimen and target...\n") - } else { - cat("\nCalculating PTA for each simulated regimen using simulated targets...\n") - } - flush.console() - - #create the progress bar - maxpb <- sum(unlist(purrr::map(target,\(x) ifelse(inherits(x, "PMpta.targ"), 1, length(x))))) * n_sim #target * simulations - pb <- txtProgressBar(min = 0, max = maxpb, style = 3) - - - ###### MAKE THE PTA OBJECT - master_pta <- map_df(1:n_type, \(x) expand_grid(sim_num = 1:n_sim, - target = if(simTarg){ #simulated targets - if(x == 1) { - list( - tidyr::tibble(id = 1:n_id, - target = sample(x = target[[x]]$target, size = n_id[x], replace = T, prob = target[[x]]$n) - )) - } else { - target[x] - } - } else {target[[x]]}, #discrete targets - this_type = x, - type = target_type[[x]], - success_ratio = success[[x]], - start = start[x], - end = end[x])) %>% - mutate(type = stringr::str_replace_all(type,"\\d+", "specific")) %>% - rowwise() %>% - mutate(pdi = list(do.call(paste0("pta_",stringr::str_replace_all(type, "-","")), - list(sims = simdata[[sim_num]]$obs, - .target = target, - .simTarg = simTarg, - .start = start, - .end = end, - .pb = pb)))) %>% - mutate(success = list(purrr::map_dbl(pdi, \(x) { - if(str_detect(type, "-")){ - x <= success_ratio #will return NA is x is NA - } else { - x >= success_ratio - } - }))) %>% - mutate(prop_success = sum(success)/length(success)) %>% - mutate(label = sim_labels[sim_num]) %>% - relocate(sim_num, label, target, type, success_ratio, prop_success, success, pdi, start, end) %>% - ungroup() #remove rowwise - - #add intersection if multiple target types - #browser() - if(n_type > 1){ - master_pta <- split(master_pta, master_pta$this_type) %>% #split by target type number - .[order(match(names(.),target_type))] - master_pta <- map(master_pta, \(x) {x$this_type = NULL; x}) - names(master_pta) <- NULL - master_pta$intersect <- master_pta[[1]] %>% select(sim_num, target, success_1 = success, label) #get primary success - for(i in 2:n_type){ #add additional success - master_pta$intersect[[paste0("success_", i)]] <- master_pta[[i]]$success[match(master_pta[[1]]$sim_num, master_pta[[i]]$sim_num)] - } - all_success <- master_pta$intersect %>% - select(tidyr::starts_with("success")) - total_success <- lapply(apply(all_success, 1, function(x) as.data.frame(x)), rowSums) #sum all success matrices for each sim/target - master_pta$intersect$prop_success <- purrr::map_dbl(total_success, \(x) sum(x == n_type)/length(x)) - master_pta$intersect <- master_pta$intersect %>% - rowwise() %>% - mutate(target = paste0("(",c(target, !!target[2:n_type]),")", collapse = "")) %>% - mutate(target = stringr::str_replace(target,"\\(1:(.|\\n)*\\){2}","(sim)")) %>% - mutate(type = paste0("(",target_type,")", collapse = "")) %>% - mutate(success_ratio = paste0("(",success,")", collapse = "")) %>% - mutate(success = list(total_success)) %>% - select(sim_num, label, target, type, success_ratio, prop_success, success) %>% - ungroup() - - } else { #only one target_type - master_pta <- master_pta %>% - select(-this_type) %>% - list(., intersect = NA) - } - - class(master_pta) <- c("PMpta", "list") - return(master_pta) - - -} - -#accessory internal functions - -pta_auc <- function(sims, .target, .simTarg, .start, .end, .pb){ - - cycle <- getTxtProgressBar(.pb) - setTxtProgressBar(.pb, cycle+1) - - auc <- tryCatch(makeAUC(sims, out ~ time, start = .start, end = .end), error = function(e) NA) - if(nrow(auc)>0){ - if(.simTarg & length(.target) > 1){ - auc <- dplyr::left_join(auc, .target, by = "id") - } else { - auc$target <- .target - } - pdi <- auc$tau/auc$target - } else { - pdi <- NA #filtered to 0 rows or other AUC error - } - return(pdi) -} - -pta_min <- function(sims, .target, .simTarg, .start, .end, .pb){ - - cycle <- getTxtProgressBar(.pb) - setTxtProgressBar(.pb, cycle+1) - - mins <- sims %>% group_by(id) %>% filter(time >= .start, time <= .end) - if(.simTarg & length(.target) > 1){ - mins <- dplyr::left_join(mins, .target, by = "id") - } else { - mins$target <- .target - } - if(nrow(mins)>0){ - mins <- mins %>% - dplyr::summarize(min = min(out, na.rm = TRUE), target = target[1]) %>% - ungroup() - pdi <- mins$min/mins$target - } else { - pdi <- NA #filtered to 0 rows - } - return(pdi) -} - -pta_max <- function(sims, .target, .simTarg, .start, .end, .pb){ - - cycle <- getTxtProgressBar(.pb) - setTxtProgressBar(.pb, cycle+1) - - maxes <- sims %>% group_by(id) %>% filter(time >= .start, time <= .end) - if(.simTarg & length(.target) > 1){ - maxes <- dplyr::left_join(maxes, .target, by = "id") - } else { - maxes$target <- .target - } - if(nrow(maxes)>0){ - maxes <- maxes %>% - dplyr::summarize(max = max(out, na.rm = TRUE), target = target[1]) %>% - ungroup() - pdi <- maxes$max/maxes$target - } else { - pdi <- NA #filtered to 0 rows - } - return(pdi) -} - -pta_specific <- function(sims, .target, .simTarg, .start, .end, .pb){ - - cycle <- getTxtProgressBar(.pb) - setTxtProgressBar(.pb, cycle+1) - - concs <- sims %>% group_by(id) %>% filter(time == .start) - if(.simTarg & length(.target) > 1){ - concs <- dplyr::left_join(concs, .target, by = "id") - } else { - concs$target <- .target - } - if(nrow(concs)>0){ - pdi <- concs$out/concs$target - } else { - pdi <- NA #filtered to 0 rows - } - return(pdi) -} - -pta_time <- function(sims, .target, .simTarg, .start, .end, .pb){ - - cycle <- getTxtProgressBar(.pb) - setTxtProgressBar(.pb, cycle+1) - - interval <- diff(sims$time)[1] #will be regular for sims - - times <- sims %>% group_by(id) %>% filter(time >= .start, time <= .end) - if(.simTarg & length(.target) > 1){ - times <- dplyr::left_join(times, .target, by = "id") - } else { - times$target <- .target - } - if(nrow(times)>0){ - times <- times %>% - mutate(above = interval * (out>target)) %>% - mutate(cross = above - dplyr::lag(above, n = 1)) - - crossing_rows <- which(times$cross == 0.5 | times$cross == -0.5) - if(length(crossing_rows)>0){ - crossing1 <- times[c(crossing_rows-1, crossing_rows),] %>% - arrange(id, time) %>% - ungroup() %>% - mutate(pair = rep(seq_along(1:(0.5*n())),each = 2)) %>% - group_by(pair) - - crossing2 <- crossing1 %>% - summarize( above = interval / (out[2] - out[1]) * - (target[1] - out[1])) - - crossing3 <- crossing1 %>% - filter(above == interval) %>% - ungroup() %>% - mutate(above = crossing2$above) - - times2 <- times %>% - filter(is.na(cross) | cross == 0) - - pdi <- bind_rows(times2, crossing3) %>% - group_by(id) %>% - summarize(sum = sum(above[-1])/24) %>% - pull(sum) - } else { - pdi <- times %>% - group_by(id) %>% - summarize(sum = sum(above[-1])/24) %>% - pull(sum) - } - pdi[pdi>1] <- 1 #in case of rounding errors - } else { - pdi <- NA #filtered to 0 rows - } - - return(pdi) -} diff --git a/Archived/modelLibrary.R b/Archived/modelLibrary.R deleted file mode 100755 index 83565dff1..000000000 --- a/Archived/modelLibrary.R +++ /dev/null @@ -1,291 +0,0 @@ -library(Pmetrics) -#initialize row object -modelRow <- list() - -#function to add rows to row object in .GlobalEnv -add_model_row <- function(ncomp, comp, par, route, elim, model_list, name, alt){ - modelRow[[length(modelRow)+1]] <<- - tibble::as_tibble_row(list(ncomp = ncomp, - comp = comp, - par = par, - route = route, - elim = list(elim), - model_list = list(model_list), - name = name, - alt = alt)) -} - - -# Models ------------------------------------------------------------------ - - - -#Ke, V -add_model_row(ncomp = 1, - comp = "1 = Central", - par = "Ke, V", - route = "Intravenous", - elim = 1, - model_list = - list( - pri = list( - Ke = ab(0, 5), - V = ab(0.01, 100) - ), - eqn = list( - "dX[1] = RATEIV[1] - Ke * X[1]" - ), - out = list( - y1 = list( - val = "X[1]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) - ),#end model list - name = "one_comp_iv", - alt = "advan1\nadvan1-trans1") - -#CL, V -add_model_row(ncomp = 1, - comp = "1 = Central", - par = "CL, V", - route = "Intravenous", - elim = 1, - model_list = - list( - pri = list( - CL = ab(0, 5), - V = ab(0.01, 100) - ), - sec = "Ke = CL/V", - eqn = list( - "dX[1] = RATEIV[1] - Ke * X[1]" - ), - out = list( - y1 = list( - val = "X[1]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "one_comp_iv_cl", - alt = "advan1\nadvan1-trans2" -) - -#Ka, Ke, V -add_model_row(ncomp = 2, - comp = "1 = Bolus\n2 = Central", - par = "Ka, Ke, V", - route = "Oral\nIntravenous", - elim = 2, - model_list = - list( - pri = list( - Ke = ab(0, 5), - V = ab(0.01, 100), - Ka = ab(0, 5) - ), - eqn = list( - "dX[1] = BOLUS[1] - Ka*X[1]", - "dX[2] = RATEIV[1] + Ka*X[1] - Ke*X[2]" - ), - out = list( - y1 = list( - val = "X[2]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "two_comp_bolus", - alt = "advan2\nadvan2-trans1" -) - -#Ka, CL, V -add_model_row(ncomp = 2, - comp = "1 = Bolus\n2 = Central", - par = "Ka, CL, V", - route = "Oral\nIntravenous", - elim = 2, - model_list = - list( - pri = list( - CL = ab(0, 5), - V = ab(0.01, 100), - Ka = ab(0, 5) - ), - sec = "Ke = CL/V", - eqn = list( - "dX[1] = BOLUS[1] - Ka*X[1]", - "dX[2] = RATEIV[1] + Ka*X[1] - Ke*X[2]" - ), - out = list( - y1 = list( - val = "X[2]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "two_comp_bolus_cl", - alt = "advan2\nadvan2-trans2" -) - - -#Ke, V, KCP, KPC -add_model_row(ncomp = 2, - comp = "1 = Central\n2 = Peripheral", - par = "Ke, V, KCP, KPC", - route = "Intravenous", - elim = 1, - model_list = - list( - pri = list( - Ke = ab(0, 5), - V = ab(0.01, 100), - KCP = ab(0, 5), - KPC = ab(0, 5) - ), - eqn = list( - "dX[1] = RATEIV[1] - (Ke + KCP)*X[1] + KPC*X[2]", - "dX[2] = KCP*X[1] - KPC*X[2]" - ), - out = list( - y1 = list( - val = "X[1]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "two_comp_iv", - alt = "advan3\nadvan3-trans1" -) - -#CL, V, Q, Vp -add_model_row(ncomp = 2, - comp = "1 = Central\n2 = Peripheral", - par = "CL, V1, Q, V2", - route = "Intravenous", - elim = 1, - model_list = - list( - pri = list( - CL = ab(0, 5), - V = ab(0.01, 100), - Q = ab(0, 5), - Vp = ab(0.01, 100) - ), - sec = c( - "Ke = CL/V", - "KCP = Q/V", - "KPC = Q/Vp" - ), - eqn = list( - "dX[1] = RATEIV[1] - (Ke + KCP)*X[1] + KPC*X[2]", - "dX[2] = KCP*X[1] - KPC*X[2]" - ), - out = list( - y1 = list( - val = "X[1]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "two_comp_iv_cl", - alt = "advan3\nadvan3-trans4" -) - - -#Ka, Ke, V, KCP, KPC -add_model_row(ncomp = 3, - comp = "1 = Bolus\n2 = Central\n3 = Peripheral", - par = "Ka, Ke, V, KCP, KPC", - route = "Oral\nIntravenous", - elim = 2, - model_list = - list( - pri = list( - Ke = ab(0, 5), - V = ab(0.01, 100), - Ka = ab(0, 5), - KCP = ab(0, 5), - KPC = ab(0, 5) - ), - eqn = list( - "dX[1] = BOLUS[1] - Ka*X[1]", - "dX[2] = RATEIV[1] + Ka*X[1] - (Ke + KCP)*X[2] + KPC*X[3]", - "dX[3] = KCP*X[2] - KPC*X[3]" - ), - out = list( - y1 = list( - val = "X[2]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "three_comp_bolus", - alt = "advan4\nadvan4-trans1" -) - -#Ka, CL, V, Q, Vp -add_model_row(ncomp = 3, - comp = "1 = Bolus\n2 = Central\n3 = Peripheral", - par = "Ka, CL, V2, Q, V3", - route = "Oral\nIntravenous", - elim = 2, - model_list = - list( - pri = list( - CL = ab(0, 5), - V = ab(0.01, 100), - Ka = ab(0, 5), - Q = ab(0, 5), - Vp = ab(0.01, 100) - ), - sec = c( - "Ke = CL/V", - "KCP = Q/V", - "KPC = Q/Vp" - ), - eqn = list( - "dX[1] = BOLUS[1] - Ka*X[1]", - "dX[2] = RATEIV[1] + Ka*X[1] - (Ke + KCP)*X[2] + KPC*X[3]", - "dX[3] = KCP*X[2] - KPC*X[3]" - ), - out = list( - y1 = list( - val = "X[2]/V", - err = list( - model = additive(0.1), - assay = errorPoly(c(0.1, 0.1, 0, 0)) - ) - ) - ) #end model list - ), - name = "three_comp_bolus_cl", - alt = "advan4\nadvan4-trans4" -) - -# Assemble and use -------------------------------------------------------- - -#assemble library -modelLibrary <- purrr::list_rbind(modelRow) \ No newline at end of file diff --git a/Archived/pkgdown.yml b/Archived/pkgdown.yml deleted file mode 100644 index d657acc0a..000000000 --- a/Archived/pkgdown.yml +++ /dev/null @@ -1,71 +0,0 @@ -on: - push: - branches: [main, master] - pull_request: - branches: [main, master] - release: - types: [published] - workflow_dispatch: - -name: pkgdown - -concurrency: - group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref_name }} - cancel-in-progress: true - -jobs: - build-site: - runs-on: ubuntu-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - permissions: - contents: read - pages: write - id-token: write - steps: - - uses: actions/checkout@v4 - - - uses: r-lib/actions/setup-pandoc@v2 - - - uses: quarto-dev/quarto-actions/setup@v2 - with: - version: latest - - - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::pkgdown, any::rsconnect, any::quarto, local::. - needs: website - - - name: Build site - run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE, quiet = FALSE) - shell: Rscript {0} - env: - RSCONNECT_PACKRAT: "false" - - - name: Upload artifact - uses: actions/upload-pages-artifact@v3 - with: - path: ./docs - - deploy: - needs: build-site - - if: github.event_name != 'pull_request' - - permissions: - pages: write # to deploy to Pages - id-token: write # to authenticate - - environment: - name: github-pages - url: ${{ steps.deployment.outputs.page_url }} - - runs-on: ubuntu-latest - steps: - - name: Deploy to GitHub Pages - id: deployment - uses: actions/deploy-pages@v4 diff --git a/Archived/plotPMdopt.R b/Archived/plotPMdopt.R deleted file mode 100755 index b67ce58c5..000000000 --- a/Archived/plotPMdopt.R +++ /dev/null @@ -1,57 +0,0 @@ -#' @title Plot Pmetrics D-optimal Times -#' @description -#' `r lifecycle::badge("stable")` -#' -#' Plot PMdopt objects -#' @details -#' This function will plot the output of the \code{\link{Dopt}} function. A histogram is generated -#' with the probability distribution of each optimal time for each support point in the model, -#' and the weighted mean for that time. -#' -#' @method plot PMdopt -#' @param x The name of an \emph{PMdopt} data object generated by \code{\link{Dopt}} - -#' @param col.mean This parameter will be applied to the tick mark indicating the weighted mean -#' optimal time -#' @param lwd.mean This parameter will be applied to the tick mark indicating the weighted mean -#' optimal time -#' @param ticksize.mean This parameter will be applied to the tick mark indicating the weighted mean -#' optimal time -#' @param xlab Define x-axis label. Default is \dQuote{Time}. -#' @param ylab Define y-axis label. Default \dQuote{Probability}. -#' @param layout This parameter specifies the number of rows and columns per page, e.g. layout=c(2,2). -#' @param \dots Other parameters as found in \code{\link{plot.default}}. -#' @return Plots the object. -#' @author Michael Neely -#' @seealso \code{\link{Dopt}}, \code{\link{summary.PMdopt}} -#' @export - - -plot.PMdopt <- function(x, col.mean = "red", lwd.mean = 4, ticksize.mean = 0.1, xlab = "Time", ylab = "Probability", layout = c(1, 1), ...) { - .par <- par("mfrow") # save current layout - ntimes <- length(x$mean) - if (missing(layout)) { - if (ntimes > 4) { - par(mfrow = c(2, 2)) - devAskNewPage(T) - } else { - par(mfrow = c(ceiling(ntimes / 2), ifelse(ntimes > 2, 2, ntimes))) - } - } else { - par(mfrow = layout) - if (ntimes > sum(layout)) { - devAskNewPage(T) - } - } - par(mar = c(5, 5, 4, 2) + 0.1) - - - for (i in 1:ntimes) { - probs <- tapply(x$all$prob, x$all$gridpoint, function(x) x[i]) - times <- tapply(x$all$time, x$all$gridpoint, function(x) x[i]) - plot(x = times, y = probs, type = "h", xlab = xlab, ylab = ylab, main = paste("Mean = ", round(x$mean[i], 3), sep = "")) - rug(x$mean[i], col = col.mean, lwd = lwd.mean, ticksize = ticksize.mean) - } - par(.par) - devAskNewPage(F) -} diff --git a/Archived/pmetrics-logo.png b/Archived/pmetrics-logo.png deleted file mode 100755 index 34a1578ab..000000000 Binary files a/Archived/pmetrics-logo.png and /dev/null differ diff --git a/Archived/printPMdopt.R b/Archived/printPMdopt.R deleted file mode 100755 index 4bd3cee38..000000000 --- a/Archived/printPMdopt.R +++ /dev/null @@ -1,23 +0,0 @@ -#' @title Print PMdopt -#' @description -#' `r lifecycle::badge("stable")` -#' -#' Print a Pmetrics PMdopt Object made by [Dopt]. -#' -#' @method print PMdopt -#' @param x A PMdopt object made by [Dopt]. -#' @param ... Not used. -#' @return A printed object. -#' @author Michael Neely -#' @seealso [Dopt] -#' @export - -print.PMdopt <- function(x, ...) { - cat("\nThe mean of the two optimization runs for each optimal sample are:\n\n") - means <- apply(x$means, 1, mean) - for (i in 1:length(means)) { - cat(paste("Time ", i, ": ", sprintf("%.3f", means[i]), "\n", sep = "")) - } - - cat(paste("\nThe average times between Optimizations 1 and 2 are ", sprintf("%.3g", mean(100 * (1 - x$all$time1 / x$all$time2))), "% different (P=", sprintf("%.3g", t.test(x$all$time1, x$all$time2)$p.value), ")", sep = "")) -} diff --git a/Archived/summaryPMdopt.R b/Archived/summaryPMdopt.R deleted file mode 100755 index e93a3004b..000000000 --- a/Archived/summaryPMdopt.R +++ /dev/null @@ -1,21 +0,0 @@ -#' @title Summarize PMdopt objects -#' @description -#' `r lifecycle::badge("stable")` -#' -#' Summarize a Pmetrics D-optimal object -#' @details -#' Summarize observations, predictions and errors in a PMdopt object made by [Dopt]. -#' -#' @method summary PMdopt -#' @param object A PMdopt object made by [Dopt]. -#' @param ... Other parameters which are not necessary. -#' @return The weighted mean D-optimal times. -#' @author Michael Neely -#' @seealso [makeOP] -#' @export - -summary.PMdopt <- function(object, ...) { - cat("Weighted mean D-optimal sample times are:\n") - cat("________________________________________\n") - cat(paste(object$mean, collapse = "\n")) -} diff --git a/Cargo.lock b/Cargo.lock index 3c31d49bd..c5e3104df 100755 --- a/Cargo.lock +++ b/Cargo.lock @@ -4,21 +4,21 @@ version = 4 [[package]] name = "ahash" -version = "0.8.11" +version = "0.8.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e89da841a80418a9b391ebaea17f5c112ffaaa96f621d2c285b5174da76b9011" +checksum = "5a15f179cd60c4584b8a8c596927aadc462e27f2ca70c04e0071964a73ba7a75" dependencies = [ "cfg-if", "once_cell", "version_check", - "zerocopy 0.7.35", + "zerocopy", ] [[package]] name = "aho-corasick" -version = "1.1.3" +version = "1.1.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916" +checksum = "ddd31a130427c27518df266943a5308ed92d4b226cc639f5a8f1002816174301" dependencies = [ "memchr", ] @@ -31,9 +31,9 @@ checksum = "683d7910e743518b0e34f1186f92494becacb047c7b6bf616c96772180fef923" [[package]] name = "anyhow" -version = "1.0.100" +version = "1.0.102" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a23eb6b1614318a8071c9b2521f36b424b2c83db5eb3a0fead4a6c0809af6e61" +checksum = "7f202df86484c868dbad7eaa557ef785d5c66295e41b460ef922eca0723b842c" [[package]] name = "approx" @@ -56,7 +56,7 @@ dependencies = [ "paste", "rand 0.9.2", "rand_xoshiro", - "thiserror 2.0.17", + "thiserror 2.0.18", "web-time", ] @@ -72,7 +72,7 @@ dependencies = [ "num-integer", "num-traits", "rand 0.9.2", - "thiserror 2.0.17", + "thiserror 2.0.18", ] [[package]] @@ -87,15 +87,15 @@ dependencies = [ [[package]] name = "autocfg" -version = "1.4.0" +version = "1.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ace50bade8e6234aa140d9a2f552bbee1db4d353f69b8217bc503490fc1a9f26" +checksum = "c08606f8c3cbf4ce6ec8e28fb0014a2c086708fe954eaa885384a6165172e7e8" [[package]] name = "bitflags" -version = "2.9.0" +version = "2.11.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5c8214115b7bf84099f1309324e63141d4c5d7cc26862f97a0a857dbefe165bd" +checksum = "843867be96c8daad0d758b57df9392b6d8d271134fce549de6ce169ff98a92af" [[package]] name = "block-buffer" @@ -108,28 +108,28 @@ dependencies = [ [[package]] name = "bumpalo" -version = "3.17.0" +version = "3.20.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1628fb46dfa0b37568d12e5edd512553eccf6a22a78e8bde00bb4aed84d5bdbf" +checksum = "5d20789868f4b01b2f2caec9f5c4e0213b41e3e5702a50157d699ae31ced2fcb" [[package]] name = "bytemuck" -version = "1.23.2" +version = "1.25.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3995eaeebcdf32f91f980d360f78732ddc061097ab4e39991ae7a6ace9194677" +checksum = "c8efb64bd706a16a1bdde310ae86b351e4d21550d98d056f22f8a7f7a2183fec" dependencies = [ "bytemuck_derive", ] [[package]] name = "bytemuck_derive" -version = "1.10.1" +version = "1.10.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4f154e572231cb6ba2bd1176980827e3d5dc04cc183a75dea38109fbdd672d29" +checksum = "f9abbd1bc6865053c427f7198e6af43bfdedc55ab791faed4fbd361d789575ff" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -147,9 +147,9 @@ dependencies = [ "ahash", "cached_proc_macro", "cached_proc_macro_types", - "hashbrown", + "hashbrown 0.15.5", "once_cell", - "thiserror 2.0.17", + "thiserror 2.0.18", "web-time", ] @@ -162,7 +162,7 @@ dependencies = [ "darling", "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -173,18 +173,19 @@ checksum = "ade8366b8bd5ba243f0a58f036cc0ca8a2f069cff1a2351ef1cac6b083e16fc0" [[package]] name = "cc" -version = "1.2.23" +version = "1.2.56" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f4ac86a9e5bc1e2b3449ab9d7d3a6a405e3d1bb28d7b9be8614f55846ae3766" +checksum = "aebf35691d1bfb0ac386a69bac2fde4dd276fb618cf8bf4f5318fe285e821bb2" dependencies = [ + "find-msvc-tools", "shlex", ] [[package]] name = "cfg-if" -version = "1.0.0" +version = "1.0.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" +checksum = "9330f8b2ff13f34540b44e946ef35111825727b38d33286ef986142615121801" [[package]] name = "cpufeatures" @@ -253,15 +254,15 @@ checksum = "d0a5c400df2834b80a4c3327b3aad3a4c4cd4de0629063962b03235697506a28" [[package]] name = "crunchy" -version = "0.2.3" +version = "0.2.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "43da5946c66ffcc7745f48db692ffbb10a83bfe0afd96235c5c2a4fb23994929" +checksum = "460fbee9c2c2f33933d720630a6a0bac33ba7053db5344fac858d4b8952d77d5" [[package]] name = "crypto-common" -version = "0.1.6" +version = "0.1.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1bfb12502f3fc46cca1bb51ac28df9d618d813cdc3d2f25b9fe775a34af26bb3" +checksum = "78c8292055d1c1df0cce5d180393dc8cce0abec0a7102adb6c7b1eef6016d60a" dependencies = [ "generic-array", "typenum", @@ -269,21 +270,21 @@ dependencies = [ [[package]] name = "csv" -version = "1.3.1" +version = "1.4.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "acdc4883a9c96732e4733212c01447ebd805833b7275a73ca3ee080fd77afdaf" +checksum = "52cd9d68cf7efc6ddfaaee42e7288d3a99d613d4b50f76ce9827ae0c6e14f938" dependencies = [ "csv-core", "itoa", "ryu", - "serde", + "serde_core", ] [[package]] name = "csv-core" -version = "0.1.12" +version = "0.1.13" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7d02f3b0da4c6504f86e9cd789d8dbafab48c2321be74e9987593de5a894d93d" +checksum = "704a3c26996a80471189265814dbc2c257598b96b8a7feae2d31ace646bb9782" dependencies = [ "memchr", ] @@ -309,7 +310,7 @@ dependencies = [ "proc-macro2", "quote", "strsim", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -320,7 +321,7 @@ checksum = "fc34b93ccb385b40dc71c6fceac4b2ad23662c7eeb248cf10d529b7e055b6ead" dependencies = [ "darling_core", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -331,9 +332,9 @@ checksum = "930c7171c8df9fb1782bdf9b918ed9ed2d33d1d22300abb754f9085bc48bf8e8" [[package]] name = "deranged" -version = "0.4.1" +version = "0.5.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "28cfac68e08048ae1883171632c2aef3ebc555621ae56fbccce1cbf22dd7f058" +checksum = "7cd812cc2bc1d69d4764bd80df88b4317eaef9e773c75226407d9bc0876b211c" dependencies = [ "powerfmt", ] @@ -351,7 +352,7 @@ dependencies = [ "num-traits", "petgraph", "serde", - "thiserror 2.0.17", + "thiserror 2.0.18", ] [[package]] @@ -366,13 +367,20 @@ dependencies = [ [[package]] name = "dyn-stack" -version = "0.13.0" +version = "0.13.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "490bd48eb68fffcfed519b4edbfd82c69cbe741d175b84f0e0cbe8c57cbe0bdd" +checksum = "1c4713e43e2886ba72b8271aa66c93d722116acf7a75555cce11dcde84388fe8" dependencies = [ "bytemuck", + "dyn-stack-macros", ] +[[package]] +name = "dyn-stack-macros" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e1d926b4d407d372f141f93bb444696142c29d32962ccbd3531117cf3aa0bfa9" + [[package]] name = "either" version = "1.15.0" @@ -388,7 +396,7 @@ dependencies = [ "heck", "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -417,7 +425,7 @@ checksum = "3bf679796c0322556351f287a51b49e48f7c4986e727b5dd78c972d30e2e16cc" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -428,7 +436,7 @@ checksum = "44f23cf4b44bfce11a86ace86f8a73ffdec849c9fd00a386a53d278bd9e81fb3" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -439,25 +447,31 @@ checksum = "877a4ace8713b0bcf2a4e7eec82529c029f1d0619886d18145fea96c3ffe5c0f" [[package]] name = "extendr-api" -version = "0.7.1" +version = "0.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67505d96c7faa49d20e749dba7ba2447db52c40a788fd88cc2b6bef02c02277a" +checksum = "ea54977c6e37236839ffcbc20b5dcea58aa32ae43fbef54a81e1011dc6b19061" dependencies = [ + "extendr-ffi", "extendr-macros", - "libR-sys", "once_cell", "paste", ] +[[package]] +name = "extendr-ffi" +version = "0.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c76777174a82bdb3e66872f580687d3d0143eed1df9b9cd72b321b9596a23ca7" + [[package]] name = "extendr-macros" -version = "0.7.1" +version = "0.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "81b58838056f294411d0b2c35ac1a2b24c507d6828b75f2c1e74f00ee9b99267" +checksum = "661cc4ae29de9c4dafe16cfcbda1dbb9f31bd2568f96ebad232cc1f9bcc8b04d" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -507,7 +521,7 @@ checksum = "2cc4b8cd876795d3b19ddfd59b03faa303c0b8adb9af6e188e81fc647c485bb9" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -528,6 +542,12 @@ dependencies = [ "reborrow", ] +[[package]] +name = "find-msvc-tools" +version = "0.1.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5baebc0774151f905a1a2cc41989300b1e6fbb29aff0ceffa1064fdd3088d582" + [[package]] name = "fixedbitset" version = "0.5.7" @@ -673,16 +693,17 @@ checksum = "5881e4c3c2433fe4905bb19cfd2b5d49d4248274862b68c27c33d9ba4e13f9ec" [[package]] name = "generator" -version = "0.8.5" +version = "0.8.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d18470a76cb7f8ff746cf1f7470914f900252ec36bbc40b569d74b1258446827" +checksum = "52f04ae4152da20c76fe800fa48659201d5cf627c5149ca0b707b69d7eef6cf9" dependencies = [ "cc", "cfg-if", "libc", "log", "rustversion", - "windows", + "windows-link", + "windows-result", ] [[package]] @@ -697,25 +718,25 @@ dependencies = [ [[package]] name = "getrandom" -version = "0.2.15" +version = "0.2.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c4567c8db10ae91089c99af84c68c38da3ec2f087c3f82960bcdbf3656b6f4d7" +checksum = "ff2abc00be7fca6ebc474524697ae276ad847ad0a6b3faa4bcb027e9a4614ad0" dependencies = [ "cfg-if", "libc", - "wasi 0.11.0+wasi-snapshot-preview1", + "wasi", ] [[package]] name = "getrandom" -version = "0.3.2" +version = "0.3.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "73fea8450eea4bac3940448fb7ae50d91f034f941199fcd9d909a5a07aa455f0" +checksum = "899def5c37c4fd7b2664648c28120ecec138e4d395b459e5ca34f9cce2dd77fd" dependencies = [ "cfg-if", "libc", "r-efi", - "wasi 0.14.2+wasi-0.2.4", + "wasip2", ] [[package]] @@ -810,33 +831,40 @@ checksum = "8babf46d4c1c9d92deac9f7be466f76dfc4482b6452fc5024b5e8daf6ffeb3ee" [[package]] name = "glam" -version = "0.30.8" +version = "0.30.10" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e12d847aeb25f41be4c0ec9587d624e9cd631bc007a8fd7ce3f5851e064c6460" +checksum = "19fc433e8437a212d1b6f1e68c7824af3aed907da60afa994e7f542d18d12aa9" [[package]] name = "half" -version = "2.5.0" +version = "2.7.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7db2ff139bba50379da6aa0766b52fdcb62cb5b263009b09ed58ba604e14bbd1" +checksum = "6ea2d84b969582b4b1864a92dc5d27cd2b77b622a8d79306834f1be5ba20d84b" dependencies = [ "bytemuck", "cfg-if", "crunchy", "num-traits", + "zerocopy", ] [[package]] name = "hashbrown" -version = "0.15.2" +version = "0.15.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bf151400ff0baff5465007dd2f3e717f3fe502074ca563069ce3a6629d07b289" +checksum = "9229cfe53dfd69f0609a49f65461bd93001ea1ef889cd5529dd176593f5338a1" dependencies = [ "allocator-api2", "equivalent", "foldhash", ] +[[package]] +name = "hashbrown" +version = "0.16.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "841d1cc9bed7f9236f321df977030373f4a4163ae1a7dbfe1a51a2c1a51d9100" + [[package]] name = "heck" version = "0.5.0" @@ -845,9 +873,9 @@ checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" [[package]] name = "hermit-abi" -version = "0.3.9" +version = "0.5.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d231dfb89cfffdbc30e7fc41579ed6066ad03abda9e567ccafae602b97ec5024" +checksum = "fc0fef456e4baa96da950455cd02c081ca953b141298e41db3fc7e36b1da849c" [[package]] name = "ident_case" @@ -857,12 +885,12 @@ checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" [[package]] name = "indexmap" -version = "2.8.0" +version = "2.13.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3954d50fe15b02142bf25d3b8bdadb634ec3948f103d04ffe3031bc8fe9d7058" +checksum = "7714e70437a7dc3ac8eb7e6f8df75fd8eb422675fc7678aff7364301092b1017" dependencies = [ "equivalent", - "hashbrown", + "hashbrown 0.16.1", ] [[package]] @@ -878,15 +906,15 @@ dependencies = [ [[package]] name = "itoa" -version = "1.0.15" +version = "1.0.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4a5f13b858c8d314ee3e8f639011f7ccefe71f97f96e50151fb991f267928e2c" +checksum = "92ecc6618181def0457392ccd0ee51198e065e016d1d527a7ac1b6dc7c1f09d2" [[package]] name = "js-sys" -version = "0.3.77" +version = "0.3.91" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1cfaf33c695fc6e08064efbc1f72ec937429614f25eef83af942d0e227c3a28f" +checksum = "b49715b7073f385ba4bc528e5747d02e66cb39c6146efb66b781f131f0fb399c" dependencies = [ "once_cell", "wasm-bindgen", @@ -899,38 +927,42 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "bbd2bcb4c963f2ddae06a2efc7e9f3591312473c50c6685e1f298068316e66fe" [[package]] -name = "libR-sys" -version = "0.7.1" +name = "libc" +version = "0.2.183" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "06ac9752bc1e83f5a354a62b9e81bd8db4468b1008e29f262441e7f0e91e6bb3" +checksum = "b5b646652bf6661599e1da8901b3b9522896f01e736bad5f723fe7a3a27f899d" [[package]] -name = "libc" -version = "0.2.171" +name = "libloading" +version = "0.8.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c19937216e9d3aa9956d9bb8dfc0b0c8beb6058fc4f7a4dc4d850edf86a237d6" +checksum = "d7c4b02199fee7c5d21a5ae7d8cfa79a6ef5bb2fc834d6e9058e89c825efdc55" +dependencies = [ + "cfg-if", + "windows-link", +] [[package]] name = "libloading" -version = "0.8.6" +version = "0.9.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc2f4eb4bc735547cfed7c0a4922cbd04a4655978c09b54f1f7b228750664c34" +checksum = "754ca22de805bb5744484a5b151a9e1a8e837d5dc232c2d7d8c2e3492edc8b60" dependencies = [ "cfg-if", - "windows-targets", + "windows-link", ] [[package]] name = "libm" -version = "0.2.15" +version = "0.2.16" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9fbbcab51052fe104eb5e5d351cf728d30a5be1fe14d9be8a3b097481fb97de" +checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" [[package]] name = "log" -version = "0.4.27" +version = "0.4.29" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "13dc2df351e3202783a1fe0d44375f7295ffb4049267b0f3018346dc122a1d94" +checksum = "5e5032e24019045c762d3c0f28f5b6b8bbf38563a65908389bf7978758920897" [[package]] name = "loom" @@ -956,9 +988,9 @@ dependencies = [ [[package]] name = "matrixmultiply" -version = "0.3.9" +version = "0.3.10" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9380b911e3e96d10c1f415da0876389aaf1b56759054eeb0de7df940c456ba1a" +checksum = "a06de3016e9fae57a36fd14dba131fccf49f74b40b7fbdb472f96e361ec71a08" dependencies = [ "autocfg", "rawpointer", @@ -966,9 +998,9 @@ dependencies = [ [[package]] name = "memchr" -version = "2.7.4" +version = "2.8.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "78ca9ab1a0babb1e7d5695e3530886289c18cf2f87ec19a575a0abdce112e3a3" +checksum = "f8ca58f447f06ed17d5fc4043ce1b10dd205e060fb3ce5b979b8ed8e59ff3f79" [[package]] name = "nalgebra" @@ -1009,7 +1041,7 @@ dependencies = [ "glam 0.27.0", "glam 0.28.0", "glam 0.29.3", - "glam 0.30.8", + "glam 0.30.10", "matrixmultiply", "nalgebra-macros", "num-complex", @@ -1027,7 +1059,7 @@ checksum = "973e7178a678cfd059ccec50887658d482ce16b0aa9da3888ddeab5cd5eb4889" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] @@ -1145,7 +1177,7 @@ version = "0.50.3" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "7957b9740744892f114936ab4a57b3f487491bbeafaf8083688b16841a4240e5" dependencies = [ - "windows-sys 0.59.0", + "windows-sys 0.61.2", ] [[package]] @@ -1171,9 +1203,9 @@ dependencies = [ [[package]] name = "num-conv" -version = "0.1.0" +version = "0.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "51d515d32fb182ee37cda2ccdcb92950d6a3c2893aa280e540671c2cd0f3b1d9" +checksum = "cf97ec579c3c42f953ef76dbf8d55ac91fb219dde70e49aa4a6b7d74e9919050" [[package]] name = "num-integer" @@ -1207,9 +1239,9 @@ dependencies = [ [[package]] name = "num_cpus" -version = "1.16.0" +version = "1.17.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4161fcb6d602d4d2081af7c3a45852d875a03dd337a6bfdd6e06407b61342a43" +checksum = "91df4bbde75afed763b708b7eee1e8e7651e02d97f6d5dd763e89367e957b23b" dependencies = [ "hermit-abi", "libc", @@ -1229,20 +1261,19 @@ checksum = "57c0d7b74b563b49d38dae00a0c37d4d6de9b432382b2892f0574ddcae73fd0a" [[package]] name = "pest" -version = "2.8.0" +version = "2.8.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "198db74531d58c70a361c42201efde7e2591e976d518caf7662a47dc5720e7b6" +checksum = "e0848c601009d37dfa3430c4666e147e49cdcf1b92ecd3e63657d8a5f19da662" dependencies = [ "memchr", - "thiserror 2.0.17", "ucd-trie", ] [[package]] name = "pest_derive" -version = "2.8.0" +version = "2.8.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d725d9cfd79e87dccc9341a2ef39d1b6f6353d68c4b33c177febbe1a402c97c5" +checksum = "11f486f1ea21e6c10ed15d5a7c77165d0ee443402f0780849d1768e7d9d6fe77" dependencies = [ "pest", "pest_generator", @@ -1250,24 +1281,23 @@ dependencies = [ [[package]] name = "pest_generator" -version = "2.8.0" +version = "2.8.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "db7d01726be8ab66ab32f9df467ae8b1148906685bbe75c82d1e65d7f5b3f841" +checksum = "8040c4647b13b210a963c1ed407c1ff4fdfa01c31d6d2a098218702e6664f94f" dependencies = [ "pest", "pest_meta", "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] name = "pest_meta" -version = "2.8.0" +version = "2.8.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7f9f832470494906d1fca5329f8ab5791cc60beb230c74815dff541cbd2b5ca0" +checksum = "89815c69d36021a140146f26659a81d6c2afa33d216d736dd4be5381a7362220" dependencies = [ - "once_cell", "pest", "sha2", ] @@ -1279,23 +1309,23 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "8701b58ea97060d5e5b155d383a69952a60943f0e6dfe30b04c287beb0b27455" dependencies = [ "fixedbitset", - "hashbrown", + "hashbrown 0.15.5", "indexmap", "serde", ] [[package]] name = "pharmsol" -version = "0.20.0" +version = "0.21.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "98b8e2ab3a0e91cd4b20c28544cb3676e8df31aa490cf5680ec0531259b5fa4e" +checksum = "2fc25564d039d0cd5701013aa3785a339b14cf0b51409d7b817320bc360dc944" dependencies = [ "argmin", "argmin-math", "cached", "csv", "diffsol", - "libloading", + "libloading 0.8.9", "nalgebra 0.34.1", "ndarray", "rand 0.9.2", @@ -1304,15 +1334,15 @@ dependencies = [ "serde", "serde_json", "statrs", - "thiserror 2.0.17", + "thiserror 2.0.18", "tracing", ] [[package]] name = "pin-project-lite" -version = "0.2.16" +version = "0.2.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3b3cff922bd51709b605d9ead9aa71031d81447142d828eb4a6eba76fe619f9b" +checksum = "a89322df9ebe1c1578d689c92318e070967d1042b512afbe49518723f4e6d5cd" [[package]] name = "pm_rs" @@ -1320,6 +1350,7 @@ version = "0.1.0" dependencies = [ "anyhow", "extendr-api", + "libloading 0.9.0", "pmcore", "rayon", "tracing", @@ -1328,13 +1359,12 @@ dependencies = [ [[package]] name = "pmcore" -version = "0.21.1" +version = "0.22.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "703e83f4a6a919cc60b85936d560840947b1b07a2d8ccfa7c87144d1722b6d63" +checksum = "3866100507aa3bcba475381af3102d84b5e503bce82cb82f56cf0fa46cc1e408" dependencies = [ "anyhow", "argmin", - "argmin-math", "csv", "faer", "faer-ext", @@ -1351,15 +1381,15 @@ dependencies = [ [[package]] name = "portable-atomic" -version = "1.11.0" +version = "1.13.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "350e9b48cbc6b0e028b0473b114454c6316e57336ee184ceab6e53f72c178b3e" +checksum = "c33a9471896f1c69cecef8d20cbe2f7accd12527ce60845ff44c153bb2a21b49" [[package]] name = "portable-atomic-util" -version = "0.2.4" +version = "0.2.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8a2f0d8d040d7848a709caf78912debcc3f33ee4b3cac47d73d1e1069e83507" +checksum = "7a9db96d7fa8782dd8c15ce32ffe8680bbd1e978a43bf51a34d39483540495f5" dependencies = [ "portable-atomic", ] @@ -1376,14 +1406,14 @@ version = "0.2.21" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "85eae3c4ed2f50dcfe72643da4befc30deadb458a9b590d720cde2f2b1e97da9" dependencies = [ - "zerocopy 0.8.24", + "zerocopy", ] [[package]] name = "private-gemm-x86" -version = "0.1.18" +version = "0.1.20" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b8138b380908e85071bdd6b2841a38b0858ef09848b754a15219d0b9ca90928" +checksum = "0af8c3e5087969c323f667ccb4b789fa0954f5aa650550e38e81cf9108be21b5" dependencies = [ "crossbeam", "defer", @@ -1397,9 +1427,9 @@ dependencies = [ [[package]] name = "proc-macro2" -version = "1.0.101" +version = "1.0.106" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "89ae43fd86e4158d6db51ad8e2b80f313af9cc74f5c0e03ccb87de09998732de" +checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" dependencies = [ "unicode-ident", ] @@ -1433,9 +1463,9 @@ dependencies = [ [[package]] name = "qd" -version = "0.7.4" +version = "0.7.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "73940173cf92cd24f3650f5f388946524026712a6ca170762340acf5fb3fde0f" +checksum = "ff8bb755b6008c3b41bf8a0866c8dd4e1245a2f011ceaa22a13ee55c538493e2" dependencies = [ "bytemuck", "libm", @@ -1445,18 +1475,18 @@ dependencies = [ [[package]] name = "quote" -version = "1.0.40" +version = "1.0.45" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1885c039570dc00dcb4ff087a89e185fd56bae234ddc7f056a945bf36467248d" +checksum = "41f2619966050689382d2b44f664f4bc593e129785a36d6ee376ddf37259b924" dependencies = [ "proc-macro2", ] [[package]] name = "r-efi" -version = "5.2.0" +version = "5.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "74765f6d916ee2faa39bc8e68e4f3ed8949b48cccdac59983d287a7cb71ce9c5" +checksum = "69cdb34c158ceb288df11e18b4bd39de994f6657d83847bdffdbd7f346754b0f" [[package]] name = "rand" @@ -1476,7 +1506,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "6db2770f06117d490610c7488547d543617b21bfa07796d7a12f6f1bd53850d1" dependencies = [ "rand_chacha 0.9.0", - "rand_core 0.9.3", + "rand_core 0.9.5", ] [[package]] @@ -1496,7 +1526,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "d3022b5f1df60f26e1ffddd6c66e8aa15de382ae63b3a0c1bfc0e4d3e3f325cb" dependencies = [ "ppv-lite86", - "rand_core 0.9.3", + "rand_core 0.9.5", ] [[package]] @@ -1505,16 +1535,16 @@ version = "0.6.4" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ec0be4795e2f6a28069bec0b5ff3e2ac9bafc99e6a9a7dc3547996c5c816922c" dependencies = [ - "getrandom 0.2.15", + "getrandom 0.2.17", ] [[package]] name = "rand_core" -version = "0.9.3" +version = "0.9.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "99d9a13982dcf210057a8a78572b2217b667c3beacbf3a0d8b454f6f82837d38" +checksum = "76afc826de14238e6e8c374ddcc1fa19e374fd8dd986b0d2af0d02377261d83c" dependencies = [ - "getrandom 0.3.2", + "getrandom 0.3.4", ] [[package]] @@ -1543,14 +1573,14 @@ version = "0.7.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "f703f4665700daf5512dcca5f43afa6af89f09db47fb56be587f80636bda2d41" dependencies = [ - "rand_core 0.9.3", + "rand_core 0.9.5", ] [[package]] name = "raw-cpuid" -version = "11.5.0" +version = "11.6.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c6df7ab838ed27997ba19a4664507e6f82b41fe6e20be42929332156e5e85146" +checksum = "498cd0dc59d73224351ee52a95fee0f1a617a2eae0e7d9d720cc622c73a54186" dependencies = [ "bitflags", ] @@ -1589,9 +1619,9 @@ checksum = "03251193000f4bd3b042892be858ee50e8b3719f2b08e5833ac4353724632430" [[package]] name = "regex-automata" -version = "0.4.9" +version = "0.4.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "809e8dc61f6de73b46c85f4c96486310fe304c434cfa43669d7b40f711150908" +checksum = "6e1dd4122fc1595e8162618945476892eefca7b88c52820e74af6262213cae8f" dependencies = [ "aho-corasick", "memchr", @@ -1600,21 +1630,21 @@ dependencies = [ [[package]] name = "regex-syntax" -version = "0.8.5" +version = "0.8.10" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b15c43186be67a4fd63bee50d0303afffcef381492ebe2c5d87f324e1b8815c" +checksum = "dc897dd8d9e8bd1ed8cdad82b5966c3e0ecae09fb1907d58efaa013543185d0a" [[package]] name = "rustversion" -version = "1.0.20" +version = "1.0.22" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eded382c5f5f786b989652c49544c4877d9f015cc22e145a5ea8ea66c2921cd2" +checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" [[package]] name = "ryu" -version = "1.0.20" +version = "1.0.23" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "28d3b2b1366ec20994f1fd18c3c594f05c5dd4bc44d8bb0c1c632c8d6829481f" +checksum = "9774ba4a74de5f7b1c1451ed6cd5285a32eddb5cccb8cc655a4e50009e06477f" [[package]] name = "safe_arch" @@ -1648,41 +1678,52 @@ checksum = "1bc711410fbe7399f390ca1c3b60ad0f53f80e95c5eb935e52268a0e2cd49acc" [[package]] name = "serde" -version = "1.0.219" +version = "1.0.228" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f0e2c6ed6606019b4e29e69dbaba95b11854410e5347d525002456dbbb786b6" +checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" +dependencies = [ + "serde_core", + "serde_derive", +] + +[[package]] +name = "serde_core" +version = "1.0.228" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" dependencies = [ "serde_derive", ] [[package]] name = "serde_derive" -version = "1.0.219" +version = "1.0.228" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b0276cf7f2c73365f7157c8123c21cd9a50fbbd844757af28ca1f5925fc2a00" +checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] name = "serde_json" -version = "1.0.140" +version = "1.0.149" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "20068b6e96dc6c9bd23e01df8827e6c7e1f2fddd43c21810382803c136b99373" +checksum = "83fc039473c5595ace860d8c4fafa220ff474b3fc6bfdb4293327f1a37e94d86" dependencies = [ "itoa", "memchr", - "ryu", "serde", + "serde_core", + "zmij", ] [[package]] name = "sha2" -version = "0.10.8" +version = "0.10.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "793db75ad2bcafc3ffa7c68b215fee268f537982cd901d132f89c6343f3a3dc8" +checksum = "a7507d819769d01a365ab707794a4084392c824f54a7a6a7862f8c3d0892b283" dependencies = [ "cfg-if", "cpufeatures", @@ -1706,9 +1747,9 @@ checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" [[package]] name = "simba" -version = "0.9.0" +version = "0.9.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b3a386a501cd104797982c15ae17aafe8b9261315b5d07e3ec803f2ea26be0fa" +checksum = "c99284beb21666094ba2b75bbceda012e610f5479dfcc2d6e2426f53197ffd95" dependencies = [ "approx", "num-complex", @@ -1719,9 +1760,9 @@ dependencies = [ [[package]] name = "smallvec" -version = "1.14.0" +version = "1.15.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7fcf8323ef1faaee30a44a340193b1ac6814fd9b7b4e88e9d4519a3e4abe1cfd" +checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" [[package]] name = "sobol_burley" @@ -1731,9 +1772,9 @@ checksum = "09f37cae1d97c4078377153ede7a26f7813b689ad5c6b76ff45dc52e53afe1d1" [[package]] name = "spindle" -version = "0.2.5" +version = "0.2.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f794dedb367e82477aa6bbf83ea9bbce9bc074b3caacaa82fc4ba398ec9b701d" +checksum = "673aaca3d8aa5387a6eba861fbf984af5348d9df5d940c25c6366b19556fdf64" dependencies = [ "atomic-wait", "crossbeam", @@ -1773,9 +1814,9 @@ dependencies = [ [[package]] name = "syn" -version = "2.0.106" +version = "2.0.117" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ede7c438028d4436d71104916910f5bb611972c5cfd7f89b8300a8186e6fada6" +checksum = "e665b8803e7b1d2a727f4023456bbbbe74da67099c585258af0ad9c5013b9b99" dependencies = [ "proc-macro2", "quote", @@ -1807,11 +1848,11 @@ dependencies = [ [[package]] name = "thiserror" -version = "2.0.17" +version = "2.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f63587ca0f12b72a0600bcba1d40081f830876000bb46dd2337a3051618f4fc8" +checksum = "4288b5bcbc7920c07a1149a35cf9590a2aa808e0bc1eafaade0b80947865fbc4" dependencies = [ - "thiserror-impl 2.0.17", + "thiserror-impl 2.0.18", ] [[package]] @@ -1822,56 +1863,55 @@ checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] name = "thiserror-impl" -version = "2.0.17" +version = "2.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3ff15c8ecd7de3849db632e14d18d2571fa09dfc5ed93479bc4485c7a517c913" +checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] name = "thread_local" -version = "1.1.8" +version = "1.1.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b9ef9bad013ada3808854ceac7b46812a6465ba368859a37e2100283d2d719c" +checksum = "f60246a4944f24f6e018aa17cdeffb7818b76356965d03b07d6a9886e8962185" dependencies = [ "cfg-if", - "once_cell", ] [[package]] name = "time" -version = "0.3.41" +version = "0.3.47" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a7619e19bc266e0f9c5e6686659d394bc57973859340060a69221e57dbc0c40" +checksum = "743bd48c283afc0388f9b8827b976905fb217ad9e647fae3a379a9283c4def2c" dependencies = [ "deranged", "itoa", "num-conv", "powerfmt", - "serde", + "serde_core", "time-core", "time-macros", ] [[package]] name = "time-core" -version = "0.1.4" +version = "0.1.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c9e9a38711f559d9e3ce1cdb06dd7c5b8ea546bc90052da6d06bb76da74bb07c" +checksum = "7694e1cfe791f8d31026952abf09c69ca6f6fa4e1a1229e18988f06a04a12dca" [[package]] name = "time-macros" -version = "0.2.22" +version = "0.2.27" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3526739392ec93fd8b359c8e98514cb3e8e021beb4e5f597b00a0221f8ed8a49" +checksum = "2e70e4c5a0e0a8a4823ad65dfe1a6930e4f4d756dcd9dd7939022b5e8c501215" dependencies = [ "num-conv", "time-core", @@ -1879,9 +1919,9 @@ dependencies = [ [[package]] name = "tracing" -version = "0.1.41" +version = "0.1.44" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "784e0ac535deb450455cbfa28a6f0df145ea1bb7ae51b821cf5e7927fdcfbdd0" +checksum = "63e71662fa4b2a2c3a26f570f037eb95bb1f85397f3cd8076caed2f026a6d100" dependencies = [ "pin-project-lite", "tracing-attributes", @@ -1890,20 +1930,20 @@ dependencies = [ [[package]] name = "tracing-attributes" -version = "0.1.28" +version = "0.1.31" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "395ae124c09f9e6918a2310af6038fba074bcf474ac352496d5910dd59a2226d" +checksum = "7490cfa5ec963746568740651ac6781f701c9c5ea257c58e057f3ba8cf69e8da" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] name = "tracing-core" -version = "0.1.33" +version = "0.1.36" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e672c95779cf947c5311f83787af4fa8fffd12fb27e4993211a84bdfd9610f9c" +checksum = "db97caf9d906fbde555dd62fa95ddba9eecfd14cb388e4f491a66d74cd5fb79a" dependencies = [ "once_cell", "valuable", @@ -1922,9 +1962,9 @@ dependencies = [ [[package]] name = "tracing-subscriber" -version = "0.3.20" +version = "0.3.22" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2054a14f5307d601f88daf0553e1cbf472acc4f2c51afab632431cdcd72124d5" +checksum = "2f30143827ddab0d256fd843b7a66d164e9f271cfa0dde49142c5ca0ca291f1e" dependencies = [ "matchers", "nu-ansi-term", @@ -1941,9 +1981,9 @@ dependencies = [ [[package]] name = "typenum" -version = "1.18.0" +version = "1.19.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1dccffe3ce07af9386bfd29e80c0ab1a8205a2fc34e4bcd40364df902cfa8f3f" +checksum = "562d481066bde0658276a35467c4af00bdc6ee726305698a55b86e61d7ad82bb" [[package]] name = "ucd-trie" @@ -1953,9 +1993,9 @@ checksum = "2896d95c02a80c6d6a5d6e953d479f5ddf2dfdb6a244441010e373ac0fb88971" [[package]] name = "unicode-ident" -version = "1.0.18" +version = "1.0.24" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a5f39404a5da50712a4c1eecf25e90dd62b613502b7e925fd4e4d19b5c96512" +checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75" [[package]] name = "valuable" @@ -1981,49 +2021,37 @@ dependencies = [ [[package]] name = "wasi" -version = "0.11.0+wasi-snapshot-preview1" +version = "0.11.1+wasi-snapshot-preview1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423" +checksum = "ccf3ec651a847eb01de73ccad15eb7d99f80485de043efb2f370cd654f4ea44b" [[package]] -name = "wasi" -version = "0.14.2+wasi-0.2.4" +name = "wasip2" +version = "1.0.2+wasi-0.2.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9683f9a5a998d873c0d21fcbe3c083009670149a8fab228644b8bd36b2c48cb3" +checksum = "9517f9239f02c069db75e65f174b3da828fe5f5b945c4dd26bd25d89c03ebcf5" dependencies = [ - "wit-bindgen-rt", + "wit-bindgen", ] [[package]] name = "wasm-bindgen" -version = "0.2.100" +version = "0.2.114" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1edc8929d7499fc4e8f0be2262a241556cfc54a0bea223790e71446f2aab1ef5" +checksum = "6532f9a5c1ece3798cb1c2cfdba640b9b3ba884f5db45973a6f442510a87d38e" dependencies = [ "cfg-if", "once_cell", + "rustversion", "wasm-bindgen-macro", -] - -[[package]] -name = "wasm-bindgen-backend" -version = "0.2.100" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2f0a0651a5c2bc21487bde11ee802ccaf4c51935d0d3d42a6101f98161700bc6" -dependencies = [ - "bumpalo", - "log", - "proc-macro2", - "quote", - "syn 2.0.106", "wasm-bindgen-shared", ] [[package]] name = "wasm-bindgen-macro" -version = "0.2.100" +version = "0.2.114" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7fe63fc6d09ed3792bd0897b314f53de8e16568c2b3f7982f468c0bf9bd0b407" +checksum = "18a2d50fcf105fb33bb15f00e7a77b772945a2ee45dcf454961fd843e74c18e6" dependencies = [ "quote", "wasm-bindgen-macro-support", @@ -2031,22 +2059,22 @@ dependencies = [ [[package]] name = "wasm-bindgen-macro-support" -version = "0.2.100" +version = "0.2.114" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8ae87ea40c9f689fc23f209965b6fb8a99ad69aeeb0231408be24920604395de" +checksum = "03ce4caeaac547cdf713d280eda22a730824dd11e6b8c3ca9e42247b25c631e3" dependencies = [ + "bumpalo", "proc-macro2", "quote", - "syn 2.0.106", - "wasm-bindgen-backend", + "syn 2.0.117", "wasm-bindgen-shared", ] [[package]] name = "wasm-bindgen-shared" -version = "0.2.100" +version = "0.2.114" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1a05d73b933a847d6cccdda8f838a22ff101ad9bf93e33684f39c1f5f0eece3d" +checksum = "75a326b8c223ee17883a4251907455a2431acc2791c98c26279376490c378c16" dependencies = [ "unicode-ident", ] @@ -2063,9 +2091,9 @@ dependencies = [ [[package]] name = "wide" -version = "0.7.32" +version = "0.7.33" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41b5576b9a81633f3e8df296ce0063042a73507636cbe956c61133dd7034ab22" +checksum = "0ce5da8ecb62bcd8ec8b7ea19f69a51275e91299be594ea5cc6ef7819e16cd03" dependencies = [ "bytemuck", "safe_arch", @@ -2073,111 +2101,24 @@ dependencies = [ [[package]] name = "winapi-util" -version = "0.1.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cf221c93e13a30d793f7645a0e7762c55d169dbb0a49671918a2319d289b10bb" -dependencies = [ - "windows-sys 0.59.0", -] - -[[package]] -name = "windows" -version = "0.61.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c5ee8f3d025738cb02bad7868bbb5f8a6327501e870bf51f1b455b0a2454a419" -dependencies = [ - "windows-collections", - "windows-core", - "windows-future", - "windows-link", - "windows-numerics", -] - -[[package]] -name = "windows-collections" -version = "0.2.0" +version = "0.1.11" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3beeceb5e5cfd9eb1d76b381630e82c4241ccd0d27f1a39ed41b2760b255c5e8" +checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" dependencies = [ - "windows-core", -] - -[[package]] -name = "windows-core" -version = "0.61.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "46ec44dc15085cea82cf9c78f85a9114c463a369786585ad2882d1ff0b0acf40" -dependencies = [ - "windows-implement", - "windows-interface", - "windows-link", - "windows-result", - "windows-strings", -] - -[[package]] -name = "windows-future" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc6a41e98427b19fe4b73c550f060b59fa592d7d686537eebf9385621bfbad8e" -dependencies = [ - "windows-core", - "windows-link", - "windows-threading", -] - -[[package]] -name = "windows-implement" -version = "0.60.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a47fddd13af08290e67f4acabf4b459f647552718f683a7b415d290ac744a836" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.106", -] - -[[package]] -name = "windows-interface" -version = "0.59.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd9211b69f8dcdfa817bfd14bf1c97c9188afa36f4750130fcdf3f400eca9fa8" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.106", + "windows-sys 0.61.2", ] [[package]] name = "windows-link" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "76840935b766e1b0a05c0066835fb9ec80071d4c09a16f6bd5f7e655e3c14c38" - -[[package]] -name = "windows-numerics" -version = "0.2.0" +version = "0.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9150af68066c4c5c07ddc0ce30421554771e528bde427614c61038bc2c92c2b1" -dependencies = [ - "windows-core", - "windows-link", -] +checksum = "f0805222e57f7521d6a62e36fa9163bc891acd422f971defe97d64e70d0a4fe5" [[package]] name = "windows-result" -version = "0.3.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4b895b5356fc36103d0f64dd1e94dfa7ac5633f1c9dd6e80fe9ec4adef69e09d" -dependencies = [ - "windows-link", -] - -[[package]] -name = "windows-strings" version = "0.4.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2a7ab927b2637c19b3dbe0965e75d8f2d30bdd697a1516191cad2ec4df8fb28a" +checksum = "7781fa89eaf60850ac3d2da7af8e5242a5ea78d1a11c49bf2910bb5a73853eb5" dependencies = [ "windows-link", ] @@ -2188,45 +2129,20 @@ version = "0.42.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "5a3e1820f08b8513f676f7ab6c1f99ff312fb97b553d30ff4dd86f9f15728aa7" dependencies = [ - "windows_aarch64_gnullvm 0.42.2", - "windows_aarch64_msvc 0.42.2", - "windows_i686_gnu 0.42.2", - "windows_i686_msvc 0.42.2", - "windows_x86_64_gnu 0.42.2", - "windows_x86_64_gnullvm 0.42.2", - "windows_x86_64_msvc 0.42.2", + "windows_aarch64_gnullvm", + "windows_aarch64_msvc", + "windows_i686_gnu", + "windows_i686_msvc", + "windows_x86_64_gnu", + "windows_x86_64_gnullvm", + "windows_x86_64_msvc", ] [[package]] name = "windows-sys" -version = "0.59.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1e38bc4d79ed67fd075bcc251a1c39b32a1776bbe92e5bef1f0bf1f8c531853b" -dependencies = [ - "windows-targets", -] - -[[package]] -name = "windows-targets" -version = "0.52.6" +version = "0.61.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9b724f72796e036ab90c1021d4780d4d3d648aca59e491e6b98e725b84e99973" -dependencies = [ - "windows_aarch64_gnullvm 0.52.6", - "windows_aarch64_msvc 0.52.6", - "windows_i686_gnu 0.52.6", - "windows_i686_gnullvm", - "windows_i686_msvc 0.52.6", - "windows_x86_64_gnu 0.52.6", - "windows_x86_64_gnullvm 0.52.6", - "windows_x86_64_msvc 0.52.6", -] - -[[package]] -name = "windows-threading" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b66463ad2e0ea3bbf808b7f1d371311c80e115c0b71d60efc142cafbcfb057a6" +checksum = "ae137229bcbd6cdf0f7b80a31df61766145077ddf49416a728b02cb3921ff3fc" dependencies = [ "windows-link", ] @@ -2237,78 +2153,36 @@ version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "597a5118570b68bc08d8d59125332c54f1ba9d9adeedeef5b99b02ba2b0698f8" -[[package]] -name = "windows_aarch64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32a4622180e7a0ec044bb555404c800bc9fd9ec262ec147edd5989ccd0c02cd3" - [[package]] name = "windows_aarch64_msvc" version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "e08e8864a60f06ef0d0ff4ba04124db8b0fb3be5776a5cd47641e942e58c4d43" -[[package]] -name = "windows_aarch64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "09ec2a7bb152e2252b53fa7803150007879548bc709c039df7627cabbd05d469" - [[package]] name = "windows_i686_gnu" version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c61d927d8da41da96a81f029489353e68739737d3beca43145c8afec9a31a84f" -[[package]] -name = "windows_i686_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e9b5ad5ab802e97eb8e295ac6720e509ee4c243f69d781394014ebfe8bbfa0b" - -[[package]] -name = "windows_i686_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0eee52d38c090b3caa76c563b86c3a4bd71ef1a819287c19d586d7334ae8ed66" - [[package]] name = "windows_i686_msvc" version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "44d840b6ec649f480a41c8d80f9c65108b92d89345dd94027bfe06ac444d1060" -[[package]] -name = "windows_i686_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "240948bc05c5e7c6dabba28bf89d89ffce3e303022809e73deaefe4f6ec56c66" - [[package]] name = "windows_x86_64_gnu" version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "8de912b8b8feb55c064867cf047dda097f92d51efad5b491dfb98f6bbb70cb36" -[[package]] -name = "windows_x86_64_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "147a5c80aabfbf0c7d901cb5895d1de30ef2907eb21fbbab29ca94c5b08b1a78" - [[package]] name = "windows_x86_64_gnullvm" version = "0.42.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "26d41b46a36d453748aedef1486d5c7a85db22e56aff34643984ea85514e94a3" -[[package]] -name = "windows_x86_64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "24d5b23dc417412679681396f2b49f3de8c1473deb516bd34410872eff51ed0d" - [[package]] name = "windows_x86_64_msvc" version = "0.42.2" @@ -2316,56 +2190,33 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "9aec5da331524158c6d1a4ac0ab1541149c0b9505fde06423b02f5ef0106b9f0" [[package]] -name = "windows_x86_64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "589f6da84c646204747d1270a2a5661ea66ed1cced2631d546fdfb155959f9ec" - -[[package]] -name = "wit-bindgen-rt" -version = "0.39.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6f42320e61fe2cfd34354ecb597f86f413484a798ba44a8ca1165c58d42da6c1" -dependencies = [ - "bitflags", -] - -[[package]] -name = "zerocopy" -version = "0.7.35" +name = "wit-bindgen" +version = "0.51.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1b9b4fd18abc82b8136838da5d50bae7bdea537c574d8dc1a34ed098d6c166f0" -dependencies = [ - "zerocopy-derive 0.7.35", -] +checksum = "d7249219f66ced02969388cf2bb044a09756a083d0fab1e566056b04d9fbcaa5" [[package]] name = "zerocopy" -version = "0.8.24" +version = "0.8.42" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2586fea28e186957ef732a5f8b3be2da217d65c5969d4b1e17f973ebbe876879" +checksum = "f2578b716f8a7a858b7f02d5bd870c14bf4ddbbcf3a4c05414ba6503640505e3" dependencies = [ - "zerocopy-derive 0.8.24", + "zerocopy-derive", ] [[package]] name = "zerocopy-derive" -version = "0.7.35" +version = "0.8.42" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fa4f8080344d4671fb4e831a13ad1e68092748387dfc4f55e356242fae12ce3e" +checksum = "7e6cc098ea4d3bd6246687de65af3f920c430e236bee1e3bf2e441463f08a02f" dependencies = [ "proc-macro2", "quote", - "syn 2.0.106", + "syn 2.0.117", ] [[package]] -name = "zerocopy-derive" -version = "0.8.24" +name = "zmij" +version = "1.0.21" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a996a8f63c5c4448cd959ac1bab0aaa3306ccfd060472f85943ee0750f0169be" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.106", -] +checksum = "b8848ee67ecc8aedbaf3e4122217aff892639231befc6a1b58d29fff4c2cabaa" diff --git a/DESCRIPTION b/DESCRIPTION index 8e5492ccc..48eac599d 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,7 +15,7 @@ Authors@R: c( person("David", "Bayard", email = "", role = "ctb"), person("Robert", "Leary", email = "", role = "ctb") ) -Version: 3.0.9 +Version: 3.0.10 URL: https://lapkb.github.io/Pmetrics_rust/ BugReports: https://github.com/LAPKB/Pmetrics_rust/issues SystemRequirements: Cargo (>= 1.82) (Rust's package manager), rustc diff --git a/NAMESPACE b/NAMESPACE index 56f0a9aba..ed86ea4e7 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -97,6 +97,7 @@ export(additive) export(all_is_numeric) export(build_model) export(build_plot) +export(check_updates) export(clear_build) export(cli_ask) export(cli_df) @@ -104,6 +105,7 @@ export(click_plot) export(compile_model) export(cor2cov) export(create_pmetrics_project) +export(downloadR) export(dummy_compile) export(export_plotly) export(fit) @@ -114,6 +116,7 @@ export(getPMoptions) export(getPalettes) export(interp) export(is_cargo_installed) +export(latestR) export(makeAUC) export(makeErrorPoly) export(makeNCA) diff --git a/R/PM_compare.R b/R/PM_compare.R index 7d5ba7427..f4d6419a9 100755 --- a/R/PM_compare.R +++ b/R/PM_compare.R @@ -23,8 +23,9 @@ #' @param outeq Number of the output equation to compare; default is 1. #' @param plot Boolean indicating whether to generate and open the comparison report; default is FALSE #' @return A highlighted table comparing the selected models with the following columns. In each metric column, -#' the best (lowest) value is highlighted in red. In the final best column, the red highlighting applies to the model -#' with the most "best" metrics. +#' the best value is highlighted in red. In the final best column, the red highlighting applies to the model +#' with the most "best" metrics. For bias, imprecision, and regression intercept, the best value is the one closest to zero. +#' For regression slope and R-squared, the best value is the one closest to 1. For -2*LL, AIC, and BIC, the best value is the lowest. #' * **run** The run number of the data # #' * **nsub** Number of subjects in the model #' * **nvar** Number of random parameters in the model @@ -128,7 +129,7 @@ PM_compare <- function(..., icen = "median", outeq = 1, plot = FALSE) { sumobjPop <- purrr::map(op, \(x) summary.PM_op(x, outeq = outeq, pred.type = "pop", icen = icen)) sumobjPost <- purrr::map(op, \(x) summary.PM_op(x, outeq = outeq, pred.type = "post", icen = icen)) - + #### MAKE BIAS AND IMPRECISION PLOT #### @@ -430,6 +431,7 @@ flextable::autofit() # make results table results <- data.frame( + run = objNames[1:nobj], # nsub = purrr::map_int(allObj, \(x) { # x$final$nsub @@ -437,7 +439,7 @@ results <- data.frame( nvar = purrr::map_int(allObj, \(x) length(names(x$final$popMean))), # par = purrr::map_chr(allObj, \(x) paste(names(x$final$popMean), collapse = ", ")), converged = purrr::map_lgl(allObj, \(x) { - x$cycle$data$status == "Converged" + grepl("Converged", x$cycle$data$status) }), ll = purrr::map_dbl(allObj, \(x) { tail(x$cycle$data$objective$neg2ll, 1) @@ -479,8 +481,34 @@ pivot_wider(id_cols = c(run), names_from = c(pred.type), names_glue = "{pred.typ results <- bind_cols(results, op_tbl %>% select(-run)) results$pval <- t -results$best <- results %>% select(c(-run, -nvar, -converged, -pval)) %>% map(~ which(.x == min(.x))) %>% unlist() %>% table() -attr(results, "highlight") <- TRUE + +# calculate the best in each metric column: +# for -2*LL, AIC/BIC, bias, imprecision, and regression intercept the best is the value closest to zero; +# for slope and R2, best is the closest to 1 +metric_cols <- names(results)[!names(results) %in% c("run", "nvar", "converged", "pval")] + +best_idx <- purrr::map(metric_cols, function(col) { + x <- suppressWarnings(as.numeric(results[[col]])) + valid <- which(!is.na(x)) + if (length(valid) == 0) { + return(integer(0)) + } + target <- ifelse(grepl("Sl|R2", col), 1, 0) + valid[which(abs(x[valid] - target) == min(abs(x[valid] - target)))] +}) + +best_counts <- integer(nobj) +for (idx in best_idx) { + if (length(idx) > 0) { + best_counts[idx] <- best_counts[idx] + 1L + } +} + +results$best <- best_counts +attr(results, "highlight") <- list( + metric_cols = setdiff(metric_cols, "best"), + best_col = "best" +) class(results) <- c("PM_compare", "data.frame") diff --git a/R/PM_data.R b/R/PM_data.R index b244beaaa..00a31ca7f 100755 --- a/R/PM_data.R +++ b/R/PM_data.R @@ -310,9 +310,9 @@ addEvent = function(..., dt = NULL, quiet = FALSE, validate = FALSE) { new_data <- dplyr::bind_rows(self$data, to_add) %>% dplyr::arrange(id, time) - self$data <- new_data + self$data <- new_data if (validate) { - self$data <- self$data %>% dplyr::select(where(~ !all(is.na(.x)))) + self$data <- self$data %>% dplyr::select(where(~ !all(is.na(.x)))) %>% arrange(id, time, out) self$standard_data <- private$validate(self$data, path = getwd(), dt = dt, quiet = quiet) } else { self$standard_data <- NULL @@ -432,6 +432,10 @@ private = list( cat(msg) } + # sort by id, time, dose + dataObj_orig <- dataObj_orig %>% arrange(id, time, out) # for any out at same time as dose, out will come first + dataObj <- dataObj %>% arrange(id, time, out) + validData <- PMcheck(data = list(standard = dataObj, original = dataObj_orig), path = path, fix = TRUE, quiet = quiet) return(validData) } # end validate function @@ -593,7 +597,18 @@ PMmatrixRelTime <- function( if (is.numeric(timeCol)) timeCol <- dataCols[timeCol] if (is.numeric(evidCol)) evidCol <- dataCols[evidCol] - # all reasonable combinations + # Get preferred date format from PMoptions; derive lubridate order string (e.g. "%m/%d/%y" -> "mdy") + opt_date_fmt <- getPMoptions("date_format", warn = FALSE, quiet = TRUE) + if (!is.character(opt_date_fmt) || !nzchar(opt_date_fmt)) { + opt_date_fmt <- if (grepl("en_US", Sys.getlocale("LC_TIME"), fixed = TRUE)) "%m/%d/%y" else "%d/%m/%y" + } + opt_date_order <- paste( + tolower(gsub("Y", "y", regmatches(opt_date_fmt, gregexpr("(?<=%)[a-zA-Z]", opt_date_fmt, perl = TRUE))[[1]])), + collapse = "" + ) + opt_formats <- paste(opt_date_order, c("HM", "HMS", "IMOp", "IMSOp")) + + # all reasonable combinations (fallback) dt_df <- tidyr::crossing(date = c("dmy", "mdy", "ymd", "ydm"), time = c("HM", "HMS", "IMOp", "IMSOp")) dt_formats <- paste(dt_df$date, dt_df$time) @@ -616,866 +631,897 @@ PMmatrixRelTime <- function( return(the_format) } - dt <- NA + found_format <- character(0) + + # Step 1: explicit format argument takes priority if (!missing(format) && !is.null(format)) { if (format[2] == "HM") format[2] <- "HMS" format <- paste(format, collapse = " ") - dt <- tryCatch(suppressWarnings(lubridate::parse_date_time(paste(temp$date, temp$time), quiet = TRUE, format)), - error = function(e) e - ) # try with specific format - found_format <- get_dt_format(format) - } - if (all(is.na(dt))) { # didn't parse yet, try automatic parsing - dt <- tryCatch(suppressWarnings(lubridate::parse_date_time(paste(temp$date, temp$time), quiet = TRUE, dt_formats)), - error = function(e) e - ) - found_format <- get_dt_format(dt_formats) -} - -if (all(is.na(dt))) { - cli::cli_abort(c("x" = "All dates/times failed to parse. Please specify correct format. ")) -} - - -temp$dt <- dt # didn't have to stop, so at least some parsed - -if (split) { - # calculate PK event numbers for each patient - for (i in unique(temp$id)) { - pk.no <- 1 - temp2 <- subset(temp, temp$id == i) - for (j in 1:nrow(temp2)) { - if (temp2$evid[j] == 4) { - pk.no <- pk.no + 1 - } - temp2$pk.no[j] <- pk.no + dt <- tryCatch( + suppressWarnings(lubridate::parse_date_time(paste(temp$date, temp$time), quiet = TRUE, format)), + error = function(e) NA + ) + found_format <- get_dt_format(format) } - temp$pk.no[temp$id == i] <- temp2$pk.no - } - # make new ID of form xxxxx.x for each PK event per patient - temp$id <- temp$id + temp$pk.no / 10 - temp$evid[temp$evid == 4] <- 1 -} - -# calculate relative times -temp <- makePMmatrixBlock(temp) %>% -dplyr::group_by(id, block) %>% -dplyr::mutate(relTime = (dt - dt[1]) / lubridate::dhours(1)) - -temp$relTime <- round(temp$relTime, 2) -temp <- temp[, c("id", "evid", "relTime")] -attr(temp, "dt_format") <- found_format - -return(temp) -} -#' @title Check Pmetrics Inputs for Errors -#' @description -#' `r lifecycle::badge("superseded")` -#' -#' This function is largely superseded as it is called automatically when -#' data are initialized as a [PM_data] object. It can still be called -#' independently of this route and will check for data errors. -#' @details -#' It will check the data for errors -#' which would cause the analysis to fail. Note that as of -#' Pmetrics Version 2, this function is called automatically when a new [PM_data] -#' object is created, and users generally no longer need to call the function directly. -#' In `PM_data$new()`, the data object is first standardized to contain all required columns, -#' since only "ID", "TIME", "DOSE" and "OUT" are required at minimum, and then checked with PMcheck. -#' -#' If calling PMcheck directly, either a filename or a Pmetrics data object in memory are accepted as `data`. -#' Because there is no standardization with direct calls, in this case the format of the .csv matrix file is fairly rigid. -#' It must have the following features. Text is case-sensitive. -#' * A header in row 1 with the appropriate version, currently "POPDATA DEC_11" -#' * Column headers in row 2. These headers are: #ID, EVID, TIME, DUR, DOSE, ADDL, II, INPUT, OUT, CENS, OUTEQ, -#' C0, C1, C2, C3. -#' * No cell should be empty. It should either contain a value or "." as a placeholder. -#' * Columns after C3 are interpreted as covariates. -#' * All subject records must begin with TIME=0. -#' * All dose events (EVID=1) must have entries in ID, EVID, TIME, DUR, DOSE and INPUT. ADDL and II are optional, but if ADDL is not 0 or -#' missing, then II is mandatory. -#' * All observation events (EVID=0) must have entries in ID, EVID, TIME, OUT, OUTEQ. -#' If an observation is missing, use -99; otherwise use a "." as a placeholder -#' in cells that are not required (e.g. INPUT for an observation event). -#' * If covariates are present in the data, there must be an entry for every covariate at time 0 for each subject. -#' * All covariates must be numeric. -#' * All times within a subject ID must be monotonically increasing. -#' * All subject IDs must be contiguous. -#' * All rows must have EVID and TIME values. -#' * All columns must be numeric except ID which may be alpha-numeric. -#' * All subjects must have at least one observation, which could be missing, i.e. -99. -#' * Cells which are not needed (e.g. dose on an observation event, EVID=0), should contain ".". -#' -#' To use this function, see the example below. -#' -#' After running PMcheck and looking at the errors in the *errors.xlsx* file, you can fix the -#' errors manually directly in the *errors.xlsx* file and resave it as a .csv file. -#' Alternatively, you could then try to fix the problem(s) with `mdata2 <- PMcheck(mdata,fix=T)`. Note that we are now returning -#' a PMmatrix data object called mdata2 (hopefully cleaned of errors) rather than the PMerr object returned when `fix=FALSE`. -#' Pmetrics handles each of the errors in the following ways. -#' * If the columns are simply out of order, they will be reordered. If some are missing, the fix must -#' be done by the user, i.e. manually. -#' * All id and covariate values are truncated to 11 characters. -#' * Missing observations are set to -99 (not "."). -#' * Incomplete dose records are flagged for the user to fix manually. -#' * Incomplete observation records are flagged for the user to fix manually. -#' * Subjects without an EVID=1 as first event are flagged for the user to fix manually. -#' * Subjects with TIME != 0 as first event have dummy dose=0 events inserted at time 0. -#' * Subjects with a missing covariate at time 0 are flagged for the user to fix manually. -#' * Non-numeric covariates are converted to numeric (via [factor()]). -#' * Non-ordered times are sorted within a subject if there are no EVID=4 events; otherwise the -#' user must fix manually. -#' * Non-contiguous subject ID rows are combined and sorted if there are no EVID=4 events; otherwise the -#' user must fix manually. -#' * Rows missing an EVID are assigned a value of 0 if DOSE is missing, 1 otherwise. -#' * Rows missing a TIME value are flagged for the user to fix manually. -#' * Cells with malformed NA values are attempted to be fixed. -#' * Columns that are non-numeric which must be numeric are flagged for the user to fix manually. -#' These are all columns except ID. -#' Covariate columns are fixed separately (see above). -#' * Dose events with censoring will be set to uncensored, with a warning to the user. -#' -#' @param data The name of a Pmetrics .csv matrix file in the current working directory, -#' the full path to one not in the current working directory, or a data.frame containing -#' the output of a previous [PMreadMatrix] command. -#' @param path The path of the data if originally a file -#' @param fix Boolean operator; if `TRUE`, Pmetrics will attempt to fix errors in the data file. -#' Default is `FALSE`. -#' @param quiet Boolean operator to suppress printed output. Default is false. -#' @return If `fix=TRUE`, then [PMcheck] returns -#' * The original data if no errors are found, or -#' * A PMmatrix data object which has been -#' cleaned of errors as much as possible, displaying a report on the console. -#' -#' If `fix=FALSE`, then [PMcheck] creates a file in the working directory called "errors.xlsx". -#' This file can be opened by Microsoft Excel or any other program that is capable of reading .xlsx files. This file -#' contains highlighted areas that are erroneous, with clarifying comments. You can correct the errors in the file -#' and then re-save as a .csv file. -#' -#' When `fix=FALSE`, the function also returns a list of objects of class *PMerr*. Each object is itself a list whose -#' first object (`$msg`) is a character vector with "OK" plus a brief description if there is no error, or the error. -#' The second object (`$results`) is a vector of the row numbers that contain that error. -#' * colorder The first 14 columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, c0, c1, c2, and c3 in that order. -#' * maxcharCol All column names should be less than or equal to 11 characters. -#' * maxcharID All id values should be less than or equal to 11 characters. -#' * missEVID Ensure that all rows have an EVID value. -#' * missTIME Ensure that all rows have a TIME value. -#' * doseDur Make sure all dose records are complete, i.e. contain a duration. -#' * doseDose Make sure all dose records are complete, i.e. contain a dose. -#' * doseInput Make sure all dose records are complete, i.e. contain an input number. -#' * obsOut Make sure all observation records are complete, i.e. contain an output. -#' * obsOuteq Make sure all observation records are complete, i.e. contain and outeq number. -#' * T0 Make sure each subject's first time=0. -#' * covT0 Make sure that there is an non-missing entry for each covariate at time=0 for each subject. -#' * timeOrder Ensure that all times within a subject ID are monotonically increasing. -#' * contigID Ensure that all subject IDs are contiguous. -#' * nonNum Ensure that all columns except ID are numeric. -#' * noObs Ensure that all subjects have at least one observation, which could be missing, i.e. -99. -#' * mal_NA Ensure that all NA values are ".", not ". ", " .", "..", or other malformations. -#' -#' @author Michael Neely and Patrick Nolain -#' @seealso [PMwriteMatrix], [PMreadMatrix] -#' @examples -#' \dontrun{ -#' err <- PMcheck(badData) -#' # look at the errors.xlsx file in the working directory -#' # try to automatically fix what can be fixed -#' goodData <- PMcheck(badCSV, fix = T) -#' PMcheck(goodData) -#' # you have to fix manually problems which require data entry -#' } -#' @export - -PMcheck <- function(data, path, fix = FALSE, quiet = FALSE) { - # get the data - if (is.character(data)) { # data is a filename - data2 <- tryCatch(PMreadMatrix(data, quiet = TRUE), error = function(e) { - # return(invisible(e)) - cli::cli_abort(c("x" = "Unable to find {data} in current working directory, {getwd()}.")) - }) - data_orig <- NULL - legacy <- attr(data2, "legacy") - source <- "file" - } else if (inherits(data, "PM_data")) { - cat("Running PMcheck on PM_data object, so using $standard_data.\n") - data2 <- data$standard_data - data_orig <- data$data - legacy <- FALSE - source <- "PM_data" - } else if (is.list(data) & !is.data.frame(data)) { # data is a list coming from PM_data$private$validate - data2 <- data$standard - data_orig <- data$original - legacy <- FALSE - source <- "list" - } else { # data is a PMmatrix object - data2 <- data - data_orig <- NULL - legacy <- attr(data2, "legacy") - source <- "PMmatrix" - } - if (is.null(legacy)) { - legacy <- F - } - - - # check for errors - err <- errcheck(data2, quiet = quiet, source = source) - if (length(err) == 1) { - cli::cli_abort(c("x" = "You must at least have id, evid, and time columns to proceed with the check.")) - } - - # report errors in errors.xlsx - if (attr(err, "error") != 0) { - # Initialize an Excel Workbook - wb <- openxlsx::createWorkbook() - # Add a Worksheet - sheet <- openxlsx::addWorksheet(wb, sheetName = "Errors") - wb <- writeErrorFile(data2, err, legacy = legacy, wb, sheet) - if (!fix) { - # Save the workbook if not going to fix - wb <- createInstructions(wb) - openxlsx::saveWorkbook(wb, file = file.path(path, "errors.xlsx"), overwrite = TRUE) + + # Step 2: try PMoptions date_format + if (all(is.na(dt))) { + dt <- tryCatch( + suppressWarnings(lubridate::parse_date_time(paste(temp$date, temp$time), quiet = TRUE, opt_formats)), + error = function(e) NA + ) + if (!all(is.na(dt))) { + found_format <- get_dt_format(opt_formats) + } } - } - - # Provide warning on console about maximum time - maxTime <- tryCatch(max(data2$time, na.rm = T), error = function(e) NA) - if (!is.na(maxTime) && !is.character(maxTime) && maxTime > 24 * 48 & !quiet) { - cli::cli_warn( - c( - "!" = "Your longest event horizon is {maxTime} hours.", - " " = "When fitting to a model, consider fewer predictions by making `idelta` longer than the default of 0.1 hours.", - " " = "See {.help PM_model} for details." + + # Step 3: fall back to automatic detection across all reasonable formats + if (all(is.na(dt))) { + dt <- tryCatch( + suppressWarnings(lubridate::parse_date_time(paste(temp$date, temp$time), quiet = TRUE, dt_formats)), + error = function(e) NA ) - ) + found_format <- get_dt_format(dt_formats) + # Report if the detected format differs from the configured PMoptions format + if (!all(is.na(dt)) && length(found_format) > 0) { + found_date_orders <- unique( + tolower(gsub("Y", "y", gsub("[^a-zA-Z]", "", sub(" .*", "", found_format)))) + ) + if (!any(grepl(opt_date_order, found_date_orders, fixed = TRUE))) { + cli::cli_warn(c( + "!" = "Date format in data does not match the configured Pmetrics date format.", + "i" = "Configured: {.val {opt_date_fmt}}", + "i" = "Detected: {.val {paste(found_format, collapse = ', ')}}", + "i" = "Update your preference with {.fn setPMoptions}." + )) + } + } + } + + if (all(is.na(dt))) { + cli::cli_abort(c("x" = "All dates/times failed to parse. Please specify correct format. ")) + } + + + temp$dt <- dt # didn't have to stop, so at least some parsed + + if (split) { + # calculate PK event numbers for each patient + for (i in unique(temp$id)) { + pk.no <- 1 + temp2 <- subset(temp, temp$id == i) + for (j in 1:nrow(temp2)) { + if (temp2$evid[j] == 4) { + pk.no <- pk.no + 1 + } + temp2$pk.no[j] <- pk.no + } + temp$pk.no[temp$id == i] <- temp2$pk.no + } + # make new ID of form xxxxx.x for each PK event per patient + temp$id <- temp$id + temp$pk.no / 10 + temp$evid[temp$evid == 4] <- 1 + } + + # calculate relative times + temp <- makePMmatrixBlock(temp) %>% + dplyr::group_by(id, block) %>% + dplyr::mutate(relTime = (dt - dt[1]) / lubridate::dhours(1)) + + temp$relTime <- round(temp$relTime, 2) + temp <- temp[, c("id", "evid", "relTime")] + attr(temp, "dt_format") <- found_format + + return(temp) } + #' @title Check Pmetrics Inputs for Errors + #' @description + #' `r lifecycle::badge("superseded")` + #' + #' This function is largely superseded as it is called automatically when + #' data are initialized as a [PM_data] object. It can still be called + #' independently of this route and will check for data errors. + #' @details + #' It will check the data for errors + #' which would cause the analysis to fail. Note that as of + #' Pmetrics Version 2, this function is called automatically when a new [PM_data] + #' object is created, and users generally no longer need to call the function directly. + #' In `PM_data$new()`, the data object is first standardized to contain all required columns, + #' since only "ID", "TIME", "DOSE" and "OUT" are required at minimum, and then checked with PMcheck. + #' + #' If calling PMcheck directly, either a filename or a Pmetrics data object in memory are accepted as `data`. + #' Because there is no standardization with direct calls, in this case the format of the .csv matrix file is fairly rigid. + #' It must have the following features. Text is case-sensitive. + #' * A header in row 1 with the appropriate version, currently "POPDATA DEC_11" + #' * Column headers in row 2. These headers are: #ID, EVID, TIME, DUR, DOSE, ADDL, II, INPUT, OUT, CENS, OUTEQ, + #' C0, C1, C2, C3. + #' * No cell should be empty. It should either contain a value or "." as a placeholder. + #' * Columns after C3 are interpreted as covariates. + #' * All subject records must begin with TIME=0. + #' * All dose events (EVID=1) must have entries in ID, EVID, TIME, DUR, DOSE and INPUT. ADDL and II are optional, but if ADDL is not 0 or + #' missing, then II is mandatory. + #' * All observation events (EVID=0) must have entries in ID, EVID, TIME, OUT, OUTEQ. + #' If an observation is missing, use -99; otherwise use a "." as a placeholder + #' in cells that are not required (e.g. INPUT for an observation event). + #' * If covariates are present in the data, there must be an entry for every covariate at time 0 for each subject. + #' * All covariates must be numeric. + #' * All times within a subject ID must be monotonically increasing. + #' * All subject IDs must be contiguous. + #' * All rows must have EVID and TIME values. + #' * All columns must be numeric except ID which may be alpha-numeric. + #' * All subjects must have at least one observation, which could be missing, i.e. -99. + #' * Cells which are not needed (e.g. dose on an observation event, EVID=0), should contain ".". + #' + #' To use this function, see the example below. + #' + #' After running PMcheck and looking at the errors in the *errors.xlsx* file, you can fix the + #' errors manually directly in the *errors.xlsx* file and resave it as a .csv file. + #' Alternatively, you could then try to fix the problem(s) with `mdata2 <- PMcheck(mdata,fix=T)`. Note that we are now returning + #' a PMmatrix data object called mdata2 (hopefully cleaned of errors) rather than the PMerr object returned when `fix=FALSE`. + #' Pmetrics handles each of the errors in the following ways. + #' * If the columns are simply out of order, they will be reordered. If some are missing, the fix must + #' be done by the user, i.e. manually. + #' * All id and covariate values are truncated to 11 characters. + #' * Missing observations are set to -99 (not "."). + #' * Incomplete dose records are flagged for the user to fix manually. + #' * Incomplete observation records are flagged for the user to fix manually. + #' * Subjects without an EVID=1 as first event are flagged for the user to fix manually. + #' * Subjects with TIME != 0 as first event have dummy dose=0 events inserted at time 0. + #' * Subjects with a missing covariate at time 0 are flagged for the user to fix manually. + #' * Non-numeric covariates are converted to numeric (via [factor()]). + #' * Non-ordered times are sorted within a subject if there are no EVID=4 events; otherwise the + #' user must fix manually. + #' * Non-contiguous subject ID rows are combined and sorted if there are no EVID=4 events; otherwise the + #' user must fix manually. + #' * Rows missing an EVID are assigned a value of 0 if DOSE is missing, 1 otherwise. + #' * Rows missing a TIME value are flagged for the user to fix manually. + #' * Cells with malformed NA values are attempted to be fixed. + #' * Columns that are non-numeric which must be numeric are flagged for the user to fix manually. + #' These are all columns except ID. + #' Covariate columns are fixed separately (see above). + #' * Dose events with censoring will be set to uncensored, with a warning to the user. + #' + #' @param data The name of a Pmetrics .csv matrix file in the current working directory, + #' the full path to one not in the current working directory, or a data.frame containing + #' the output of a previous [PMreadMatrix] command. + #' @param path The path of the data if originally a file + #' @param fix Boolean operator; if `TRUE`, Pmetrics will attempt to fix errors in the data file. + #' Default is `FALSE`. + #' @param quiet Boolean operator to suppress printed output. Default is false. + #' @return If `fix=TRUE`, then [PMcheck] returns + #' * The original data if no errors are found, or + #' * A PMmatrix data object which has been + #' cleaned of errors as much as possible, displaying a report on the console. + #' + #' If `fix=FALSE`, then [PMcheck] creates a file in the working directory called "errors.xlsx". + #' This file can be opened by Microsoft Excel or any other program that is capable of reading .xlsx files. This file + #' contains highlighted areas that are erroneous, with clarifying comments. You can correct the errors in the file + #' and then re-save as a .csv file. + #' + #' When `fix=FALSE`, the function also returns a list of objects of class *PMerr*. Each object is itself a list whose + #' first object (`$msg`) is a character vector with "OK" plus a brief description if there is no error, or the error. + #' The second object (`$results`) is a vector of the row numbers that contain that error. + #' * colorder The first 14 columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, c0, c1, c2, and c3 in that order. + #' * maxcharCol All column names should be less than or equal to 11 characters. + #' * maxcharID All id values should be less than or equal to 11 characters. + #' * missEVID Ensure that all rows have an EVID value. + #' * missTIME Ensure that all rows have a TIME value. + #' * doseDur Make sure all dose records are complete, i.e. contain a duration. + #' * doseDose Make sure all dose records are complete, i.e. contain a dose. + #' * doseInput Make sure all dose records are complete, i.e. contain an input number. + #' * obsOut Make sure all observation records are complete, i.e. contain an output. + #' * obsOuteq Make sure all observation records are complete, i.e. contain and outeq number. + #' * T0 Make sure each subject's first time=0. + #' * covT0 Make sure that there is an non-missing entry for each covariate at time=0 for each subject. + #' * timeOrder Ensure that all times within a subject ID are monotonically increasing. + #' * contigID Ensure that all subject IDs are contiguous. + #' * nonNum Ensure that all columns except ID are numeric. + #' * noObs Ensure that all subjects have at least one observation, which could be missing, i.e. -99. + #' * mal_NA Ensure that all NA values are ".", not ". ", " .", "..", or other malformations. + #' + #' @author Michael Neely and Patrick Nolain + #' @seealso [PMwriteMatrix], [PMreadMatrix] + #' @examples + #' \dontrun{ + #' err <- PMcheck(badData) + #' # look at the errors.xlsx file in the working directory + #' # try to automatically fix what can be fixed + #' goodData <- PMcheck(badCSV, fix = T) + #' PMcheck(goodData) + #' # you have to fix manually problems which require data entry + #' } + #' @export - - # try to fix errors if asked - if (fix) { - if (attr(err, "error") == 0) { - # if (!quiet) { - # cli::cli_inform(c( - # "i" = "FIX DATA REPORT:", - # " " = "There were no errors to fix in your data file.")) - # } - return(invisible(data2)) - } else { - newdata <- errfix(data2 = data2, err = err, quiet = quiet) - err2 <- errcheck(newdata, quiet = TRUE) - # Add a Worksheet if any errors remain - if (attr(err2, "error") != 0) { - sheet <- openxlsx::addWorksheet(wb, sheetName = "After_Fix") - wb <- writeErrorFile(newdata, err2, legacy = legacy, wb, sheet) - # Save the workbook ... + PMcheck <- function(data, path = ".", fix = FALSE, quiet = FALSE) { + # get the data + if (is.character(data)) { # data is a filename + data2 <- tryCatch(PMreadMatrix(data, quiet = TRUE), error = function(e) { + # return(invisible(e)) + cli::cli_abort(c("x" = "Unable to find {data} in current working directory, {getwd()}.")) + }) + data_orig <- NULL + legacy <- attr(data2, "legacy") + source <- "file" + } else if (inherits(data, "PM_data")) { + cat("Running PMcheck on PM_data object, so using $standard_data.\n") + data2 <- data$standard_data + data_orig <- data$data + legacy <- FALSE + source <- "PM_data" + } else if (is.list(data) & !is.data.frame(data)) { # data is a list coming from PM_data$private$validate + data2 <- data$standard + data_orig <- data$original + legacy <- FALSE + source <- "list" + } else { # data is a PMmatrix object + data2 <- data + data_orig <- NULL + legacy <- attr(data2, "legacy") + source <- "PMmatrix" + } + if (is.null(legacy)) { + legacy <- F + } + + + # check for errors + err <- errcheck(data2, quiet = quiet, source = source) + if (length(err) == 1) { + cli::cli_abort(c("x" = "You must at least have id, evid, and time columns to proceed with the check.")) + } + + # report errors in errors.xlsx + if (attr(err, "error") != 0) { + # Initialize an Excel Workbook + wb <- openxlsx::createWorkbook() + # Add a Worksheet + sheet <- openxlsx::addWorksheet(wb, sheetName = "Errors") + wb <- writeErrorFile(data2, err, legacy = legacy, wb, sheet) + if (!fix) { + # Save the workbook if not going to fix wb <- createInstructions(wb) openxlsx::saveWorkbook(wb, file = file.path(path, "errors.xlsx"), overwrite = TRUE) } - - return(invisible(newdata)) } - } else { - # didn't ask to fix errors so return error object - return(invisible(err)) - } -} - - - -########### ERROR CHECKING, REPORTING AND FIXING FUNCTIONS - -# errcheck ---------------------------------------------------------------- - -# Check for errors -errcheck <- function(data2, quiet, source) { - # each list element has msg when OK, results for rows with errors, column, code for excel - err <- list( - colorder = list(msg = "OK - The first 14 columns are appropriately named and ordered.", results = NA, col = NA, code = NA), - # maxCharCol = list(msg = "OK - All columns contain entries of 11 or fewer characters.", results = NA, col = NA, code = NA), - # maxCharID = list(msg = "OK - All subject IDs are 11 or fewer characters.", results = NA, col = 1, code = 1), - missEVID = list(msg = "OK - All rows have an EVID value.", results = NA, col = 2, code = 2), - missTIME = list(msg = "OK - All rows have a TIME value.", results = NA, col = 3, code = 3), - doseDur = list(msg = "OK - All dose records have a duration.", results = NA, col = 4, code = 4), - doseDose = list(msg = "OK - All dose records have a dose.", results = NA, col = 5, code = 5), - doseInput = list(msg = "OK - All dose records have an input.", results = NA, col = 8, code = 6), - obsOut = list(msg = "OK - All observation records have an output.", results = NA, col = 9, code = 7), - obsOuteq = list(msg = "OK - All observation records have an output equation.", results = NA, col = 10, code = 8), - T0 = list(msg = "OK - All subjects have time=0 as first record.", results = NA, col = 3, code = 9), - covT0 = list(msg = "OK - There are no covariates in the dataset.", results = NA, col = getFixedColNum() + 1, code = 10), - timeOrder = list(msg = "OK - All times are increasing within a subject, given any EVID=4.", results = NA, col = 3, code = 11), - contigID = list(msg = "OK - All subject IDs are contiguous.", results = NA, col = 1, code = 12), - nonNum = list(msg = "OK - All columns that must be numeric are numeric.", results = NA, col = NA, code = 13), - noObs = list(msg = "OK - All subjects have at least one observation.", results = NA, col = 1, code = 14), - mal_NA = list(msg = "OK - all unrequired cells have proper NA values.", results = NA, col = NA, code = 15), - doseOut = list(msg = "OK - All doses and observations separated.", results = NA, col = 5, code = 16) - ) - # set initial attribute to 0 for no error - attr(err, "error") <- 0 - - # define fixed column names - fixedColNames <- getFixedColNames() - - # define number of columns and number of covariates - numcol <- ncol(data2) - numfix <- getFixedColNum() - numcov <- getCov(data2)$ncov - - # ensure lowercase - t <- tolower(names(data2)) - - # check to make sure first 14 columns are correct - if (any(!c("id", "time", "evid") %in% t)) { - # must at least have id, evid, and time columns to proceed with the check - return(-1) - } - if (length(t) < numfix | any(!fixedColNames %in% t)) { - err$colorder$msg <- paste("FAIL - The first ", numfix, " columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, cens, c0, c1, c2, and c3 in that order", sep = "") - attr(err, "error") <- -1 - } else { - if (!identical(t[1:numfix], fixedColNames)) { - err$colorder$msg <- paste("FAIL - The first ", numfix, " columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, cens, c0, c1, c2, and c3 in that order.", sep = "") - attr(err, "error") <- -1 + + # Provide warning on console about maximum time + maxTime <- tryCatch(max(data2$time, na.rm = T), error = function(e) NA) + if (!is.na(maxTime) && !is.character(maxTime) && maxTime > 24 * 48 & !quiet) { + cli::cli_warn( + c( + "!" = "Your longest event horizon is {maxTime} hours.", + " " = "When fitting to a model, consider fewer predictions by making `idelta` longer than the default of 0.1 hours.", + " " = "See {.help PM_model} for details." + ) + ) } - } - - - # check that all records have an EVID value - t <- which(is.na(data2$evid)) - if (length(t) > 0) { - err$missEVID$msg <- "FAIL - The following row numbers have missing EVID values:" - err$missEVID$results <- t - attr(err, "error") <- -1 - } - - # check that all records have a TIME value - t <- which(is.na(data2$time)) - if (length(t) > 0) { - err$missTIME$msg <- "FAIL - The following row numbers have missing TIME values. Check date/time entries." - err$missTIME$results <- t - attr(err, "error") <- -1 - } - - # check for dur on dose records - t <- which(data2$evid != 0 & is.na(data2$dur)) - if (length(t) > 0) { - err$doseDur$msg <- "FAIL - The following row numbers are dose events without DUR (unused addl or ii should have '.' placeholders):" - err$doseDur$results <- t - attr(err, "error") <- -1 - } - - # check for dose on dose records - t <- which(data2$evid != 0 & is.na(data2$dose)) - if (length(t) > 0) { - err$doseDose$msg <- "FAIL - The following row numbers are dose events without DOSE (unused addl or ii should have '.' placeholders):" - err$doseDose$results <- t - attr(err, "error") <- -1 - } - - # check for input on dose records - t <- which(data2$evid != 0 & is.na(data2$input)) - if (length(t) > 0) { - err$doseInput$msg <- "FAIL - The following row numbers are dose events without INPUT (unused addl or ii should have '.' placeholders):" - err$doseInput$results <- t - attr(err, "error") <- -1 - } - - # check for out on observation records - t <- which(data2$evid == 0 & is.na(data2$out)) - if (length(t) > 0) { - err$obsOut$msg <- "FAIL - The following row numbers are observation events without OUT:" - err$obsOut$results <- t - attr(err, "error") <- -1 - } - - # check for outeq on observation records - t <- which(data2$evid == 0 & is.na(data2$outeq)) - if (length(t) > 0) { - err$obsOuteq$msg <- "FAIL - The following row numbers are observation events without OUTEQ:" - err$obsOuteq$results <- t - attr(err, "error") <- -1 - } - - # check for time=0 for each subject as first record - t <- which(tapply(data2$time, data2$id, function(x) x[1]) != 0) - t2 <- match(names(t), data2$id) - if (length(t) > 0) { - err$T0$msg <- "FAIL - The following row numbers do not have time=0 as first record:" - err$T0$results <- t2 - attr(err, "error") <- -1 - } - - # covariate checks - if (numcov > 0) { - covinfo <- getCov(data2) - # check for missing covariates at time 0 - time0 <- which(data2$time == 0 & data2$evid == 1) - if (length(time0) > 1) { - t <- apply(as.matrix(data2[time0, covinfo$covstart:covinfo$covend], ncol = numcov), 1, function(x) any(is.na(x))) + + + # try to fix errors if asked + if (fix) { + if (attr(err, "error") == 0) { + # if (!quiet) { + # cli::cli_inform(c( + # "i" = "FIX DATA REPORT:", + # " " = "There were no errors to fix in your data file.")) + # } + return(invisible(data2)) + } else { + newdata <- errfix(data2 = data2, err = err, quiet = quiet) + err2 <- errcheck(newdata, quiet = TRUE) + # Add a Worksheet if any errors remain + if (attr(err2, "error") != 0) { + sheet <- openxlsx::addWorksheet(wb, sheetName = "After_Fix") + wb <- writeErrorFile(newdata, err2, legacy = legacy, wb, sheet) + # Save the workbook ... + wb <- createInstructions(wb) + openxlsx::saveWorkbook(wb, file = file.path(path, "errors.xlsx"), overwrite = TRUE) + } + + return(invisible(newdata)) + } } else { - t <- is.na(time0) + # didn't ask to fix errors so return error object + return(invisible(err)) + } + } + + + + ########### ERROR CHECKING, REPORTING AND FIXING FUNCTIONS + + # errcheck ---------------------------------------------------------------- + + # Check for errors + errcheck <- function(data2, quiet, source) { + # each list element has msg when OK, results for rows with errors, column, code for excel + err <- list( + colorder = list(msg = "OK - The first 14 columns are appropriately named and ordered.", results = NA, col = NA, code = NA), + # maxCharCol = list(msg = "OK - All columns contain entries of 11 or fewer characters.", results = NA, col = NA, code = NA), + # maxCharID = list(msg = "OK - All subject IDs are 11 or fewer characters.", results = NA, col = 1, code = 1), + missEVID = list(msg = "OK - All rows have an EVID value.", results = NA, col = 2, code = 2), + missTIME = list(msg = "OK - All rows have a TIME value.", results = NA, col = 3, code = 3), + doseDur = list(msg = "OK - All dose records have a duration.", results = NA, col = 4, code = 4), + doseDose = list(msg = "OK - All dose records have a dose.", results = NA, col = 5, code = 5), + doseInput = list(msg = "OK - All dose records have an input.", results = NA, col = 8, code = 6), + obsOut = list(msg = "OK - All observation records have an output.", results = NA, col = 9, code = 7), + obsOuteq = list(msg = "OK - All observation records have an output equation.", results = NA, col = 10, code = 8), + T0 = list(msg = "OK - All subjects have time=0 as first record.", results = NA, col = 3, code = 9), + covT0 = list(msg = "OK - There are no covariates in the dataset.", results = NA, col = getFixedColNum() + 1, code = 10), + timeOrder = list(msg = "OK - All times are increasing within a subject, given any EVID=4.", results = NA, col = 3, code = 11), + contigID = list(msg = "OK - All subject IDs are contiguous.", results = NA, col = 1, code = 12), + nonNum = list(msg = "OK - All columns that must be numeric are numeric.", results = NA, col = NA, code = 13), + noObs = list(msg = "OK - All subjects have at least one observation.", results = NA, col = 1, code = 14), + mal_NA = list(msg = "OK - all unrequired cells have proper NA values.", results = NA, col = NA, code = 15), + doseOut = list(msg = "OK - All doses and observations separated.", results = NA, col = 5, code = 16) + ) + # set initial attribute to 0 for no error + attr(err, "error") <- 0 + + # define fixed column names + fixedColNames <- getFixedColNames() + + # define number of columns and number of covariates + numcol <- ncol(data2) + numfix <- getFixedColNum() + numcov <- getCov(data2)$ncov + + # ensure lowercase + t <- tolower(names(data2)) + + # check to make sure first 14 columns are correct + if (any(!c("id", "time", "evid") %in% t)) { + # must at least have id, evid, and time columns to proceed with the check + return(-1) } - if (length(time0[t]) > 0) { - err$covT0$msg <- "FAIL - The following row numbers are subjects with missing covariate data at time 0." - err$covT0$results <- time0[t] + if (length(t) < numfix | any(!fixedColNames %in% t)) { + err$colorder$msg <- paste("FAIL - The first ", numfix, " columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, cens, c0, c1, c2, and c3 in that order", sep = "") attr(err, "error") <- -1 } else { - err$covT0$msg <- "OK - All subjects have covariate data at time 0." + if (!identical(t[1:numfix], fixedColNames)) { + err$colorder$msg <- paste("FAIL - The first ", numfix, " columns must be named id, evid, time, dur, dose, addl, ii, input, out, outeq, cens, c0, c1, c2, and c3 in that order.", sep = "") + attr(err, "error") <- -1 + } } - } - - # check that all times within a given ID block 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)) - # if not missing (reported elsewhere) and diff<0 in same ID and not evid=4, misordered - if (!is.na(time_diff) && (time_diff < 0 & data2$id[i] == data2$id[i - 1] & data2$evid[i] != 4)) misorder <- c(misorder, i) - } - if (length(misorder) > 1) { - err$timeOrder$msg <- "FAIL - The following rows are from subject IDs with unsorted times. Check date/time entries." - err$timeOrder$results <- misorder[-1] - attr(err, "error") <- -1 - } - - # check that all records for a given subject ID are grouped - temp <- data.frame(row = 1:nrow(data2), id = data2$id) - t <- tapply(temp$row, temp$id, function(x) any(diff(x) > 1)) - if (any(t)) { - t2 <- which(data2$id %in% sort(unique(data2$id))[t]) - } else { - t2 <- NULL - } - if (length(t2) > 0) { - err$contigID$msg <- "FAIL - The following rows are from subject IDs that are not contiguous." - err$contigID$results <- t2 - attr(err, "error") <- -1 - } - - # check that all non-missing columns other than ID and cens are numeric - - allMiss <- names(data2)[which(apply(data2, 2, function(x) all(is.na(x))))] - nonNumeric <- names(data2)[which(sapply(data2, function(x) !is.numeric(x)))] - if (length(nonNumeric) > 0) { - nonNumeric <- nonNumeric[!nonNumeric %in% allMiss] %>% purrr::discard(~.x %in% (c("id", "cens"))) - } - if (length(nonNumeric) > 0 ) { # exclude id, cens columns - err$nonNum$msg <- "FAIL - The following columns must be all numeric." - err$nonNum$results <- nonNumeric - attr(err, "error") <- -1 - } - - # check that all subjects have at least one observation - subjObs <- tapply(data2$evid, data2$id, function(x) sum(x == 0, na.rm = T)) - if (any(subjObs == 0)) { - subjMissObs <- unique(data2$id)[which(subjObs == 0)] - err$noObs$msg <- "FAIL - The following rows are subjects with no observations." - err$noObs$results <- which(data2$id %in% subjMissObs) - attr(err, "error") <- -1 - } - - # check for columns with malformed NA values - mal_NA <- purrr::map(as.list(data2), ~ stringr::str_count(.x, "(?% - map(~ which(.x == 1)) %>% - purrr::map_vec(~ length(.x) > 0) %>% - which() - if (length(mal_NA) > 0) { - err$mal_NA$msg <- "FAIL - The following columns contain malformed NA values." - err$mal_NA$results <- mal_NA - attr(err, "error") <- -1 - } - - # check that doses and observations are separated - doseOut <- which(!is.na(data2$dose) & !is.na(data2$out)) - if (length(doseOut) > 0) { - err$doseOut$msg <- "FAIL - The following rows have both dose and observation values." - err$doseOut$results <- doseOut - attr(err, "error") <- -1 - } - - - - class(err) <- c("PMerr", "list") - if (!quiet) { - cli::cli_h1("DATA VALIDATION") - print(err) - flush.console() - } - - - if (!quiet) flush.console() - return(err) -} - - -# errfix ------------------------------------------------------------------ - - -# try and fix errors in the data file -errfix <- function(data2, err, quiet) { - report <- NA - numcol <- ncol(data2) - # Fix first fixed columns - if (length(grep("FAIL", err$colorder$msg)) > 0) { - fixedColNames <- getFixedColNames() - t <- tolower(names(data2)) - PMcols <- match(fixedColNames, t) - if (any(is.na(PMcols))) { - misscols <- fixedColNames[is.na(PMcols)] - report <- c(report, paste("Cannot fix columns; the following are missing: ", paste(misscols, collapse = "'', '"), ".", sep = "")) - } else { - covcols <- (1:numcol)[!(1:numcol) %in% PMcols] - data2 <- data2[, c(PMcols, covcols)] - report <- c(report, paste("Columns are now ordered appropriately.")) + + + # check that all records have an EVID value + t <- which(is.na(data2$evid)) + if (length(t) > 0) { + err$missEVID$msg <- "FAIL - The following row numbers have missing EVID values:" + err$missEVID$results <- t + attr(err, "error") <- -1 } - } - - # Check for NA observations (should be -99) - if (length(grep("FAIL", err$obsMiss$msg)) > 0) { - data2 <- data2[err$obsMiss$results, "out"] < -99 - report <- c(report, paste("Missing observations for evid=0 have been replaced with -99.")) - err <- errcheck(data2 = data2, quiet = T) - } - # Check for DUR dose records - if (length(grep("FAIL", err$doseDur$msg)) > 0) { - report <- c(report, paste("Dose records (evid=1 or evid=4) must have DUR. See errors.xlsx and fix manually.")) - } - # Check for DOSE dose records - if (length(grep("FAIL", err$doseDose$msg)) > 0) { - report <- c(report, paste("Dose records (evid=1 or evid=4) must have DOSE. See errors.xlsx and fix manually.")) - } - # Check for INPUT dose records - if (length(grep("FAIL", err$doseInput$msg)) > 0) { - report <- c(report, paste("Dose records (evid=1 or evid=4) must have INPUT. See errors.xlsx and fix manually.")) - } - # Check for OUT observation records - if (length(grep("FAIL", err$obsOut$msg)) > 0) { - report <- c(report, paste("Observation records (evid=0) must have OUT. See errors.xlsx and fix manually.")) - } - # Check for OUTEQ observation records - if (length(grep("FAIL", err$obsOuteq$msg)) > 0) { - report <- c(report, paste("Observation records (evid=0) must have OUTEQ. See errors.xlsx and fix manually.")) - } - - # Insert dummy doses of 0 for those missing time=0 first events - if (length(grep("FAIL", err$T0$msg)) > 0) { - T0 <- data2[err$T0$results, ] - T0$time <- 0 - T0$evid <- 1 - T0$dose <- 0 - T0$dur <- 0 - T0$input <- 1 - T0$addl <- NA - T0$ii <- NA - data2 <- rbind(data2, T0) - data2 <- data2[order(data2$id, data2$time), ] - report <- c(report, paste("Subjects with first time > 0 have had a dummy dose of 0 inserted at time 0.")) - err <- errcheck(data2 = data2, quiet = T) - } - - # Alert for missing covariate data - if (length(grep("FAIL", err$covT0$msg)) > 0) { - 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 - if (length(grep("FAIL", err$timeOrder$msg)) > 0) { - data2 <- makePMmatrixBlock(data2) %>% - dplyr::group_by(id, block) %>% - dplyr::arrange(time, .by_group = T) %>% - ungroup() %>% - select(-block) - if (any(data2$evid == 4)) { - report <- c(report, paste("Your dataset has EVID=4 events. Times ordered within each event block.")) - } else { - report <- c(report, paste("Times for each subject have been ordered.")) + # check that all records have a TIME value + t <- which(is.na(data2$time)) + if (length(t) > 0) { + err$missTIME$msg <- "FAIL - The following row numbers have missing TIME values. Check date/time entries." + err$missTIME$results <- t + attr(err, "error") <- -1 } - } - # Reorder IDs - if (length(grep("FAIL", err$contigID$msg)) > 0) { - if (any(data2$evid == 4)) { - report <- c(report, paste("Your dataset has EVID=4 events. Unable to sort subjects and times automatically.")) - } else { - data2 <- data2[order(data2$id, data2$time), ] - report <- c(report, paste("Subjects have been grouped and ordered.")) + + # check for dur on dose records + t <- which(data2$evid != 0 & is.na(data2$dur)) + if (length(t) > 0) { + err$doseDur$msg <- "FAIL - The following row numbers are dose events without DUR (unused addl or ii should have '.' placeholders):" + err$doseDur$results <- t + attr(err, "error") <- -1 } - } - # Fix missing EVID - if (length(grep("FAIL", err$missEVID$msg)) > 0) { - data2$evid[err$missEVID$results] <- ifelse(is.na(data2$dose[err$missEVID$results]), 0, 1) - report <- c(report, paste("EVID for events with doses changed to 1, otherwise 0.")) - } - - # Fix doses and observations separated - if (length(grep("FAIL", err$doseOut$msg)) > 0) { - report <- c(report, paste("Rows with both dose and observation values must be fixed manually. See errors.xlsx.")) - } - - # Fix malformed NA - if (length(grep("FAIL", err$mal_NA$msg)) > 0) { - # convert to "." then NA - data2 <- data2 %>% - mutate(across(everything(), ~ str_replace_all(.x, "(?% - mutate(across(everything(), ~ dplyr::na_if(.x, "."))) - report <- c(report, paste("Malformed NAs corrected.")) - } - - - # Report missing TIME - if (length(grep("FAIL", err$missTIME$msg)) > 0) { - report <- c(report, paste("Your dataset has missing times. See errors.xlsx and fix manually.")) - } - - # Report non-numeric columns - if (length(grep("FAIL", err$nonNum$msg)) > 0) { - report <- c(report, paste("Your dataset has non-numeric columns. See errors.xlsx and fix manually.")) - } - - # Report subjects with no observations - if (length(grep("FAIL", err$noObs$msg)) > 0) { - report <- c(report, paste("Your dataset has subjects with no observations. See errors.xlsx and fix manually.")) - } - - if (!quiet) { - cli::cli_h1("FIX DATA REPORT:") - report <- report[-1] - cat(paste0("(", 1:length(report), ") ", report, collapse = "\n")) - flush.console() - } - return(data2) -} - - -# writeErrorFile ---------------------------------------------------------- - -writeErrorFile <- function(dat, err, legacy, wb, sheet) { - # Definition of a table of n types of errors, each one with 'code' and 'color' properties - errorsTable <- data.frame( - comment = c( - "", # old error now not used - "Missing EVID", - "Missing TIME", - "Missing DUR for dose event", - "Missing DOSE for dose event", - "Missing INPUT for dose event", - "Missing OUT for output (use -99)", - "Missing OUTEQ for observation", - "TIME not 0 at first event for subject", - "Missing one or more covariate values at TIME=0", - "TIME entry out of order", - "Non-contiguous subject ID", - "Non-numeric entry", - "Subject with no observations", - "Malformed NA value", - "Rows with both dose and observation values"), - stringsAsFactors = F - ) - numError <- nrow(errorsTable) - errorsTable$code <- 1:numError - - # assign errors with row, column, and code - errList <- lapply(err[3:length(err)], function(x) (lapply(x$results, function(y) c(y, x$col, x$code)))) - errDF <- data.frame(t(data.frame(errList))) - row.names(errDF) <- 1:nrow(errDF) - names(errDF) <- c("row", "column", "code") - errors <- errDF[!is.na(errDF$row), ] - formattedCols <- names(dat) - - if (legacy) { - pmVersion <- "POPDATA DEC_11" - formattedCols <- toupper(formattedCols) - formattedCols[1] <- "#ID" - legacy_offset <- 1 - } else { - legacy_offset <- 0 + + # check for dose on dose records + t <- which(data2$evid != 0 & is.na(data2$dose)) + if (length(t) > 0) { + err$doseDose$msg <- "FAIL - The following row numbers are dose events without DOSE (unused addl or ii should have '.' placeholders):" + err$doseDose$results <- t + attr(err, "error") <- -1 } - # set colors for errors - errColor <- "#FFFF00" # yellow, column specific - errColor2 <- "#00FF00" # green, across columns - errColor3 <- "#00AAFF" # blue, NA - errColor4 <- "#FFAA00" # orange, summary + # check for input on dose records + t <- which(data2$evid != 0 & is.na(data2$input)) + if (length(t) > 0) { + err$doseInput$msg <- "FAIL - The following row numbers are dose events without INPUT (unused addl or ii should have '.' placeholders):" + err$doseInput$results <- t + attr(err, "error") <- -1 + } - # create styles for error formatting - errStyle1 <- openxlsx::createStyle(fgFill = errColor) - errStyle2 <- openxlsx::createStyle(fgFill = errColor2) - errStyle3 <- openxlsx::createStyle(fgFill = errColor3) - errStyle4 <- openxlsx::createStyle(fgFill = errColor4) + # check for out on observation records + t <- which(data2$evid == 0 & is.na(data2$out)) + if (length(t) > 0) { + err$obsOut$msg <- "FAIL - The following row numbers are observation events without OUT:" + err$obsOut$results <- t + attr(err, "error") <- -1 + } + # check for outeq on observation records + t <- which(data2$evid == 0 & is.na(data2$outeq)) + if (length(t) > 0) { + err$obsOuteq$msg <- "FAIL - The following row numbers are observation events without OUTEQ:" + err$obsOuteq$results <- t + attr(err, "error") <- -1 + } - # function to detect things that can't be coerced to numbers - is.char.num <- function(x) { - if (!is.na(x) && suppressWarnings(is.na(as.numeric(x)))) { - return(T) - } else { - return(F) - } + # check for time=0 for each subject as first record + t <- which(tapply(data2$time, data2$id, function(x) x[1]) != 0) + t2 <- match(names(t), data2$id) + if (length(t) > 0) { + err$T0$msg <- "FAIL - The following row numbers do not have time=0 as first record:" + err$T0$results <- t2 + attr(err, "error") <- -1 } - # make second table to summarize errors - error_summary <- errors %>% filter(!code %in% c(10, 13, 15)) # we will add these back - - # Highlight the cells with errors - for (i in 1:nrow(errors)) { - thisErr <- errors[i, ] - colIndex <- thisErr$column - rowIndex <- thisErr$row - # special highlighting - overwrite some values - if (thisErr$code == 10) { - # if covariate error - covData <- getCov(dat) - colIndex <- covData$covstart + - which(is.na(dat[rowIndex, covData$covstart:covData$covend])) - 1 - rowIndex <- rowIndex + 1 + legacy_offset - error_summary <- dplyr::bind_rows( - error_summary, - data.frame( - row = rep(rowIndex, length(colIndex)), - column = colIndex, - code = 10 - ) - ) - openxlsx::addStyle(wb, sheet, errStyle2, rows = rowIndex, cols = colIndex) - purrr::walk2(colIndex, rowIndex, ~ openxlsx::removeComment(wb, sheet, col = .x, row = .y)) # Excel throws a fit if two comments written - purrr::walk2(colIndex, rowIndex, ~ openxlsx::writeComment(wb, sheet, - col = .x, row = .y, - comment = openxlsx::createComment(errorsTable$comment[10], author = "Pmetrics", visible = F) - )) - } else if (thisErr$code == 12) { - # special for non-numeric columns - colIndex <- thisErr$row # because of the way the error is detected - # find the non-numeric cells in a column - rowIndex2 <- which(sapply(dplyr::pull(dat, colIndex), is.char.num)) + 1 + legacy_offset - # find the malformed NAs as a special case and remove them (separate error below) - # because openxlsx can't overwrite comments - mal_NA <- stringr::str_count(dplyr::pull(dat, colIndex), "(?% - map(~ which(.x == 1)) %>% - purrr::map_vec(~ length(.x) > 0) %>% - which() + 1 + legacy_offset - # remove any mal_NA from non-numeric - rowIndex2 <- rowIndex2[!rowIndex2 %in% mal_NA] - # highlight them if any left - if (length(rowIndex2) > 0) { - openxlsx::addStyle(wb, sheet, errStyle2, rows = rowIndex2, cols = colIndex) - purrr::walk2(colIndex, rowIndex2, ~ openxlsx::removeComment(wb, sheet, col = .x, row = .y)) # Excel throws a fit if two comments written - purrr::walk2(colIndex, rowIndex2, ~ openxlsx::writeComment(wb, sheet, - col = .x, row = .y, - comment = openxlsx::createComment(errorsTable$comment[13], author = "Pmetrics", visible = F) - )) - error_summary <- dplyr::bind_rows( - error_summary, - data.frame( - row = rowIndex2, - column = rep(colIndex, length(rowIndex2)), - code = 13 - ) - ) - } - } else if (thisErr$code == 14) { - # malformed NA - colIndex <- thisErr$row # because of the way the error is detected - rowIndex3 <- stringr::str_count(dplyr::pull(dat, colIndex), "(?% - map(~ which(.x == 1)) %>% - purrr::map_vec(~ length(.x) > 0) %>% - which() + 1 + legacy_offset - # highlight them - openxlsx::addStyle(wb, sheet, errStyle3, rows = rowIndex3, cols = colIndex) - purrr::walk2(colIndex, rowIndex3, ~ openxlsx::writeComment(wb, sheet, - col = .x, row = .y, - comment = openxlsx::createComment(errorsTable$comment[15], author = "Pmetrics", visible = F) - )) - error_summary <- dplyr::bind_rows( - error_summary, - data.frame( - row = rowIndex3, - column = rep(colIndex, length(rowIndex3)), - code = 15 - ) - ) + # covariate checks + if (numcov > 0) { + covinfo <- getCov(data2) + # check for missing covariates at time 0 + time0 <- which(data2$time == 0 & data2$evid == 1) + if (length(time0) > 1) { + t <- apply(as.matrix(data2[time0, covinfo$covstart:covinfo$covend], ncol = numcov), 1, function(x) any(is.na(x))) } else { - # add the highlighting and comments for other errors - rowIndex <- rowIndex + 1 + legacy_offset - comment <- openxlsx::createComment(errorsTable$comment[thisErr$code], author = "Pmetrics", visible = F) - openxlsx::addStyle(wb, sheet, errStyle1, rowIndex, colIndex) - openxlsx::writeComment(wb, sheet, xy = c(colIndex, rowIndex), comment = comment) + t <- is.na(time0) } - } # end errors for loop - - # Add summaries to each column with errors - sum_errors <- dplyr::as_tibble(table(error_summary$column, error_summary$code, dnn = c("column", "code"))) %>% - group_by(column) %>% - summarize(n_err = sum(n)) - - openxlsx::addStyle(wb, sheet, errStyle4, rows = 1 + legacy_offset, cols = as.numeric(sum_errors$column)) - comments <- purrr::map(1:nrow(sum_errors), ~ openxlsx::createComment(paste( - sum_errors$n_err[.x], - ifelse(sum_errors$n_err[.x] > 1, "errors", "error") - ), author = "Pmetrics", visible = F)) - purrr::walk(1:nrow(sum_errors), ~ openxlsx::writeComment(wb, sheet, col = as.numeric(sum_errors$column[.x]), row = 1 + legacy_offset, comment = comments[[.x]])) - - # Writing out the header of the Pmetrics data file : version line.... - if (legacy) { - openxlsx::writeData(wb, sheet, pmVersion, xy = c(1, 1)) - } # POPDATA... - - # ...and data frame column names - openxlsx::writeData(wb, sheet, t(formattedCols), xy = c(1, 1 + legacy_offset), colNames = F) - - # Add the data - openxlsx::writeData(wb, sheet, dat, - rowNames = F, colNames = F, xy = c(1, 2 + legacy_offset), - keepNA = T, na.string = "." - ) + if (length(time0[t]) > 0) { + err$covT0$msg <- "FAIL - The following row numbers are subjects with missing covariate data at time 0." + err$covT0$results <- time0[t] + attr(err, "error") <- -1 + } else { + err$covT0$msg <- "OK - All subjects have covariate data at time 0." + } + } - return(wb) - } - - createInstructions <- function(wb) { - # set colors for errors - errColor <- "#FFFF00" # yellow, column header - errColor2 <- "#00FF00" # green, cell - errColor3 <- "#00AAFF" # blue, NA - errColor4 <- "#FFAA00" # orange, summary - - # create styles for error formatting - errStyle1 <- openxlsx::createStyle(fgFill = errColor) - errStyle2 <- openxlsx::createStyle(fgFill = errColor2) - errStyle3 <- openxlsx::createStyle(fgFill = errColor3) - errStyle4 <- openxlsx::createStyle(fgFill = errColor4) - textStyle <- openxlsx::createStyle(fontSize = 16) - - openxlsx::addWorksheet(wb, "Instructions", tabColour = "grey80") - openxlsx::addStyle(wb, "Instructions", textStyle, rows = 1:8, cols = 1) - openxlsx::addStyle(wb, "Instructions", textStyle, rows = 10:13, cols = 2) - openxlsx::writeData(wb, "Instructions", + # check that all times within a given ID block 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)) + # if not missing (reported elsewhere) and diff<0 in same ID and not evid=4, misordered + if (!is.na(time_diff) && (time_diff < 0 & data2$id[i] == data2$id[i - 1] & data2$evid[i] != 4)) misorder <- c(misorder, i) + } + if (length(misorder) > 1) { + err$timeOrder$msg <- "FAIL - The following rows are from subject IDs with unsorted times. Check date/time entries." + err$timeOrder$results <- misorder[-1] + attr(err, "error") <- -1 + } + + # check that all records for a given subject ID are grouped + temp <- data.frame(row = 1:nrow(data2), id = data2$id) + t <- tapply(temp$row, temp$id, function(x) any(diff(x) > 1)) + if (any(t)) { + t2 <- which(data2$id %in% sort(unique(data2$id))[t]) + } else { + t2 <- NULL + } + if (length(t2) > 0) { + err$contigID$msg <- "FAIL - The following rows are from subject IDs that are not contiguous." + err$contigID$results <- t2 + attr(err, "error") <- -1 + } + + # check that all non-missing columns other than ID and cens are numeric + + allMiss <- names(data2)[which(apply(data2, 2, function(x) all(is.na(x))))] + nonNumeric <- names(data2)[which(sapply(data2, function(x) !is.numeric(x)))] + if (length(nonNumeric) > 0) { + nonNumeric <- nonNumeric[!nonNumeric %in% allMiss] %>% purrr::discard(~.x %in% (c("id", "cens"))) + } + if (length(nonNumeric) > 0 ) { # exclude id, cens columns + err$nonNum$msg <- "FAIL - The following columns must be all numeric." + err$nonNum$results <- nonNumeric + attr(err, "error") <- -1 + } + + # check that all subjects have at least one observation + subjObs <- tapply(data2$evid, data2$id, function(x) sum(x == 0, na.rm = T)) + if (any(subjObs == 0)) { + subjMissObs <- unique(data2$id)[which(subjObs == 0)] + err$noObs$msg <- "FAIL - The following rows are subjects with no observations." + err$noObs$results <- which(data2$id %in% subjMissObs) + attr(err, "error") <- -1 + } + + # check for columns with malformed NA values + mal_NA <- purrr::map(as.list(data2), ~ stringr::str_count(.x, "(?% + map(~ which(.x == 1)) %>% + purrr::map_vec(~ length(.x) > 0) %>% + which() + if (length(mal_NA) > 0) { + err$mal_NA$msg <- "FAIL - The following columns contain malformed NA values." + err$mal_NA$results <- mal_NA + attr(err, "error") <- -1 + } + + # check that doses and observations are separated + doseOut <- which(!is.na(data2$dose) & !is.na(data2$out)) + if (length(doseOut) > 0) { + err$doseOut$msg <- "FAIL - The following rows have both dose and observation values." + err$doseOut$results <- doseOut + attr(err, "error") <- -1 + } + + + + class(err) <- c("PMerr", "list") + if (!quiet) { + cli::cli_h1("DATA VALIDATION") + print(err) + flush.console() + } + + + if (!quiet) flush.console() + return(err) + } + + + # errfix ------------------------------------------------------------------ + + + # try and fix errors in the data file + errfix <- function(data2, err, quiet) { + report <- NA + numcol <- ncol(data2) + # Fix first fixed columns + if (length(grep("FAIL", err$colorder$msg)) > 0) { + fixedColNames <- getFixedColNames() + t <- tolower(names(data2)) + PMcols <- match(fixedColNames, t) + if (any(is.na(PMcols))) { + misscols <- fixedColNames[is.na(PMcols)] + report <- c(report, paste("Cannot fix columns; the following are missing: ", paste(misscols, collapse = "'', '"), ".", sep = "")) + } else { + covcols <- (1:numcol)[!(1:numcol) %in% PMcols] + data2 <- data2[, c(PMcols, covcols)] + report <- c(report, paste("Columns are now ordered appropriately.")) + } + } + + # Check for NA observations (should be -99) + if (length(grep("FAIL", err$obsMiss$msg)) > 0) { + data2 <- data2[err$obsMiss$results, "out"] < -99 + report <- c(report, paste("Missing observations for evid=0 have been replaced with -99.")) + err <- errcheck(data2 = data2, quiet = T) + } + # Check for DUR dose records + if (length(grep("FAIL", err$doseDur$msg)) > 0) { + report <- c(report, paste("Dose records (evid=1 or evid=4) must have DUR. See errors.xlsx and fix manually.")) + } + # Check for DOSE dose records + if (length(grep("FAIL", err$doseDose$msg)) > 0) { + report <- c(report, paste("Dose records (evid=1 or evid=4) must have DOSE. See errors.xlsx and fix manually.")) + } + # Check for INPUT dose records + if (length(grep("FAIL", err$doseInput$msg)) > 0) { + report <- c(report, paste("Dose records (evid=1 or evid=4) must have INPUT. See errors.xlsx and fix manually.")) + } + # Check for OUT observation records + if (length(grep("FAIL", err$obsOut$msg)) > 0) { + report <- c(report, paste("Observation records (evid=0) must have OUT. See errors.xlsx and fix manually.")) + } + # Check for OUTEQ observation records + if (length(grep("FAIL", err$obsOuteq$msg)) > 0) { + report <- c(report, paste("Observation records (evid=0) must have OUTEQ. See errors.xlsx and fix manually.")) + } + + # Insert dummy doses of 0 for those missing time=0 first events + if (length(grep("FAIL", err$T0$msg)) > 0) { + T0 <- data2[err$T0$results, ] + T0$time <- 0 + T0$evid <- 1 + T0$dose <- 0 + T0$dur <- 0 + T0$input <- 1 + T0$addl <- NA + T0$ii <- NA + data2 <- rbind(data2, T0) + data2 <- data2[order(data2$id, data2$time), ] + report <- c(report, paste("Subjects with first time > 0 have had a dummy dose of 0 inserted at time 0.")) + err <- errcheck(data2 = data2, quiet = T) + } + + # Alert for missing covariate data + if (length(grep("FAIL", err$covT0$msg)) > 0) { + 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 + if (length(grep("FAIL", err$timeOrder$msg)) > 0) { + data2 <- makePMmatrixBlock(data2) %>% + dplyr::group_by(id, block) %>% + dplyr::arrange(time, .by_group = T) %>% + ungroup() %>% + select(-block) + + if (any(data2$evid == 4)) { + report <- c(report, paste("Your dataset has EVID=4 events. Times ordered within each event block.")) + } else { + report <- c(report, paste("Times for each subject have been ordered.")) + } + } + # Reorder IDs + if (length(grep("FAIL", err$contigID$msg)) > 0) { + if (any(data2$evid == 4)) { + report <- c(report, paste("Your dataset has EVID=4 events. Unable to sort subjects and times automatically.")) + } else { + data2 <- data2[order(data2$id, data2$time), ] + report <- c(report, paste("Subjects have been grouped and ordered.")) + } + } + # Fix missing EVID + if (length(grep("FAIL", err$missEVID$msg)) > 0) { + data2$evid[err$missEVID$results] <- ifelse(is.na(data2$dose[err$missEVID$results]), 0, 1) + report <- c(report, paste("EVID for events with doses changed to 1, otherwise 0.")) + } + + # Fix doses and observations separated + if (length(grep("FAIL", err$doseOut$msg)) > 0) { + report <- c(report, paste("Rows with both dose and observation values must be fixed manually. See errors.xlsx.")) + } + + # Fix malformed NA + if (length(grep("FAIL", err$mal_NA$msg)) > 0) { + # convert to "." then NA + data2 <- data2 %>% + mutate(across(everything(), ~ str_replace_all(.x, "(?% + mutate(across(everything(), ~ dplyr::na_if(.x, "."))) + report <- c(report, paste("Malformed NAs corrected.")) + } + + + # Report missing TIME + if (length(grep("FAIL", err$missTIME$msg)) > 0) { + report <- c(report, paste("Your dataset has missing times. See errors.xlsx and fix manually.")) + } + + # Report non-numeric columns + if (length(grep("FAIL", err$nonNum$msg)) > 0) { + report <- c(report, paste("Your dataset has non-numeric columns. See errors.xlsx and fix manually.")) + } + + # Report subjects with no observations + if (length(grep("FAIL", err$noObs$msg)) > 0) { + report <- c(report, paste("Your dataset has subjects with no observations. See errors.xlsx and fix manually.")) + } + + if (!quiet) { + cli::cli_h1("FIX DATA REPORT:") + report <- report[-1] + cat(paste0("(", 1:length(report), ") ", report, collapse = "\n")) + flush.console() + } + return(data2) + } + + + # writeErrorFile ---------------------------------------------------------- + + writeErrorFile <- function(dat, err, legacy, wb, sheet) { + # Definition of a table of n types of errors, each one with 'code' and 'color' properties + errorsTable <- data.frame( + comment = c( + "", # old error now not used + "Missing EVID", + "Missing TIME", + "Missing DUR for dose event", + "Missing DOSE for dose event", + "Missing INPUT for dose event", + "Missing OUT for output (use -99)", + "Missing OUTEQ for observation", + "TIME not 0 at first event for subject", + "Missing one or more covariate values at TIME=0", + "TIME entry out of order", + "Non-contiguous subject ID", + "Non-numeric entry", + "Subject with no observations", + "Malformed NA value", + "Rows with both dose and observation values"), + stringsAsFactors = F + ) + numError <- nrow(errorsTable) + errorsTable$code <- 1:numError + + # assign errors with row, column, and code + errList <- lapply(err[3:length(err)], function(x) (lapply(x$results, function(y) c(y, x$col, x$code)))) + errDF <- data.frame(t(data.frame(errList))) + row.names(errDF) <- 1:nrow(errDF) + names(errDF) <- c("row", "column", "code") + errors <- errDF[!is.na(errDF$row), ] + formattedCols <- names(dat) + + if (legacy) { + pmVersion <- "POPDATA DEC_11" + formattedCols <- toupper(formattedCols) + formattedCols[1] <- "#ID" + legacy_offset <- 1 + } else { + legacy_offset <- 0 + } + + # set colors for errors + errColor <- "#FFFF00" # yellow, column specific + errColor2 <- "#00FF00" # green, across columns + errColor3 <- "#00AAFF" # blue, NA + errColor4 <- "#FFAA00" # orange, summary + + # create styles for error formatting + errStyle1 <- openxlsx::createStyle(fgFill = errColor) + errStyle2 <- openxlsx::createStyle(fgFill = errColor2) + errStyle3 <- openxlsx::createStyle(fgFill = errColor3) + errStyle4 <- openxlsx::createStyle(fgFill = errColor4) + + + # function to detect things that can't be coerced to numbers + is.char.num <- function(x) { + if (!is.na(x) && suppressWarnings(is.na(as.numeric(x)))) { + return(T) + } else { + return(F) + } + } + + # make second table to summarize errors + error_summary <- errors %>% filter(!code %in% c(10, 13, 15)) # we will add these back + + # Highlight the cells with errors + for (i in 1:nrow(errors)) { + thisErr <- errors[i, ] + colIndex <- thisErr$column + rowIndex <- thisErr$row + # special highlighting - overwrite some values + if (thisErr$code == 10) { + # if covariate error + covData <- getCov(dat) + colIndex <- covData$covstart + + which(is.na(dat[rowIndex, covData$covstart:covData$covend])) - 1 + rowIndex <- rowIndex + 1 + legacy_offset + error_summary <- dplyr::bind_rows( + error_summary, + data.frame( + row = rep(rowIndex, length(colIndex)), + column = colIndex, + code = 10 + ) + ) + openxlsx::addStyle(wb, sheet, errStyle2, rows = rowIndex, cols = colIndex) + purrr::walk2(colIndex, rowIndex, ~ openxlsx::removeComment(wb, sheet, col = .x, row = .y)) # Excel throws a fit if two comments written + purrr::walk2(colIndex, rowIndex, ~ openxlsx::writeComment(wb, sheet, + col = .x, row = .y, + comment = openxlsx::createComment(errorsTable$comment[10], author = "Pmetrics", visible = F) + )) + } else if (thisErr$code == 12) { + # special for non-numeric columns + colIndex <- thisErr$row # because of the way the error is detected + # find the non-numeric cells in a column + rowIndex2 <- which(sapply(dplyr::pull(dat, colIndex), is.char.num)) + 1 + legacy_offset + # find the malformed NAs as a special case and remove them (separate error below) + # because openxlsx can't overwrite comments + mal_NA <- stringr::str_count(dplyr::pull(dat, colIndex), "(?% + map(~ which(.x == 1)) %>% + purrr::map_vec(~ length(.x) > 0) %>% + which() + 1 + legacy_offset + # remove any mal_NA from non-numeric + rowIndex2 <- rowIndex2[!rowIndex2 %in% mal_NA] + # highlight them if any left + if (length(rowIndex2) > 0) { + openxlsx::addStyle(wb, sheet, errStyle2, rows = rowIndex2, cols = colIndex) + purrr::walk2(colIndex, rowIndex2, ~ openxlsx::removeComment(wb, sheet, col = .x, row = .y)) # Excel throws a fit if two comments written + purrr::walk2(colIndex, rowIndex2, ~ openxlsx::writeComment(wb, sheet, + col = .x, row = .y, + comment = openxlsx::createComment(errorsTable$comment[13], author = "Pmetrics", visible = F) + )) + error_summary <- dplyr::bind_rows( + error_summary, + data.frame( + row = rowIndex2, + column = rep(colIndex, length(rowIndex2)), + code = 13 + ) + ) + } + } else if (thisErr$code == 14) { + # malformed NA + colIndex <- thisErr$row # because of the way the error is detected + rowIndex3 <- stringr::str_count(dplyr::pull(dat, colIndex), "(?% + map(~ which(.x == 1)) %>% + purrr::map_vec(~ length(.x) > 0) %>% + which() + 1 + legacy_offset + # highlight them + openxlsx::addStyle(wb, sheet, errStyle3, rows = rowIndex3, cols = colIndex) + purrr::walk2(colIndex, rowIndex3, ~ openxlsx::writeComment(wb, sheet, + col = .x, row = .y, + comment = openxlsx::createComment(errorsTable$comment[15], author = "Pmetrics", visible = F) + )) + error_summary <- dplyr::bind_rows( + error_summary, + data.frame( + row = rowIndex3, + column = rep(colIndex, length(rowIndex3)), + code = 15 + ) + ) + } else { + # add the highlighting and comments for other errors + rowIndex <- rowIndex + 1 + legacy_offset + comment <- openxlsx::createComment(errorsTable$comment[thisErr$code], author = "Pmetrics", visible = F) + openxlsx::addStyle(wb, sheet, errStyle1, rowIndex, colIndex) + openxlsx::writeComment(wb, sheet, xy = c(colIndex, rowIndex), comment = comment) + } + } # end errors for loop + + # Add summaries to each column with errors + sum_errors <- dplyr::as_tibble(table(error_summary$column, error_summary$code, dnn = c("column", "code"))) %>% + group_by(column) %>% + summarize(n_err = sum(n)) + + openxlsx::addStyle(wb, sheet, errStyle4, rows = 1 + legacy_offset, cols = as.numeric(sum_errors$column)) + comments <- purrr::map(1:nrow(sum_errors), ~ openxlsx::createComment(paste( + sum_errors$n_err[.x], + ifelse(sum_errors$n_err[.x] > 1, "errors", "error") + ), author = "Pmetrics", visible = F)) + purrr::walk(1:nrow(sum_errors), ~ openxlsx::writeComment(wb, sheet, col = as.numeric(sum_errors$column[.x]), row = 1 + legacy_offset, comment = comments[[.x]])) + + # Writing out the header of the Pmetrics data file : version line.... + if (legacy) { + openxlsx::writeData(wb, sheet, pmVersion, xy = c(1, 1)) + } # POPDATA... + + # ...and data frame column names + openxlsx::writeData(wb, sheet, t(formattedCols), xy = c(1, 1 + legacy_offset), colNames = F) + + # Add the data + openxlsx::writeData(wb, sheet, dat, + rowNames = F, colNames = F, xy = c(1, 2 + legacy_offset), + keepNA = T, na.string = "." + ) + + return(wb) + } + + createInstructions <- function(wb) { + # set colors for errors + errColor <- "#FFFF00" # yellow, column header + errColor2 <- "#00FF00" # green, cell + errColor3 <- "#00AAFF" # blue, NA + errColor4 <- "#FFAA00" # orange, summary + + # create styles for error formatting + errStyle1 <- openxlsx::createStyle(fgFill = errColor) + errStyle2 <- openxlsx::createStyle(fgFill = errColor2) + errStyle3 <- openxlsx::createStyle(fgFill = errColor3) + errStyle4 <- openxlsx::createStyle(fgFill = errColor4) + textStyle <- openxlsx::createStyle(fontSize = 16) + + openxlsx::addWorksheet(wb, "Instructions", tabColour = "grey80") + openxlsx::addStyle(wb, "Instructions", textStyle, rows = 1:8, cols = 1) + openxlsx::addStyle(wb, "Instructions", textStyle, rows = 10:13, cols = 2) + openxlsx::writeData(wb, "Instructions", + c( + "'Errors' tab contains your data which has been standardized if read using PM_data$new().", + "Cells with errors are color coded according to table below.", + "Hover your mouse over each cell to read pop-up comment with details.", + "Comments on column headers in orange contain the total number of errors in that column.", + "If fix = TRUE, which is default for PM_data$new(), there will be an additional 'After_Fix' tab.", + "This tab contains your standardized data after Pmetrics attempted to repair your data.", + "Residual errors will be indicated as for the 'Errors' tab.", + "You can fix the remaining errors and save the 'After_Fix' tab as a new .csv data file." + ), + startCol = 1, startRow = 1 + ) + + openxlsx::addStyle(wb, "Instructions", errStyle1, rows = 10, cols = 1) + openxlsx::addStyle(wb, "Instructions", errStyle2, rows = 11, cols = 1) + openxlsx::addStyle(wb, "Instructions", errStyle3, rows = 12, cols = 1) + openxlsx::addStyle(wb, "Instructions", errStyle4, rows = 13, cols = 1) + + openxlsx::writeData(wb, "Instructions", c( - "'Errors' tab contains your data which has been standardized if read using PM_data$new().", - "Cells with errors are color coded according to table below.", - "Hover your mouse over each cell to read pop-up comment with details.", - "Comments on column headers in orange contain the total number of errors in that column.", - "If fix = TRUE, which is default for PM_data$new(), there will be an additional 'After_Fix' tab.", - "This tab contains your standardized data after Pmetrics attempted to repair your data.", - "Residual errors will be indicated as for the 'Errors' tab.", - "You can fix the remaining errors and save the 'After_Fix' tab as a new .csv data file." + "Errors specific to a particular column", + "Errors not specific to a defined column, i.e. non-numeric entries or missing covariates at time 0.", + "Malformed NA values, which should only be '.'", + "Used for column headers to report the total number of errors in that column." ), - startCol = 1, startRow = 1 + startCol = 2, startRow = 10 ) - - openxlsx::addStyle(wb, "Instructions", errStyle1, rows = 10, cols = 1) - openxlsx::addStyle(wb, "Instructions", errStyle2, rows = 11, cols = 1) - openxlsx::addStyle(wb, "Instructions", errStyle3, rows = 12, cols = 1) - openxlsx::addStyle(wb, "Instructions", errStyle4, rows = 13, cols = 1) - - openxlsx::writeData(wb, "Instructions", - c( - "Errors specific to a particular column", - "Errors not specific to a defined column, i.e. non-numeric entries or missing covariates at time 0.", - "Malformed NA values, which should only be '.'", - "Used for column headers to report the total number of errors in that column." - ), - startCol = 2, startRow = 10 -) -return(wb) + return(wb) } @@ -1629,744 +1675,760 @@ plot.PM_data <- function( # process marker marker <- amendMarker(marker) - if (stringr::str_detect(marker$color, "#")){ # color is hex - marker$color <- map_chr(marker$color, \(x) substr(x, 1, 7)) # remove alpha if present, controlled by opacity - } - - highlight_color <- opposite_color(marker$color[1]) # in plotly_Utils.R - - - # process line - if (any(!base::names(line) %in% c("join", "pred"))) { - cli::cli_warn(c("!" = "{.code line} should be a list with at most two named elements: {.code join}, {.code loess}, and/or {.code pred}.", "i" = "See {.fn Pmetrics::plot.PM_data}.")) - } - if (is.null(line$join)) { - line$join <- FALSE - } - if (is.null(line$pred)) { - line$pred <- FALSE - } - - join <- amendLine(line$join) - if (is.logical(line$pred) && !line$pred) { # if line$pred is FALSE - line$pred <- NULL - } - pred <- line$pred # process further later - - # get the rest of the dots - layout <- amendDots(list(...)) - - # legend - if (missing(legend)) { - if (is.null(group)) { - legend <- FALSE - } else { - legend <- TRUE + if (!is.null(marker$color)) { + marker$color <- as.character(marker$color) + has_hex <- stringr::str_detect(marker$color, "#") + if (any(has_hex, na.rm = TRUE)) { + alpha_val <- if (is.null(marker$opacity)) 1 else marker$opacity[[1]] + marker$color[has_hex] <- vapply( + marker$color[has_hex], + rgba_to_rgb, + FUN.VALUE = character(1), + alpha = alpha_val + ) } } - legendList <- amendLegend(legend) - layout <- modifyList(layout, list(showlegend = legendList$showlegend)) - if (length(legendList) > 1) { - layout <- modifyList(layout, list(legend = within(legendList, rm(showlegend)))) - } - - - # grid - layout$xaxis <- setGrid(layout$xaxis, grid) - layout$yaxis <- setGrid(layout$yaxis, grid) - - # axis labels if needed - layout$xaxis$title <- amendTitle(xlab) - if (is.character(ylab)) { - layout$yaxis$title <- amendTitle(ylab, layout$xaxis$title$font) + # if (stringr::str_detect(marker$color, "#")){ # color is hex + # marker$color <- map_chr(marker$color, \(x) substr(x, 1, 7)) # remove alpha if present, controlled by opacity + # } + + + + highlight_color <- opposite_color(marker$color[1]) # in plotly_Utils.R + + + # process line + if (any(!base::names(line) %in% c("join", "pred"))) { + cli::cli_warn(c("!" = "{.code line} should be a list with at most two named elements: {.code join}, {.code loess}, and/or {.code pred}.", "i" = "See {.fn Pmetrics::plot.PM_data}.")) + } + if (is.null(line$join)) { + line$join <- FALSE + } + if (is.null(line$pred)) { + line$pred <- FALSE + } + + join <- amendLine(line$join) + if (is.logical(line$pred) && !line$pred) { # if line$pred is FALSE + line$pred <- NULL + } + pred <- line$pred # process further later + + + # get the rest of the dots + layout <- amendDots(list(...)) + + # legend + if (missing(legend)) { + if (is.null(group)) { + legend <- FALSE } else { - layout$yaxis$title <- amendTitle(ylab) - } - - - # axis ranges - if (!missing(xlim)) { - layout$xaxis <- modifyList(layout$xaxis, list(range = xlim)) - } - if (!missing(ylim)) { - layout$yaxis <- modifyList(layout$yaxis, list(range = ylim)) - } - - # log y axis - if (log) { - layout$yaxis <- modifyList(layout$yaxis, list(type = "log")) - } - - # title - layout$title <- amendTitle(title, default = list(size = 20)) - - # overlay - if (is.logical(overlay)) { # T/F - if (!overlay) { # F,default - nrows <- 1 - ncols <- 1 - } # if T, no need to set nrows or ncols - } else { # specified as c(rows, cols) - nrows <- overlay[1] - ncols <- overlay[2] - overlay <- FALSE + legend <- TRUE } - - # Data processing --------------------------------------------------------- - dat <- x$clone() #make copy of x to work with - - # make blocks - dat$standard_data <- makePMmatrixBlock(dat$standard_data) - - # time after dose - if (tad) { - dat$standard_data$time <- calcTAD(dat$standard_data) - dat$standard_data <- dat$standard_data %>% arrange(id, time) - } - - # filter - presub <- dat$standard_data %>% - filter(outeq %in% !!outeq, block %in% !!block, evid == 0) %>% - includeExclude(include, exclude) - - - - # make group column for groups - if (!is.null(group)) { - if (!group %in% base::names(dat$standard_data)) { - cli::cli_abort(c("x" = "{group} is not a column in the data.")) - } - if (is.null(group_names)) { - presub$group <- presub[[group]] - } else if (length(group_names) < length(unique(presub[[group]]))) { - cli::cli_abort(c("x" = "The number of names in {.var group_names} must be at least as long as the number of unique values in {.var group}.")) - } else { - presub$group <- factor(presub[[group]], labels = group_names) - } - } else { # group was NULL - presub <- presub %>% mutate(group = "") + } + + legendList <- amendLegend(legend) + layout <- modifyList(layout, list(showlegend = legendList$showlegend)) + if (length(legendList) > 1) { + layout <- modifyList(layout, list(legend = within(legendList, rm(showlegend)))) + } + + + # grid + layout$xaxis <- setGrid(layout$xaxis, grid) + layout$yaxis <- setGrid(layout$yaxis, grid) + + # axis labels if needed + layout$xaxis$title <- amendTitle(xlab) + if (is.character(ylab)) { + layout$yaxis$title <- amendTitle(ylab, layout$xaxis$title$font) + } else { + layout$yaxis$title <- amendTitle(ylab) + } + + + # axis ranges + if (!missing(xlim)) { + layout$xaxis <- modifyList(layout$xaxis, list(range = xlim)) + } + if (!missing(ylim)) { + layout$yaxis <- modifyList(layout$yaxis, list(range = ylim)) + } + + # log y axis + if (log) { + layout$yaxis <- modifyList(layout$yaxis, list(type = "log")) + } + + # title + layout$title <- amendTitle(title, default = list(size = 20)) + + # overlay + if (is.logical(overlay)) { # T/F + if (!overlay) { # F,default + nrows <- 1 + ncols <- 1 + } # if T, no need to set nrows or ncols + } else { # specified as c(rows, cols) + nrows <- overlay[1] + ncols <- overlay[2] + overlay <- FALSE + } + + # Data processing --------------------------------------------------------- + dat <- x$clone() #make copy of x to work with + + # make blocks + dat$standard_data <- makePMmatrixBlock(dat$standard_data) + + # time after dose + if (tad) { + dat$standard_data$time <- calcTAD(dat$standard_data) + dat$standard_data <- dat$standard_data %>% arrange(id, time) + } + + # filter + presub <- dat$standard_data %>% + filter(outeq %in% !!outeq, block %in% !!block, evid == 0) %>% + includeExclude(include, exclude) + + + + # make group column for groups + if (!is.null(group)) { + if (!group %in% base::names(dat$standard_data)) { + cli::cli_abort(c("x" = "{group} is not a column in the data.")) } - - - # make outeq labels if more than one output being plotted - if (length(outeq) > 1) { - if (is.null(out_names)) { - out_names <- paste0("Output ", 1:max(outeq)) - } else if (length(out_names) < max(outeq)) { - cli::cli_abort(c("x" = "The number of names in {.var out_names} must be at least as long as the maximum number of outputs in {.var outeq}.")) - } - # add outeq to group - presub <- presub %>% - rowwise() %>% - mutate(group = paste0(group, ", ", out_names[outeq])) + if (is.null(group_names)) { + presub$group <- presub[[group]] + } else if (length(group_names) < length(unique(presub[[group]]))) { + cli::cli_abort(c("x" = "The number of names in {.var group_names} must be at least as long as the number of unique values in {.var group}.")) + } else { + presub$group <- factor(presub[[group]], labels = group_names) } - - # add blocks if more than one being plotted - if (length(block) > 1) { - presub <- presub %>% - rowwise() %>% - mutate(group = paste0(group, ", Block ", block)) + } else { # group was NULL + presub <- presub %>% mutate(group = "") + } + + + # make outeq labels if more than one output being plotted + if (length(outeq) > 1) { + if (is.null(out_names)) { + out_names <- paste0("Output ", 1:max(outeq)) + } else if (length(out_names) < max(outeq)) { + cli::cli_abort(c("x" = "The number of names in {.var out_names} must be at least as long as the maximum number of outputs in {.var outeq}.")) } - - # there will always be an Obs group + # add outeq to group presub <- presub %>% rowwise() %>% - mutate(group = paste0(group, ", Obs ")) - - presub$group <- stringr::str_replace(presub$group, "^\\s*,*\\s*", "") - - # add cens column if missing - if (!"cens" %in% names(presub)) { - presub$cens <- "none" - } - - # select relevant columns - sub <- presub %>% - select(id, time, out, cens, outeq, group) %>% - mutate(id = as.character(id)) %>% - ungroup() - sub$group <- factor(sub$group) - - # add identifier - sub$src <- "obs" - - # remove missing - sub <- sub %>% filter(out != -99) - - - # now process pred data if there - if (!is.null(pred)) { - if (inherits(pred, c("PM_post", "PM_pop"))) { # only PM_post/pop was supplied, make into a list of 1 - pred <- list(pred$data) - } else if (inherits(pred, c("PM_post_data", "PM_pop_data"))) { # only PM_post_data/PM_pop_data was supplied, make into a list of 1 - pred <- list(pred) - } else if (inherits(pred[[1]], c("PM_post", "PM_pop"))) { # PM_post/pop as first argument of list - pred[[1]] <- pred[[1]]$data - } else if (inherits(pred[[1]], c("PM_post_data", "PM_pop_data"))){ # PM_post_data/PM_pop_data as first argument of list - pred[[1]] <- pred[[1]] # nothing to do, in right format already - } else if (pred[[1]] %in% c("pop", "post")) { # pred[[1]] was "pop" or "post" - thisPred <- pred[[1]] - if (is.null(x[[thisPred]])) { # post/pop missing because x was data did not come from a PM_result - cli::cli_warn(c( - "!" = "{.code pred = {thisPred}} can only be used as a shortcut when plotting {.cls PM_data} from a {.cls PM_result}.", - "i" = "Supply a {.cls PM_result} object, e.g. {.code line = list(pred = run2$post)}, if you wish to add predictions otherwise." - )) - pred <- NULL - } else { # post/pop present - if (length(pred) == 1){ # pred is either "pop" or "post" - pred <- list(x[[thisPred]]) - } else { - pred[[1]] <- x[[thisPred]] - } - } - } else { # pred[[1]] was none of the above + mutate(group = paste0(group, ", ", out_names[outeq])) + } + + # add blocks if more than one being plotted + if (length(block) > 1) { + presub <- presub %>% + rowwise() %>% + mutate(group = paste0(group, ", Block ", block)) + } + + # there will always be an Obs group + presub <- presub %>% + rowwise() %>% + mutate(group = paste0(group, ", Obs ")) + + presub$group <- stringr::str_replace(presub$group, "^\\s*,*\\s*", "") + + # add cens column if missing + if (!"cens" %in% names(presub)) { + presub$cens <- "none" + } + + # select relevant columns + sub <- presub %>% + select(id, time, out, cens, outeq, group) %>% + mutate(id = as.character(id)) %>% + ungroup() + sub$group <- factor(sub$group) + + # add identifier + sub$src <- "obs" + + # remove missing + sub <- sub %>% filter(out != -99) + + + # now process pred data if there + if (!is.null(pred)) { + if (inherits(pred, c("PM_post", "PM_pop"))) { # only PM_post/pop was supplied, make into a list of 1 + pred <- list(pred$data) + } else if (inherits(pred, c("PM_post_data", "PM_pop_data"))) { # only PM_post_data/PM_pop_data was supplied, make into a list of 1 + pred <- list(pred) + } else if (inherits(pred[[1]], c("PM_post", "PM_pop"))) { # PM_post/pop as first argument of list + pred[[1]] <- pred[[1]]$data + } else if (inherits(pred[[1]], c("PM_post_data", "PM_pop_data"))){ # PM_post_data/PM_pop_data as first argument of list + pred[[1]] <- pred[[1]] # nothing to do, in right format already + } else if (pred[[1]] %in% c("pop", "post")) { # pred[[1]] was "pop" or "post" + thisPred <- pred[[1]] + if (is.null(x[[thisPred]])) { # post/pop missing because x was data did not come from a PM_result cli::cli_warn(c( - "!" = "The {.var pred} argument is mis-specified.", - "i" = "See the help for {.code plot.PM_data}." + "!" = "{.code pred = {thisPred}} can only be used as a shortcut when plotting {.cls PM_data} from a {.cls PM_result}.", + "i" = "Supply a {.cls PM_result} object, e.g. {.code line = list(pred = run2$post)}, if you wish to add predictions otherwise." )) pred <- NULL - } - - - # process pred list to determine formatting - if (length(pred) == 1) { # default formatting and prediction - predArgs <- TRUE - icen <- "median" - } else { # not default, but need to extract icen if present - icen <- purrr::pluck(pred, "icen") # check if icen is in list - if (is.null(icen)) { # not in list so set default - icen <- "median" + } else { # post/pop present + if (length(pred) == 1){ # pred is either "pop" or "post" + pred <- list(x[[thisPred]]) } else { - purrr::pluck(pred, "icen") <- NULL - } # was in list, so remove after extraction - predArgs <- pred[-1] # get args beyond data to plot for pred - } - - predArgs <- amendLine(predArgs) # color will be set by obs later - - - - # 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) %>% - mutate(cens = "none") %>% # always none for predictions - includeExclude(include, exclude) %>% - group_by(id) - - # time after dose - if (tad) { - predsub$time <- calcTAD(predsub) + pred[[1]] <- x[[thisPred]] } - - # select relevant columns and filter missing - predsub <- predsub %>% - select(id, time, out = pred, cens, outeq) %>% - mutate(id = as.character(id)) %>% - filter(out != -99 & (cens == "none" | cens == 0)) - - - # add group - lookup <- dplyr::distinct(sub, id, outeq, group) - predsub <- predsub %>% dplyr::left_join(lookup, by = c("id", "outeq")) %>% - mutate(group = factor(stringr::str_replace_all(group, "Obs", "Pred"))) - - # add identifier - predsub$src <- "pred" - } else { # pred was reset to NULL b/c of invalid pred[[1]] - predsub <- NULL } - } else { # pred was NULL from beginning - predsub <- NULL - } # end pred processing + } else { # pred[[1]] was none of the above + cli::cli_warn(c( + "!" = "The {.var pred} argument is mis-specified.", + "i" = "See the help for {.code plot.PM_data}." + )) + pred <- NULL + } + + + # process pred list to determine formatting + if (length(pred) == 1) { # default formatting and prediction + predArgs <- TRUE + icen <- "median" + } else { # not default, but need to extract icen if present + icen <- purrr::pluck(pred, "icen") # check if icen is in list + if (is.null(icen)) { # not in list so set default + icen <- "median" + } else { + purrr::pluck(pred, "icen") <- NULL + } # was in list, so remove after extraction + predArgs <- pred[-1] # get args beyond data to plot for pred + } + predArgs <- amendLine(predArgs) # color will be set by obs later - # Plot function ---------------------------------------------------------- - dataPlot <- function(allsub, overlay, includePred) { + # 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) %>% + mutate(cens = "none") %>% # always none for predictions + includeExclude(include, exclude) %>% + group_by(id) - group_colors <- marker$color - group_symbols <- marker$symbol - if (!is.null(group) | length(outeq)>1 | length(block)>1) { # there was grouping beyond obs/pred - - n_colors <- length(unique(allsub$group)) - - if (length(group_colors) < n_colors) { # fewer colors than groups, need to interpolate - if (checkRequiredPackages("RColorBrewer")) { - palettes <- RColorBrewer::brewer.pal.info %>% mutate(name = rownames(.)) - if (length(group_colors) == 1) { # only one color specified - if (group_colors %in% palettes$name){# colors specified as a palette name - max_colors <- palettes$maxcolors[match(group_colors, palettes$name)] - group_colors <- colorRampPalette(RColorBrewer::brewer.pal(max_colors, group_colors))(n_colors) - } else { - group_colors <- c(group_colors, getDefaultColors(n_colors)[-1]) # in plotly_Utils, add default colors to specified color - } - } else { # length of group_colors > 1 but fewer than groups, so interpolate - group_colors <- tryCatch(colorRampPalette(group_colors)(n_colors), - error = function(e) { - cli::cli_warn(c("!" = "Unable to interpolate colors, using default colors.")) - getDefaultColors(n_colors) # in plotly_Utils - } - ) - } - } else { - cli::cli_inform(c("i" = "Group colors are better with the {.pkg RColorBrewer} package installed.")) - colors <- getDefaultColors(n_colors) # in plotly_Utils - } + # time after dose + if (tad) { + predsub$time <- calcTAD(predsub) } - if (length(group_symbols) < n_colors) { # fewer symbols than groups, need to interpolate - if (length(group_symbols) == 1) { # only one symbol specified - group_symbols <- rep(group_symbols, n_colors) - } else { # multiple symbols specified, but fewer than groups - group_symbols <- rep(group_symbols, length.out = n_colors) - } - } + # select relevant columns and filter missing + predsub <- predsub %>% + select(id, time, out = pred, cens, outeq) %>% + mutate(id = as.character(id)) %>% + filter(out != -99 & (cens == "none" | cens == 0)) - } else { # no grouping other than possibly pred - if (includePred | join$width > 0) { # need colors for both obs and join or pred - group_colors <- rep(group_colors, 2) # observed and predicted should be the same - } - } - - - # assign colors and symbols to each group, editing for censoring - IDstring <- ifelse(overlay, "ID: {id}\n", "") - allsub <- allsub %>% - #rowwise() %>% - mutate( - color = group_colors[as.integer(group)], - symbol = group_symbols[as.integer(group)] - ) %>% - mutate( - color = dplyr::case_when( - cens == "bloq" | cens == "1" | color == "aloq" | color == "-1" ~ opposite_color(color, degrees = 90), - .default = color - ), - #color = ifelse(cens != "none" & cens != "0", opposite_color(color, degrees = 90), color), - symbol = dplyr::case_when( - cens == "bloq" | cens == "1" ~ "triangle-down", - cens == "none" | cens == "0" ~ as.character(symbol), - cens == "aloq" | cens == "-1" ~ "triangle-up", - .default = symbol), - text_label = dplyr::case_when( - cens == "bloq" | cens == "1" ~ glue::glue(IDstring,"Time: {round2(time)}\nBLLQ: {round2(out)}\n{group}"), - cens == "none" | cens == "0" ~ glue::glue(IDstring,"Time: {round2(time)}\nOut: {round2(out)}\n{group}"), - cens == "aloq" | cens == "-1" ~ glue::glue(IDstring,"Time: {round2(time)}\nAULQ: {round2(out)}\n{group}"), - .default = glue::glue(IDstring,"Time: {round2(time)}\nPred: {round2(out)}\n{group}") - ) - ) %>% - ungroup() - # if ID is numeric, arrange by numeric ID - if(overlay && !any(is.na(suppressWarnings(as.numeric(allsub$id))))) { - allsub <- allsub %>% - mutate(id = as.numeric(id)) %>% arrange(id, time) - } + # add group + lookup <- dplyr::distinct(sub, id, outeq, group) + predsub <- predsub %>% dplyr::left_join(lookup, by = c("id", "outeq")) %>% + mutate(group = factor(stringr::str_replace_all(group, "Obs", "Pred"))) + # add identifier + predsub$src <- "pred" + } else { # pred was reset to NULL b/c of invalid pred[[1]] + predsub <- NULL + } + } else { # pred was NULL from beginning + predsub <- NULL + } # end pred processing + + + + # Plot function ---------------------------------------------------------- + + dataPlot <- function(allsub, overlay, includePred) { + + group_colors <- marker$color + group_symbols <- marker$symbol + if (!is.null(group) | length(outeq)>1 | length(block)>1) { # there was grouping beyond obs/pred - seen_groups <- NULL - traces <- if(overlay) {allsub %>% dplyr::group_split(id)} else {list(allsub)} + n_colors <- length(unique(allsub$group)) - # Build plot - p <- plot_ly() - for (i in seq_along(traces)) { - trace_data <- traces[[i]] - if (any(!unique(trace_data$group) %in% seen_groups)) { - seen_groups <- c(seen_groups, as.character(unique(trace_data$group))) - legendShow <- TRUE - } else { - legendShow <- FALSE - } - this_id <- ifelse(overlay, trace_data$id[1], 1) - - p <- add_trace( - p, - data = trace_data %>% plotly::filter(src == "obs") %>% arrange(group, time), - x = ~time, y = ~ out * mult, - type = "scatter", - mode = "markers", - split = ~group, - name = ~group, - uid = as.character(this_id), - meta = list(id = this_id), - marker = list(color = ~I(color), symbol = ~I(symbol), size = marker$size, opacity = marker$opacity, - line = list(color = marker$line$color, width = marker$line$width)), - text = ~text_label, - hoverinfo = "text", - legendgroup = ~group, - showlegend = legendShow - ) - - # add joining lines if needed - if (join$width > 0){ - trace_split <- trace_data %>% filter(src == "obs") %>% dplyr::group_split(color) - for(j in seq_along(trace_split)){ - this_color <- trace_split[[j]]$color[1] - p <- add_trace( - p, - data = trace_split[[j]], - x = ~time, y = ~(out * mult), - type = "scatter", mode = "lines", - name = ~group, - uid = as.character(this_id), - meta = list(id = this_id), - line = list(color = this_color, width = join$width, dash = join$dash), - text = ~text_label, - hoverinfo = "text", - legendgroup = ~group, - showlegend = FALSE - ) - } - } - - if (includePred) { - trace_split <- trace_data %>% filter(src == "pred") %>% dplyr::group_split(color) - for(j in seq_along(trace_split)){ - this_color <- trace_split[[j]]$color[1] - p <- add_trace( - p, - data = trace_split[[j]], - x = ~time, y = ~(out * mult), - type = "scatter", mode = "lines", - name = ~group, - uid = as.character(this_id), - meta = list(id = this_id), - line = list(color = this_color, width = predArgs$width, dash = predArgs$dash), - text = ~text_label, - hoverinfo = "text", - legendgroup = ~group, - showlegend = legendShow - ) - } + if (length(group_colors) < n_colors) { # fewer colors than groups, need to interpolate + if (checkRequiredPackages("RColorBrewer")) { + palettes <- RColorBrewer::brewer.pal.info %>% mutate(name = rownames(.)) + if (length(group_colors) == 1) { # only one color specified + if (group_colors %in% palettes$name){# colors specified as a palette name + max_colors <- palettes$maxcolors[match(group_colors, palettes$name)] + group_colors <- colorRampPalette(RColorBrewer::brewer.pal(max_colors, group_colors))(n_colors) + } else { + group_colors <- c(group_colors, getDefaultColors(n_colors)[-1]) # in plotly_Utils, add default colors to specified color + } + } else { # length of group_colors > 1 but fewer than groups, so interpolate + group_colors <- tryCatch(colorRampPalette(group_colors)(n_colors), + error = function(e) { + cli::cli_warn(c("!" = "Unable to interpolate colors, using default colors.")) + getDefaultColors(n_colors) # in plotly_Utils + } + ) } + } else { + cli::cli_inform(c("i" = "Group colors are better with the {.pkg RColorBrewer} package installed.")) + colors <- getDefaultColors(n_colors) # in plotly_Utils } - - p <- p %>% plotly::layout( - xaxis = layout$xaxis, - yaxis = layout$yaxis, - title = layout$title, - showlegend = layout$showlegend, - legend = layout$legend - ) - return(invisible(p)) - } # end dataPlot - - - # Call plot --------------------------------------------------------------- + } + if (length(group_symbols) < n_colors) { # fewer symbols than groups, need to interpolate + if (length(group_symbols) == 1) { # only one symbol specified + group_symbols <- rep(group_symbols, n_colors) + } else { # multiple symbols specified, but fewer than groups + group_symbols <- rep(group_symbols, length.out = n_colors) + } + } - # if pred present, need to combine data and pred for proper display + } else { # no grouping other than possibly pred + if (includePred | join$width > 0) { # need colors for both obs and join or pred + group_colors <- rep(group_colors, 2) # observed and predicted should be the same + } + } + + + # assign colors and symbols to each group, editing for censoring + IDstring <- ifelse(overlay, "ID: {id}\n", "") + allsub <- allsub %>% + #rowwise() %>% + mutate( + color = group_colors[as.integer(group)], + symbol = group_symbols[as.integer(group)] + ) %>% + mutate( + color = dplyr::case_when( + cens == "bloq" | cens == "1" | color == "aloq" | color == "-1" ~ opposite_color(color, degrees = 90), + .default = color + ), + #color = ifelse(cens != "none" & cens != "0", opposite_color(color, degrees = 90), color), + symbol = dplyr::case_when( + cens == "bloq" | cens == "1" ~ "triangle-down", + cens == "none" | cens == "0" ~ as.character(symbol), + cens == "aloq" | cens == "-1" ~ "triangle-up", + .default = symbol), + text_label = dplyr::case_when( + cens == "bloq" | cens == "1" ~ glue::glue(IDstring,"Time: {round2(time)}\nBLLQ: {round2(out)}\n{group}"), + cens == "none" | cens == "0" ~ glue::glue(IDstring,"Time: {round2(time)}\nOut: {round2(out)}\n{group}"), + cens == "aloq" | cens == "-1" ~ glue::glue(IDstring,"Time: {round2(time)}\nAULQ: {round2(out)}\n{group}"), + .default = glue::glue(IDstring,"Time: {round2(time)}\nPred: {round2(out)}\n{group}") + ) + ) %>% + ungroup() - if (!is.null(predsub)) { - allsub <- dplyr::bind_rows(sub, predsub) %>% dplyr::arrange(id, time) - includePred <- TRUE - } else { - allsub <- sub - includePred <- FALSE + # if ID is numeric, arrange by numeric ID + if(overlay && !any(is.na(suppressWarnings(as.numeric(allsub$id))))) { + allsub <- allsub %>% + mutate(id = as.numeric(id)) %>% arrange(id, time) } - # call the plot function and display appropriately - if (overlay) { - allsub <- allsub %>% dplyr::group_by(id) - p <- dataPlot(allsub, overlay = TRUE, includePred) + seen_groups <- NULL + traces <- if(overlay) {allsub %>% dplyr::group_split(id)} else {list(allsub)} + + # Build plot + p <- plot_ly() + for (i in seq_along(traces)) { + trace_data <- traces[[i]] + if (any(!unique(trace_data$group) %in% seen_groups)) { + seen_groups <- c(seen_groups, as.character(unique(trace_data$group))) + legendShow <- TRUE + } else { + legendShow <- FALSE + } + this_id <- ifelse(overlay, trace_data$id[1], 1) - if (print) print(click_plot(p, highlight_color = highlight_color)) - return(invisible(p)) - } else { # overlay = FALSE, ie. split them + p <- add_trace( + p, + data = trace_data %>% plotly::filter(src == "obs") %>% arrange(group, time), + x = ~time, y = ~ out * mult, + type = "scatter", + mode = "markers", + split = ~group, + name = ~group, + uid = as.character(this_id), + meta = list(id = this_id), + marker = list(color = ~I(color), symbol = ~I(symbol), size = marker$size, opacity = marker$opacity, + line = list(color = marker$line$color, width = marker$line$width)), + text = ~text_label, + hoverinfo = "text", + legendgroup = ~group, + showlegend = legendShow + ) - if (!checkRequiredPackages("trelliscopejs")) { - cli::cli_abort(c("x" = "Package {.pkg trelliscopejs} required to plot when {.code overlay = FALSE}.")) + # add joining lines if needed + if (join$width > 0){ + trace_split <- trace_data %>% filter(src == "obs") %>% dplyr::group_split(color) + for(j in seq_along(trace_split)){ + this_color <- trace_split[[j]]$color[1] + p <- add_trace( + p, + data = trace_split[[j]], + x = ~time, y = ~(out * mult), + type = "scatter", mode = "lines", + name = ~group, + uid = as.character(this_id), + meta = list(id = this_id), + line = list(color = this_color, width = join$width, dash = join$dash), + text = ~text_label, + hoverinfo = "text", + legendgroup = ~group, + showlegend = FALSE + ) + } } - sub_split <- allsub %>% - nest(data = -id) %>% - mutate(panel = trelliscopejs::map_plot(data, \(x) dataPlot(x, overlay = FALSE, includePred = includePred))) - p <- sub_split %>% - ungroup() %>% - trelliscopejs::trelliscope(name = "Data", nrow = nrows, ncol = ncols) - if (print) print(p) + if (includePred) { + trace_split <- trace_data %>% filter(src == "pred") %>% dplyr::group_split(color) + for(j in seq_along(trace_split)){ + this_color <- trace_split[[j]]$color[1] + p <- add_trace( + p, + data = trace_split[[j]], + x = ~time, y = ~(out * mult), + type = "scatter", mode = "lines", + name = ~group, + uid = as.character(this_id), + meta = list(id = this_id), + line = list(color = this_color, width = predArgs$width, dash = predArgs$dash), + text = ~text_label, + hoverinfo = "text", + legendgroup = ~group, + showlegend = legendShow + ) + } + } } + p <- p %>% plotly::layout( + xaxis = layout$xaxis, + yaxis = layout$yaxis, + title = layout$title, + showlegend = layout$showlegend, + legend = layout$legend + ) return(invisible(p)) - } - # SUMMARY ----------------------------------------------------------------- + } # end dataPlot + + + # Call plot --------------------------------------------------------------- + + + # if pred present, need to combine data and pred for proper display + + if (!is.null(predsub)) { + allsub <- dplyr::bind_rows(sub, predsub) %>% dplyr::arrange(id, time) + includePred <- TRUE + } else { + allsub <- sub + includePred <- FALSE + } - #' @title Summarize PM_data objects - #' @description - #' `r lifecycle::badge("stable")` - #' - #' Summarize the raw data used for a Pmetrics run. - #' - #' @method summary PM_data - #' @param object A [PM_data] object. - #' @param formula Optional formula for specifying custom summaries. See [aggregate] - #' and [formula] for details on how to specify formulae in R. If, for example, the data contain - #' a covariate for weight named 'wt', then to summarize the mean dose in mg/kg per subject specify - #' `formula = dose/wt ~ id` and `FUN = mean`. - #' @param FUN The summary function to apply to [formula], if specified. This is not - #' quoted, and usual choices will be [mean], [median], [max], or [min]. - #' @param include A vector of subject IDs to include in the summary, e.g. `c(1:3,5,15)` - #' @param exclude A vector of subject IDs to exclude in the summary, e.g. `c(4,6:14,16:20)` - #' @param ... Additional arguments to `FUN`, e.g. `na.rm = TRUE` - #' @return A list of class *summary.PM_data* with the following items: - #' * **nsub** Number of subjects - #' * **ndrug** Number of drug inputs - #' * **numeqt** Number of outputs - #' * **nobsXouteq** Number of observations by outeq - #' * **missObsXouteq** Number of missing observations by outeq - #' * **loqObsXouteq** Number of observations coded as below the limit of quantification by outeq - #' * **ncov** Number of covariates - #' * **covnames** Covariate names - #' * **ndoseXid** Number of doses per input per subject - #' * **nobsXid** Number of observations per outeq per subject - #' * **doseXid** Doses per input per subject - #' * **obsXid** Observations per outeq per subject - #' * **formula** Results of including [formula] - #' @author Michael Neely - #' @seealso [aggregate] - #' @export - summary.PM_data <- function(object, formula, FUN, include, exclude, ...) { + # call the plot function and display appropriately + if (overlay) { + allsub <- allsub %>% dplyr::group_by(id) + p <- dataPlot(allsub, overlay = TRUE, includePred) - if(inherits(object, "PM_data")) { - object <- object$standard_data - } + if (print) print(click_plot(p, highlight_color = highlight_color)) + return(invisible(p)) + } else { # overlay = FALSE, ie. split them - # filter data if needed - if (!missing(include)) { - object <- subset(object, sub("[[:space:]]+", "", as.character(object$id)) %in% as.character(include)) - } - if (!missing(exclude)) { - object <- subset(object, !sub("[[:space:]]+", "", as.character(object$id)) %in% as.character(exclude)) - } - - # make results list - results <- list() - idOrder <- rank(unique(object$id)) - - results$nsub <- length(unique(object$id)) - results$ndrug <- max(object$input, na.rm = T) - results$numeqt <- max(object$outeq, na.rm = T) - results$nobsXouteq <- tapply(object$evid, object$outeq, function(x) length(x == 0)) - results$missObsXouteq <- by(object, object$outeq, function(x) length(x$out[x$evid == 0 & x$out == -99])) - - # censored - - results$bloqObsXouteq <- purrr::map_int(1:max(object$outeq, na.rm = TRUE), \(x) sum(object$cens[object$outeq == x] == "1", object$cens[object$outeq == x] == "bloq", na.rm = TRUE)) - results$aloqObsXouteq <- purrr::map_int(1:max(object$outeq, na.rm = TRUE), \(x) sum(object$cens[object$outeq == x] == "-1", object$cens[object$outeq == x] == "aloq", na.rm = TRUE)) - - covinfo <- getCov(object) - ncov <- covinfo$ncov - results$ncov <- ncov - results$covnames <- covinfo$covnames - results$ndoseXid <- as.matrix(tapply(object$evid, list(object$id, object$input), function(x) length(x != 0))[idOrder, ]) - results$nobsXid <- as.matrix(tapply(object$evid, list(object$id, object$outeq), function(x) length(x == 0))[idOrder, ]) - results$doseXid <- as.matrix(tapply(object$dose, list(object$id, object$input), function(x) x[!is.na(x)])[idOrder, ]) - results$obsXid <- as.matrix(tapply(object$out, list(object$id, object$outeq), function(x) x[!is.na(x)])[idOrder, ]) - if (ncov > 0) { - # get each subject's covariate values - results$cov <- lapply(1:ncov, function(y) { - tapply( - object[[covinfo$covstart + y - 1]], object$id, - function(z) z[!is.na(z)] - )[idOrder] - }) - names(results$cov) <- covinfo$covnames - } - if (!missing(formula)) { - results$formula <- aggregate(formula, object, FUN, ...) + if (!checkRequiredPackages("trelliscopejs")) { + cli::cli_abort(c("x" = "Package {.pkg trelliscopejs} required to plot when {.code overlay = FALSE}.")) } - class(results) <- c("summary.PM_data", "list") - return(results) - } # end function - # PRINT SUMMARY ----------------------------------------------------------------- - - #' @title Print Summary of Pmetrics Data - #' @description - #' `r lifecycle::badge("stable")` - #' - #' @details - #' Print the summary of [PM_data] object. - #' - #' Summarize the raw data used for a Pmetrics run. - #' - #' @method print summary.PM_data - #' @param x An object made by [summary.PM_data]. - #' @return A printed object - #' @author Michael Neely - #' @param ... Not used. - #' @seealso [summary.PM_data] - #' @examples - #' \dontrun{ - #' dataEx$summary() - #' } + sub_split <- allsub %>% + nest(data = -id) %>% + mutate(panel = trelliscopejs::map_plot(data, \(x) dataPlot(x, overlay = FALSE, includePred = includePred))) + p <- sub_split %>% + ungroup() %>% + trelliscopejs::trelliscope(name = "Data", nrow = nrows, ncol = ncols) + if (print) print(p) + } - #' @export + return(invisible(p)) +} +# SUMMARY ----------------------------------------------------------------- + +#' @title Summarize PM_data objects +#' @description +#' `r lifecycle::badge("stable")` +#' +#' Summarize the raw data used for a Pmetrics run. +#' +#' @method summary PM_data +#' @param object A [PM_data] object. +#' @param formula Optional formula for specifying custom summaries. See [aggregate] +#' and [formula] for details on how to specify formulae in R. If, for example, the data contain +#' a covariate for weight named 'wt', then to summarize the mean dose in mg/kg per subject specify +#' `formula = dose/wt ~ id` and `FUN = mean`. +#' @param FUN The summary function to apply to [formula], if specified. This is not +#' quoted, and usual choices will be [mean], [median], [max], or [min]. +#' @param include A vector of subject IDs to include in the summary, e.g. `c(1:3,5,15)` +#' @param exclude A vector of subject IDs to exclude in the summary, e.g. `c(4,6:14,16:20)` +#' @param ... Additional arguments to `FUN`, e.g. `na.rm = TRUE` +#' @return A list of class *summary.PM_data* with the following items: +#' * **nsub** Number of subjects +#' * **ndrug** Number of drug inputs +#' * **numeqt** Number of outputs +#' * **nobsXouteq** Number of observations by outeq +#' * **missObsXouteq** Number of missing observations by outeq +#' * **loqObsXouteq** Number of observations coded as below the limit of quantification by outeq +#' * **ncov** Number of covariates +#' * **covnames** Covariate names +#' * **ndoseXid** Number of doses per input per subject +#' * **nobsXid** Number of observations per outeq per subject +#' * **doseXid** Doses per input per subject +#' * **obsXid** Observations per outeq per subject +#' * **formula** Results of including [formula] +#' @author Michael Neely +#' @seealso [aggregate] +#' @export + +summary.PM_data <- function(object, formula, FUN, include, exclude, ...) { + + if(inherits(object, "PM_data")) { + object <- object$standard_data + } + + # filter data if needed + if (!missing(include)) { + object <- subset(object, sub("[[:space:]]+", "", as.character(object$id)) %in% as.character(include)) + } + if (!missing(exclude)) { + object <- subset(object, !sub("[[:space:]]+", "", as.character(object$id)) %in% as.character(exclude)) + } + + # make results list + results <- list() + idOrder <- rank(unique(object$id)) + + results$nsub <- length(unique(object$id)) + results$ndrug <- max(object$input, na.rm = T) + results$numeqt <- max(object$outeq, na.rm = T) + results$nobsXouteq <- tapply(object$evid, object$outeq, function(x) length(x == 0)) + results$missObsXouteq <- by(object, object$outeq, function(x) length(x$out[x$evid == 0 & x$out == -99])) + + # censored + + results$bloqObsXouteq <- purrr::map_int(1:max(object$outeq, na.rm = TRUE), \(x) sum(object$cens[object$outeq == x] == "1", object$cens[object$outeq == x] == "bloq", na.rm = TRUE)) + results$aloqObsXouteq <- purrr::map_int(1:max(object$outeq, na.rm = TRUE), \(x) sum(object$cens[object$outeq == x] == "-1", object$cens[object$outeq == x] == "aloq", na.rm = TRUE)) + + covinfo <- getCov(object) + ncov <- covinfo$ncov + results$ncov <- ncov + results$covnames <- covinfo$covnames + results$ndoseXid <- as.matrix(tapply(object$evid, list(object$id, object$input), function(x) length(x != 0))[idOrder, ]) + results$nobsXid <- as.matrix(tapply(object$evid, list(object$id, object$outeq), function(x) length(x == 0))[idOrder, ]) + results$doseXid <- as.matrix(tapply(object$dose, list(object$id, object$input), function(x) x[!is.na(x)])[idOrder, ]) + results$obsXid <- as.matrix(tapply(object$out, list(object$id, object$outeq), function(x) x[!is.na(x)])[idOrder, ]) + if (ncov > 0) { + # get each subject's covariate values + results$cov <- lapply(1:ncov, function(y) { + tapply( + object[[covinfo$covstart + y - 1]], object$id, + function(z) z[!is.na(z)] + )[idOrder] + }) + names(results$cov) <- covinfo$covnames + } + if (!missing(formula)) { + results$formula <- aggregate(formula, object, FUN, ...) + } - print.summary.PM_data <- function(x, ...) { - # order of objects - # nsub - # ndrug - # numeqt - # nobsXouteq - # missObsXouteq - # bloqObsXouteq - # aloqObsXouteq - # ncov - # ndoseXid - # nobsXid - # doseXid - # obsXid - # cov - # formula - - cli::cli_div(theme = list( - span.blue = list(color = navy()) - )) - cli::cli_h1("Data Summary") - - cli::cli_text("Number of subjects: {.blue {x$nsub}}") - cli::cli_text("Number of inputs: {.blue {x$ndrug}}") - cli::cli_text("Number of outputs: {.blue {x$numeqt}}") - if (x$ncov > 0) { - cli::cli_text(" Covariates: {.blue {x$covnames}}") - } - cli::cli_h2("Inputs: Mean (SD), Min to Max") - for (i in 1:x$ndrug) { - if (x$ndrug > 1) { - cli::cli_h3("Input {i}") - } - cli::cli_text("Number of doses per subject: {.blue {sprintf('%.3f', mean(x$ndoseXid[, i], na.rm = T))}} ({.blue {sprintf('%.3f', sd(x$ndoseXid[, i], na.rm = T))}}), {.blue {sprintf('%.3f', min(x$ndoseXid[, i], na.rm = T))}} to {.blue {sprintf('%.3f', max(x$ndoseXid[, i], na.rm = T))}} ") - cli::cli_text("Dose amount per subject: {.blue {sprintf('%.3f', mean(unlist(x$doseXid[, i]), na.rm = T))}} ({.blue {sprintf('%.3f', sd(unlist(x$doseXid[, i]), na.rm = T))}}), {.blue {sprintf('%.3f', min(unlist(x$doseXid[, i]), na.rm = T))}} to {.blue {sprintf('%.3f', max(unlist(x$doseXid[, i]), na.rm = T))}} ") - - } - cli::cli_h2("Outputs: Mean (SD), Min to Max") - for (i in 1:x$numeqt) { - if (x$numeqt > 1) { - cli::cli_h3("Output {i}") - } - nobs <- unlist(x$nobsXid[, i]) - mean_nobs <- mean(nobs, na.rm = T) - sd_nobs <- sd(nobs, na.rm = T) - min_nobs <- min(nobs, na.rm = T) - max_nobs <- max(nobs, na.rm = T) - - obs <- unlist(x$obsXid[, i]) - obs <- obs[obs != -99] - mean_obs <- mean(obs, na.rm = T) - sd_obs <- sd(obs, na.rm = T) - min_obs <- min(obs, na.rm = T) - max_obs <- max(obs, na.rm = T) - - if (x$bloqObsXouteq[i] > 0) { - extra_text <- ", and {.blue {x$bloqObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$bloqObsXouteq[i] / x$nobsXouteq[i])}%}) censored as below a lower LOQ" - } else { - extra_text <- "" - } - - if (x$aloqObsXouteq[i] > 0) { - extra_text <- paste0(extra_text, ", and {.blue {x$aloqObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$aloqObsXouteq[i] / x$nobsXouteq[i])}%}) censored as above an upper LOQ") - } - cli::cli_text("Total across all subjects: {.blue {x$nobsXouteq[i]}}, with {.blue {x$missObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$missObsXouteq[i] / x$nobsXouteq[i])}%}) missing", extra_text, ".") - cli::cli_text("Number per subject: {.blue {sprintf('%.3f', mean_nobs)}} ({.blue {sprintf('%.3f', sd_nobs)}}), {.blue {sprintf('%i', min_nobs)}} to {.blue {sprintf('%i', max_nobs)}} ") - cli::cli_text("Value per subject: {.blue {sprintf('%.3f', mean_obs)}} ({.blue {sprintf('%.3f', sd_obs)}}), {.blue {sprintf('%.3f', min_obs)}} to {.blue {sprintf('%.3f', max_obs)}} ") - } - if (x$ncov > 0) { - cli::cli_h2("Population level covariates: Mean (SD), Min to Max") - for (i in 1:x$ncov) { - cli::cli_text("{x$covnames[i]}: {.blue {sprintf('%.3f', mean(unlist(x$cov[[i]]), na.rm = T))}} ({.blue {sprintf('%.3f', sd(unlist(x$cov[[i]]), na.rm = T))}}), {.blue {sprintf('%.3f', min(unlist(x$cov[[i]]), na.rm = T))}} to {.blue {sprintf('%.3f', max(unlist(x$cov[[i]]), na.rm = T))}}") - } + class(results) <- c("summary.PM_data", "list") + return(results) +} # end function +# PRINT SUMMARY ----------------------------------------------------------------- + +#' @title Print Summary of Pmetrics Data +#' @description +#' `r lifecycle::badge("stable")` +#' +#' @details +#' Print the summary of [PM_data] object. +#' +#' Summarize the raw data used for a Pmetrics run. +#' +#' @method print summary.PM_data +#' @param x An object made by [summary.PM_data]. +#' @return A printed object +#' @author Michael Neely +#' @param ... Not used. +#' @seealso [summary.PM_data] +#' @examples +#' \dontrun{ +#' dataEx$summary() +#' } + +#' @export + +print.summary.PM_data <- function(x, ...) { + # order of objects + # nsub + # ndrug + # numeqt + # nobsXouteq + # missObsXouteq + # bloqObsXouteq + # aloqObsXouteq + # ncov + # ndoseXid + # nobsXid + # doseXid + # obsXid + # cov + # formula + + cli::cli_div(theme = list( + span.blue = list(color = navy()) + )) + cli::cli_h1("Data Summary") + + cli::cli_text("Number of subjects: {.blue {x$nsub}}") + cli::cli_text("Number of inputs: {.blue {x$ndrug}}") + cli::cli_text("Number of outputs: {.blue {x$numeqt}}") + if (x$ncov > 0) { + cli::cli_text(" Covariates: {.blue {x$covnames}}") + } + cli::cli_h2("Inputs: Mean (SD), Min to Max") + for (i in 1:x$ndrug) { + if (x$ndrug > 1) { + cli::cli_h3("Input {i}") + } + cli::cli_text("Number of doses per subject: {.blue {sprintf('%.3f', mean(x$ndoseXid[, i], na.rm = T))}} ({.blue {sprintf('%.3f', sd(x$ndoseXid[, i], na.rm = T))}}), {.blue {sprintf('%.3f', min(x$ndoseXid[, i], na.rm = T))}} to {.blue {sprintf('%.3f', max(x$ndoseXid[, i], na.rm = T))}} ") + cli::cli_text("Dose amount per subject: {.blue {sprintf('%.3f', mean(unlist(x$doseXid[, i]), na.rm = T))}} ({.blue {sprintf('%.3f', sd(unlist(x$doseXid[, i]), na.rm = T))}}), {.blue {sprintf('%.3f', min(unlist(x$doseXid[, i]), na.rm = T))}} to {.blue {sprintf('%.3f', max(unlist(x$doseXid[, i]), na.rm = T))}} ") + + } + cli::cli_h2("Outputs: Mean (SD), Min to Max") + for (i in 1:x$numeqt) { + if (x$numeqt > 1) { + cli::cli_h3("Output {i}") + } + nobs <- unlist(x$nobsXid[, i]) + mean_nobs <- mean(nobs, na.rm = T) + sd_nobs <- sd(nobs, na.rm = T) + min_nobs <- min(nobs, na.rm = T) + max_nobs <- max(nobs, na.rm = T) + + obs <- unlist(x$obsXid[, i]) + obs <- obs[obs != -99] + mean_obs <- mean(obs, na.rm = T) + sd_obs <- sd(obs, na.rm = T) + min_obs <- min(obs, na.rm = T) + max_obs <- max(obs, na.rm = T) + + if (x$bloqObsXouteq[i] > 0) { + extra_text <- ", and {.blue {x$bloqObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$bloqObsXouteq[i] / x$nobsXouteq[i])}%}) censored as below a lower LOQ" + } else { + extra_text <- "" } - if (!is.null(x$formula)) { - cli::cli_h2("Formula Results") - print(x$formula) + if (x$aloqObsXouteq[i] > 0) { + extra_text <- paste0(extra_text, ", and {.blue {x$aloqObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$aloqObsXouteq[i] / x$nobsXouteq[i])}%}) censored as above an upper LOQ") + } + cli::cli_text("Total across all subjects: {.blue {x$nobsXouteq[i]}}, with {.blue {x$missObsXouteq[i]}} ({.blue {sprintf('%.3f', 100 * x$missObsXouteq[i] / x$nobsXouteq[i])}%}) missing", extra_text, ".") + cli::cli_text("Number per subject: {.blue {sprintf('%.3f', mean_nobs)}} ({.blue {sprintf('%.3f', sd_nobs)}}), {.blue {sprintf('%i', min_nobs)}} to {.blue {sprintf('%i', max_nobs)}} ") + cli::cli_text("Value per subject: {.blue {sprintf('%.3f', mean_obs)}} ({.blue {sprintf('%.3f', sd_obs)}}), {.blue {sprintf('%.3f', min_obs)}} to {.blue {sprintf('%.3f', max_obs)}} ") + } + if (x$ncov > 0) { + cli::cli_h2("Population level covariates: Mean (SD), Min to Max") + for (i in 1:x$ncov) { + cli::cli_text("{x$covnames[i]}: {.blue {sprintf('%.3f', mean(unlist(x$cov[[i]]), na.rm = T))}} ({.blue {sprintf('%.3f', sd(unlist(x$cov[[i]]), na.rm = T))}}), {.blue {sprintf('%.3f', min(unlist(x$cov[[i]]), na.rm = T))}} to {.blue {sprintf('%.3f', max(unlist(x$cov[[i]]), na.rm = T))}}") } - cli::cli_text("") - cli::cli_text("{.strong Note:} See {.help summary.PM_data} for more summary options using {.arg formula}.") - } # end function - # WRITE ------------------------------------------------------------------- + } - #' @title Write a Pmetrics .csv Matrix File - #' @description - #' `r lifecycle::badge("superseded")` - #' - #' This function is largely superseded as the function is accessed with - #' the `$save()` method for [PM_data] objects. There is rarely a need to call - #' it directly. It is the companion function to [PMreadMatrix]. - #' It will write an appropriate R data object to a formatted .csv file. - #' @details - #' *PMwriteMatrix* will first run [PMcheck] to determine - #' if there are any errors in the structure of `data`. If the error check - #' fails, the file will not be written and a message will be printed on the console. - #' - #' @param data Must be a data.frame with appropriate structure (see [PMcheck]). - #' @param filename Name of file to create. - #' @param override Boolean operator to write even if errors are detected. Default is `FALSE`. - #' @param version Which matrix data format version to write. Default is the current version. - #' @param header Is there a header row? Default is `FALSE` as this was the legacy format. - #' @return Returns the error report (see [PMcheck] for details). - #' @author Michael Neely - #' @seealso [PM_data], [PMcheck], [PMreadMatrix] - #' @export - #' @examples - #' \dontrun{ - #' # write to the current directory - #' NPex$data$save("data.csv") - #' } - PMwriteMatrix <- function( - data, filename, override = FALSE, - version = "DEC_11", header = FALSE) { - if (!override) { - err <- PMcheck(data, quiet = TRUE) - if (length(grep("FAIL", err)) > 0) { - cli::cli_warn(c("!" = "Write failed; returning errors.")) - return(invisible(err)) - } - } 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, - MAR = 3, - APR = 4, - MAY = 5, - JUN = 6, - JUL = 7, - AUG = 8, - SEP = 9, - OCT = 10, - NOV = 11, - DEC = 12 - ) / 100 - if (versionNum < 11.12) { - if (tolower(names(data)[6]) == "addl") data <- data[, c(-6, -7)] - } - OS <- getOS() - eol <- c("\r\n", "\n", "\r\n")[OS] - f <- file(filename, "w") - if (header) { - writeLines(paste("POPDATA ", version, "\n#", sep = ""), f, sep = "") - } - writeLines(toupper(names(data)[-ncol(data)]), sep = getPMoptions("sep"), f) - writeLines(toupper(names(data)[ncol(data)]), f) - write.table(data, f, - row.names = FALSE, na = ".", quote = F, sep = getPMoptions("sep"), - dec = getPMoptions("dec"), col.names = F, eol = eol - ) - close(f) - return(invisible(err)) + if (!is.null(x$formula)) { + cli::cli_h2("Formula Results") + print(x$formula) } - \ No newline at end of file + cli::cli_text("") + cli::cli_text("{.strong Note:} See {.help summary.PM_data} for more summary options using {.arg formula}.") +} # end function +# WRITE ------------------------------------------------------------------- + +#' @title Write a Pmetrics .csv Matrix File +#' @description +#' `r lifecycle::badge("superseded")` +#' +#' This function is largely superseded as the function is accessed with +#' the `$save()` method for [PM_data] objects. There is rarely a need to call +#' it directly. It is the companion function to [PMreadMatrix]. +#' It will write an appropriate R data object to a formatted .csv file. +#' @details +#' *PMwriteMatrix* will first run [PMcheck] to determine +#' if there are any errors in the structure of `data`. If the error check +#' fails, the file will not be written and a message will be printed on the console. +#' +#' @param data Must be a data.frame with appropriate structure (see [PMcheck]). +#' @param filename Name of file to create. +#' @param override Boolean operator to write even if errors are detected. Default is `FALSE`. +#' @param version Which matrix data format version to write. Default is the current version. +#' @param header Is there a header row? Default is `FALSE` as this was the legacy format. +#' @return Returns the error report (see [PMcheck] for details). +#' @author Michael Neely +#' @seealso [PM_data], [PMcheck], [PMreadMatrix] +#' @export +#' @examples +#' \dontrun{ +#' # write to the current directory +#' NPex$data$save("data.csv") +#' } +PMwriteMatrix <- function( + data, filename, override = FALSE, + version = "DEC_11", header = FALSE) { + if (!override) { + err <- PMcheck(data, quiet = TRUE) + if (length(grep("FAIL", err)) > 0) { + cli::cli_warn(c("!" = "Write failed; returning errors.")) + return(invisible(err)) + } + } 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, + MAR = 3, + APR = 4, + MAY = 5, + JUN = 6, + JUL = 7, + AUG = 8, + SEP = 9, + OCT = 10, + NOV = 11, + DEC = 12 + ) / 100 + if (versionNum < 11.12) { + if (tolower(names(data)[6]) == "addl") data <- data[, c(-6, -7)] + } + OS <- getOS() + eol <- c("\r\n", "\n", "\r\n")[OS] + f <- file(filename, "w") + if (header) { + writeLines(paste("POPDATA ", version, "\n#", sep = ""), f, sep = "") + } + writeLines(toupper(names(data)[-ncol(data)]), sep = getPMoptions("sep"), f) + writeLines(toupper(names(data)[ncol(data)]), f) + write.table(data, f, + row.names = FALSE, na = ".", quote = F, sep = getPMoptions("sep"), + dec = getPMoptions("dec"), col.names = F, eol = eol + ) + close(f) + return(invisible(err)) +} diff --git a/R/PM_model.R b/R/PM_model.R index bbb0da2d6..ccc4bccd0 100644 --- a/R/PM_model.R +++ b/R/PM_model.R @@ -437,25 +437,7 @@ PM_model <- R6::R6Class( "i" = "It must be a filename, list, or current {.code PM_model} object." )) } - } else { # x is NULL, check if other arguments are NULL - named_args <- list( - pri = pri, - cov = cov, - sec = sec, - eqn = eqn, - lag = lag, - fa = fa, - ini = ini, - out = out, - err = err - ) - other_args <- list(...) - all_args <- c(named_args, other_args) - if (all(sapply(all_args, is.null))) { # everything is NULL - self <- build_model() # launch the shiny app - return(invisible(self)) - } - } # no, some arguments were not NULL, so keep going + } msg <- NULL @@ -479,7 +461,7 @@ PM_model <- R6::R6Class( # Get model template name if present (NA if absent) and set type model_template <- get_found_model(self$arg_list$eqn) # function defined below, returns 0 if not found, -1 if error - + # change logic; need to accomodate library models that are ODEs if (length(model_template) > 1 && model_template$analytical) { type <- "Analytical" @@ -736,14 +718,22 @@ PM_model <- R6::R6Class( extra_args <- list(...) + + + if ("quiet" %in% names(extra_args) && extra_args$quiet) { + quiet <- TRUE + } else { + quiet <- FALSE + } + if (!is.null(purrr::pluck(extra_args, "compile"))) { if (extra_args$compile) { - self$compile() + self$compile(quiet) } } else { # default is to compile - self$compile() + self$compile(quiet = quiet) } - }, + }, #' @description #' Print the model summary. @@ -962,6 +952,7 @@ PM_model <- R6::R6Class( #' @param algorithm The algorithm to use for the run. Default is "NPAG" for the **N**on-**P**arametric **A**daptive **G**rid. Alternatives: "NPOD". #' @param report If missing, the default Pmetrics report template as specified in [getPMoptions] #' is used. Otherwise can be "plotly", "ggplot", or "none". + #' @param quiet Boolean operator to suppress messages during the run. Default is `FALSE`. #' @return A successful run will result in creation of a new folder in the working #' directory with the results inside the folder. #' @@ -980,7 +971,8 @@ PM_model <- R6::R6Class( seed = 23, overwrite = FALSE, algorithm = "NPAG", # POSTPROB for posteriors, select when cycles = 0, allow for "NPOD" - report = getPMoptions("report_template")) { + report = getPMoptions("report_template"), + quiet = FALSE) { msg <- NULL # status message at end of run run_error <- 0 @@ -1142,7 +1134,7 @@ PM_model <- R6::R6Class( #### Continue with fit #### # check if model compiled and if not, do so - self$compile() + self$compile(quiet = quiet) intern <- TRUE # always true until (if) rust can run separately from R @@ -1250,7 +1242,7 @@ PM_model <- R6::R6Class( } - if (length(msg) > 1) { + if (length(msg) > 1 & !quiet) { cli::cli_h1("Notes:") cli::cli_ul() purrr::walk(msg[-1], ~ cli::cli_li(.x)) @@ -1319,8 +1311,9 @@ PM_model <- R6::R6Class( #' @param theta A matrix of parameter values to use for the simulation. #' The `theta` matrix should have the same number of columns as the number of primary parameters in the model. #' Each row of `theta` represents a different set of parameter values. + #' @param quiet Logical, if TRUE, suppresses messages during simulation. #' - sim = function(data, theta) { + sim = function(data, theta, quiet = FALSE) { if (!inherits(data, "PM_data")) { cli::cli_abort(c("x" = "Data must be a PM_data object.")) } @@ -1339,7 +1332,7 @@ PM_model <- R6::R6Class( data$save(temp_csv, header = FALSE) if (is.null(self$binary_path)) { - self$compile() + self$compile(quiet = quiet) if (is.null(self$binary_path)) { cli::cli_abort(c("x" = "Model must be compiled before simulating.")) } @@ -1354,9 +1347,9 @@ PM_model <- R6::R6Class( #' This method write the model to a Rust file in a temporary path, #' updates the `binary_path` field for the model, and compiles that #' file to a binary file that can be used for fitting or simulation. - #' If the model is already compiled, the method does nothing. + #' @param quiet Logical, if TRUE, suppresses messages during compilation. #' - compile = function() { + compile = function(quiet = FALSE) { if (!is.null(self$binary_path) && file.exists(self$binary_path)) { # model is compiled return(invisible(NULL)) @@ -1365,28 +1358,23 @@ PM_model <- R6::R6Class( model_path <- file.path(tempdir(), "model.rs") private$write_model_to_rust(model_path) output_path <- tempfile(pattern = "model_", fileext = ".pmx") - cli::cli_inform(c("i" = "Compiling model...")) + if (!quiet) cli::cli_inform(c("i" = "Compiling model...")) # path inside Pmetrics package template_path <- if (Sys.getenv("env") == "Development") { file.path(temporary_path(), "template") } else { system.file(package = "Pmetrics")} - if (file.access(template_path, 0) == -1 | file.access(template_path, 2) == -1){ - cli::cli_abort(c("x" = "Template path {.path {template_path}} does not exist or is not writable.", - "i" = "Please set the template path with {.fn setPMoptions} (choose {.emph Compile Options}), to an existing, writable folder." - )) - } - if (Sys.getenv("env") == "Development") {cat("Using template path:", template_path, "\n")} - tryCatch( - { - compile_model(model_path, output_path, private$get_primary(), template_path, kind = tolower(self$model_list$type)) - self$binary_path <- output_path - }, - error = function(e) { - cli::cli_abort( - c("x" = "Model compilation failed: {e$message}", "i" = "Please check the model file and try again.") - ) - } - ) - - return(invisible(self)) + if (Sys.getenv("env") == "Development") {cat("Using template path:", template_path, "\n")} + tryCatch( + { + compile_model(model_path, output_path, private$get_primary(), template_path, kind = tolower(self$model_list$type)) + self$binary_path <- output_path + }, + error = function(e) { + cli::cli_abort( + c("x" = "Model compilation failed: {e$message}", "i" = "Please check the model file and try again.") + ) + } + ) + + return(invisible(self)) }, # end compile method #' @description #' Save model to file (deprecated). diff --git a/R/PM_sim.R b/R/PM_sim.R index 2c7bc41d6..1f8edbe32 100755 --- a/R/PM_sim.R +++ b/R/PM_sim.R @@ -563,6 +563,23 @@ PM_sim <- R6::R6Class( "i" = "Instead, use {.arg noise}. See {.help PM_sim}." )) } + + # check to make sure any arguments in ... are not misspelled or otherwise unrecognized + allArgs <- formals(PM_sim$public_methods$initialize) %>% names() + # exclude the variadic placeholder from validation + allArgs <- setdiff(allArgs, "...") + dotArgs <- names(dots) + # only validate truly named arguments (non-NA, non-empty names) + dotArgs <- dotArgs[!is.null(dotArgs) & !is.na(dotArgs) & nzchar(dotArgs)] + unrecog <- setdiff(dotArgs, allArgs) + if (length(unrecog) > 0) { + cli::cli_abort(c( + "x" = "The following argument{?s} {?is/are} not recognized: {.val {unrecog}}.", + "i" = "Check for case errors or misspellings. Refer to {.help PM_sim} for a list of valid arguments." + )) + } + + if (missing(poppar)) { cli::cli_abort(c( @@ -803,7 +820,7 @@ PM_sim <- R6::R6Class( ) return(self) - }, # end initialize + }, # end initialize #' #' @description #' `r lifecycle::badge("stable")` @@ -914,7 +931,7 @@ PM_sim <- R6::R6Class( ###### POPPAR - npar <- length(poppar$popMean) + npar <- if (useTheta) {ncol(poppar$popPoints) - 1} else {length(poppar$popMean)} @@ -1140,7 +1157,7 @@ PM_sim <- R6::R6Class( # get SD of covariates - covSD <- CVsum %>% summarize(across(last_col(offset = nsimcov - 1):last_col(), sd, na.rm = TRUE)) + covSD <- CVsum %>% summarize(across(last_col(offset = nsimcov - 1):last_col(), \(x) sd(x, na.rm = TRUE))) # grab their names covs2sim <- names(covSD) @@ -1162,7 +1179,7 @@ PM_sim <- R6::R6Class( dimnames(covMat) <- dimnames(corMat) # get means of covariates - covMean <- CVsum %>% summarize(across(covs2sim, mean, na.rm = TRUE)) + covMean <- CVsum %>% summarize(across(covs2sim, \(x) mean(x, na.rm = TRUE))) # set means of named variables, and use population values for others if (length(covariate$mean) > 0) { @@ -1181,9 +1198,9 @@ PM_sim <- R6::R6Class( meanVector <- poppar$popMean %>% tibble::add_column(!!!as.list(covMean)) # get the covariate limits # get min of original population covariates - covMin <- CVsum %>% summarize(across(covs2sim, min, na.rm = TRUE)) + covMin <- CVsum %>% summarize(across(covs2sim, \(x) min(x, na.rm = TRUE))) # and get max of original population covariates - covMax <- CVsum %>% summarize(across(covs2sim, max, na.rm = TRUE)) + covMax <- CVsum %>% summarize(across(covs2sim, \(x) max(x, na.rm = TRUE))) orig_covlim <- tibble::tibble(par = covs2sim, min = unlist(covMin), max = unlist(covMax)) covLimits <- orig_covlim @@ -1302,7 +1319,12 @@ PM_sim <- R6::R6Class( template <- PM_data$new(template, quiet = TRUE) - mod <- PM_model$new(arg_list) # now we compile + if (simWithCov) { # if simulating with covariates, we need to recompile the model with the new covariates + if (!quiet) cli::cli_inform("Recompiling model to include covariates...") + mod <- PM_model$new(arg_list, quiet = TRUE) # + } else { + mod <- model + } if (length(postToUse) > 0) { # simulating from posteriors, each posterior matched to a subject diff --git a/R/PMoptions.R b/R/PMoptions.R index 13e96cbbf..391556520 100755 --- a/R/PMoptions.R +++ b/R/PMoptions.R @@ -89,12 +89,54 @@ setPMoptions <- function(launch.app = TRUE) { fs::dir_create(opt_dir) # ensure directory exists PMoptionsUserFile <- file.path(opt_dir, "PMoptions.json") - - # If file doesn't exist in user space, copy default - if (!fs::file_exists(PMoptionsUserFile)) { - PMoptionsFile <- glue::glue(system.file("options", package = "Pmetrics"), "/PMoptions.json") - fs::file_copy(PMoptionsFile, PMoptionsUserFile, overwrite = TRUE) + + PMoptionsDefaultsFile <- file.path(system.file("options", package = "Pmetrics"), "PMoptions.json") + + sync_pmoptions <- function() { + default_opts <- tryCatch( + jsonlite::fromJSON(PMoptionsDefaultsFile, simplifyVector = TRUE), + error = function(e) list() + ) + + user_opts <- if (fs::file_exists(PMoptionsUserFile)) { + tryCatch(jsonlite::fromJSON(PMoptionsUserFile, simplifyVector = TRUE), error = function(e) list()) + } else { + list() + } + + # Apply locale-aware default for date format when missing + lc <- Sys.getlocale("LC_TIME") + locale_date <- if (grepl("en_US", lc, fixed = TRUE)) "%m/%d/%y" else "%d/%m/%y" + if (is.null(user_opts$date_format) || is.na(user_opts$date_format) || !nzchar(user_opts$date_format)) { + default_opts$date_format <- locale_date + } + + # Keep only current defaults; fill missing values from defaults + synced_opts <- default_opts + shared_names <- intersect(names(default_opts), names(user_opts)) + for (nm in shared_names) { + synced_opts[[nm]] <- user_opts[[nm]] + } + + # Validate update settings + valid_update_check <- c("manual", "never", "daily", "weekly", "monthly") + update_check <- tolower(as.character(synced_opts$update_check)) + if (!(update_check %in% valid_update_check)) { + update_check <- "weekly" + } + synced_opts$update_check <- update_check + + update_timeout <- suppressWarnings(as.numeric(synced_opts$update_timeout)) + if (!is.finite(update_timeout) || update_timeout <= 0) { + update_timeout <- 1 + } + synced_opts$update_timeout <- update_timeout + + jsonlite::write_json(synced_opts, PMoptionsUserFile, pretty = TRUE, auto_unbox = TRUE) + synced_opts } + + opts <- sync_pmoptions() app <- shiny::shinyApp( @@ -160,6 +202,18 @@ setPMoptions <- function(launch.app = TRUE) { selected = "." ) ) + ), + shiny::selectInput( + "date_format", + bslib::tooltip( + shiny::tags$span("Date format", shiny::icon("circle-question", class = "ms-1 text-muted")), + "Date format used to parse date-time strings, e.g. the 'start' argument in BestDose" + ), + choices = c( + "MM/DD/YY \u2014 United States" = "%m/%d/%y", + "DD/MM/YY \u2014 International" = "%d/%m/%y" + ), + selected = "%m/%d/%y" ) ) ), @@ -206,6 +260,44 @@ setPMoptions <- function(launch.app = TRUE) { selected = "plotly" ) ) + ), + + # Update Notifications Card + bslib::card( + class = "mb-3", + bslib::card_header( + class = "bg-primary text-white", + shiny::icon("bell", class = "me-2"), + "Update Notifications" + ), + bslib::card_body( + shiny::selectInput( + "update_check", + bslib::tooltip( + shiny::tags$span("Startup check frequency", shiny::icon("circle-question", class = "ms-1 text-muted")), + "How often Pmetrics should check for R/Pmetrics updates when the package is attached" + ), + choices = c( + "Manual only" = "manual", + "Never" = "never", + "Daily" = "daily", + "Weekly" = "weekly", + "Monthly" = "monthly" + ), + selected = "weekly" + ), + shiny::numericInput( + "update_timeout", + bslib::tooltip( + shiny::tags$span("Network timeout (seconds)", shiny::icon("circle-question", class = "ms-1 text-muted")), + "Maximum seconds spent on automatic startup update checks" + ), + value = 1, + min = 1, + max = 30, + step = 1 + ) + ) ) ), # end left column @@ -379,6 +471,9 @@ setPMoptions <- function(launch.app = TRUE) { if (!is.null(settings$digits)) shiny::updateNumericInput(session, "digits", value = settings$digits) if (!is.null(settings$report_template)) shiny::updateSelectInput(session, "report_template", selected = settings$report_template) if (!is.null(settings$ic_method)) shiny::updateSelectInput(session, "ic_method", selected = settings$ic_method) + if (!is.null(settings$date_format)) shiny::updateSelectInput(session, "date_format", selected = settings$date_format) + if (!is.null(settings$update_check)) shiny::updateSelectInput(session, "update_check", selected = settings$update_check) + if (!is.null(settings$update_timeout)) shiny::updateNumericInput(session, "update_timeout", value = settings$update_timeout) # Bias/imprecision methods - strip percent_ prefix for display if (!is.null(settings$bias_method)) { @@ -419,7 +514,8 @@ setPMoptions <- function(launch.app = TRUE) { }) |> shiny::bindEvent( input$sep, input$dec, input$digits, input$show_metrics, input$bias_method, input$imp_method, input$use_percent, - input$ic_method, input$report_template, + input$ic_method, input$report_template, input$date_format, + input$update_check, input$update_timeout, ignoreInit = TRUE ) @@ -459,7 +555,10 @@ setPMoptions <- function(launch.app = TRUE) { bias_method = glue::glue(c("", "percent_")[1 + as.numeric(input$use_percent)], input$bias_method), imp_method = glue::glue(c("", "percent_")[1 + as.numeric(input$use_percent)], input$imp_method), ic_method = input$ic_method, - report_template = input$report_template + report_template = input$report_template, + date_format = input$date_format, + update_check = input$update_check, + update_timeout = as.numeric(input$update_timeout) # backend = input$backend, # model_template_path = input$model_template_path ) @@ -541,6 +640,14 @@ setPMoptions <- function(launch.app = TRUE) { if(launch.app){ shiny::runApp(app, launch.browser = TRUE) } + + # Re-sync in case app/user edits introduced missing or obsolete keys + opts <- sync_pmoptions() + + pm_option_values <- unname(as.list(opts)) + names(pm_option_values) <- paste0("Pmetrics.", names(opts)) + do.call(options, pm_option_values) + options(Pmetrics.user_options = opts) return(invisible(NULL)) diff --git a/R/PMutilities.R b/R/PMutilities.R index 9fbf7c7fe..ddd16b102 100755 --- a/R/PMutilities.R +++ b/R/PMutilities.R @@ -1446,38 +1446,82 @@ wtd.var <- function(x, weights = NULL, cli_df <- function(df) { highlight <- attr(df, "highlight") # get columns to highlight minimums from attributes + has_highlight <- !is.null(highlight) && !identical(highlight, FALSE) + resolve_cols <- function(spec, names_df) { + if (is.null(spec)) return(character(0)) + if (is.numeric(spec)) return(names_df[spec]) + if (is.character(spec)) return(spec[spec %in% names_df]) + character(0) + } + # Convert all columns to character for uniform formatting df_chr <- df %>% mutate(across(where(is.double), ~round2(.x))) %>% mutate(across(everything(), ~as.character(.x, stringsAsFactors = FALSE))) - - if (highlight){ # highlight minimums in requested columns - # first replace minima with special formatting - # mins <- df %>% summarize(across(c(-run, -nvar, -converged, -pval, -best), ~round2(min(.x, na.rm = TRUE)))) # get minima for each column - mins <- df %>% summarize(across(c(-run, -nvar, -converged, -pval, -best), ~ which(.x == min(.x, na.rm = TRUE)))) %>% unlist() # get minima for each column - - best <- df %>% summarize(across(best, ~ which(.x == max(.x, na.rm = TRUE)))) %>% unlist() # get best for best column + + if (has_highlight){ # highlight best in requested columns + metric_cols <- character(0) + best_col <- character(0) + + if (is.list(highlight)) { + metric_cols <- resolve_cols(highlight$metric_cols, names(df)) + best_col <- resolve_cols(highlight$best_col, names(df)) + } else if (isTRUE(highlight)) { + metric_cols <- names(df)[vapply(df, is.numeric, logical(1))] + } else { + metric_cols <- resolve_cols(highlight, names(df)) + } + metric_cols <- setdiff(metric_cols, best_col) + + metric_best <- purrr::map(metric_cols, function(col) { + x_num <- suppressWarnings(as.numeric(df[[col]])) + valid <- which(!is.na(x_num)) + if (length(valid) == 0) return(integer(0)) + target <- ifelse(grepl("Sl|R2", col), 1, 0) + valid[which(abs(x_num[valid] - target) == min(abs(x_num[valid] - target)))] + }) + names(metric_best) <- metric_cols + + best_best <- NA_integer_ + if (length(best_col) == 1) { + x_num <- suppressWarnings(as.numeric(df[[best_col]])) + valid <- which(!is.na(x_num)) + if (length(valid) > 0) { + best_best <- valid[which.max(x_num[valid])] + } + } + + + # create table to get the spacing df_tab <- knitr::kable(df_chr, format = "simple") - + # rebuild the data frame df2 <- map_vec(df_tab, \(x) str_split(x, "(?<=\\s)(?=\\S)")) df2 <- as.data.frame(do.call(rbind, df2)) - - # replace minima with highlighted versions + + # replace best with highlighted versions # first 2 rows are headers and spacers, so need to add 2 to the mins row index - for (p in 1:length(mins)){ - df2[mins[p]+2, p+3] <- stringr::str_replace_all(df2[mins[p]+2, p+3], "(\\d+(?:\\.\\d+)?)(\\s+)", "{.red \\1}\\2") + for (p in seq_along(metric_best)){ + row_idx <- metric_best[[p]] + col_name <- names(metric_best)[p] + col_idx <- match(col_name, names(df_chr)) + if (length(row_idx) > 0 && !is.na(col_idx)) { + for (r in row_idx) { + df2[r + 2, col_idx] <- stringr::str_replace_all(df2[r + 2, col_idx], "(-?\\d+(?:\\.\\d+)?)(\\s+)", "{.red \\1}\\2") + } + } } - - # for(p in 1:length(mins)){ - # df2[, p+3] <- stringr::str_replace_all(df2[, p+3], as.character(mins[p]), paste0("{.strong ", as.character(mins[p]), "}")) - # } - # df2$V18 <- stringr::str_replace(df2$V18, as.character(best), paste0("{.red ", as.character(best), "}")) - df2$V17[best+2] <- stringr::str_replace(df2$V17[best+2], "(\\d+(?:\\.\\d+)?)(\\s+)", "{.red \\1}\\2") - + + if (!is.na(best_best) && length(best_col) == 1) { + best_col_idx <- match(best_col, names(df_chr)) + if (!is.na(best_col_idx)) { + df2[best_best + 2, best_col_idx] <- stringr::str_replace_all(df2[best_best + 2, best_col_idx], "(-?\\d+(?:\\.\\d+)?)(\\s+)", "{.red \\1}\\2") + } + } + # print header header <- df2[1,] %>% stringr::str_replace_all(" ", "\u00A0" ) %>% paste(collapse = "") cli::cli_text("{.strong {header}}") @@ -1496,17 +1540,17 @@ wtd.var <- function(x, weights = NULL, } cli::cli_end() } else { # no highlighting - + # create table df_tab <- knitr::kable(df_chr, format = "simple") - + # print header header <- df_tab[1] %>% stringr::str_replace_all(" ", "\u00A0" ) cli::cli_text("{.strong {header}}") - + # print each row for (i in 2:length(df_tab)) { - cli::cli_text(df_tab[i] %>% stringr::str_replace_all(" ", "\u00A0" )) + cli::cli_text(df_tab[i] %>% stringr::str_replace_all(" ", "\u00A0" )) } } @@ -1652,3 +1696,231 @@ modifyList2 <- function (x, val, keep.null = FALSE) clear_build <- function(){ fs::dir_delete(system.file("template", package = "Pmetrics")) } + + +#' @title Get latest platform-specific R release metadata +#' @description +#' `r lifecycle::badge("stable")` +#' Retrieves metadata for the latest R release available for the current +#' platform from the r-hub rversions API. +#' @return A list containing all fields returned by the API response. +#' @export +latestR <- function() { + sysname <- tolower(Sys.info()[["sysname"]]) + r_arch <- tolower(R.version$arch) + r_release_endpoint <- switch( + sysname, + windows = "r-release-win", + darwin = if (grepl("arm64|aarch64", r_arch)) "r-release-macos-arm64" else "r-release-macos", + linux = "r-release-tarball", + "r-release" + ) + + jsonlite::fromJSON(sprintf("https://api.r-hub.io/rversions/%s", r_release_endpoint)) +} + + +pm_updates_cache_file <- function() { + file.path(tools::R_user_dir("Pmetrics", which = "cache"), "updates.rds") +} + + +pm_read_updates_cache <- function() { + cache_file <- pm_updates_cache_file() + if (!file.exists(cache_file)) { + return(NULL) + } + + tryCatch(readRDS(cache_file), error = function(e) NULL) +} + + +pm_write_updates_cache <- function(result) { + cache_file <- pm_updates_cache_file() + cache_dir <- dirname(cache_file) + if (!dir.exists(cache_dir)) { + dir.create(cache_dir, recursive = TRUE) + } + + tryCatch(saveRDS(result, cache_file), error = function(e) invisible(NULL)) + invisible(result) +} + + +pm_update_interval_days <- function() { + mode <- getPMoptions("update_check", warn = FALSE, quiet = TRUE) + if (is.null(mode)) { + mode <- getOption("Pmetrics.update_check", "weekly") + } + mode <- tolower(as.character(mode)) + + switch( + mode, + always = 0, + daily = 1, + weekly = 7, + monthly = 30, + manual = Inf, + never = Inf, + Inf + ) +} + + +pm_notify_outdated <- function(result) { + if (is.null(result)) { + return(invisible(NULL)) + } + + pmetrics_outdated <- isTRUE(result$pmetrics_outdated) + r_outdated <- isTRUE(result$r_outdated) + + if (!pmetrics_outdated && !r_outdated) { + return(invisible(NULL)) + } + + ul <- cli::cli_ul() + + if (pmetrics_outdated) { + cli::cli_li("{.red Update available:} Pmetrics {result$latest_pmetrics} (installed: {result$installed_pmetrics}).") + } + + if (r_outdated) { + cli::cli_li("{.red Update available:} R {result$latest_r} (installed: {result$current_r}). Use {.help downloadR}.") + } + + cli::cli_end(ul) + invisible(result) +} + + +pm_maybe_notify_updates <- function() { + if (!interactive()) { + return(invisible(NULL)) + } + + cache <- pm_read_updates_cache() + interval_days <- pm_update_interval_days() + + needs_refresh <- is.null(cache) || + is.null(cache$checked_at) || + (is.finite(interval_days) && + as.numeric(difftime(Sys.time(), cache$checked_at, units = "days")) >= interval_days) + + if (is.finite(interval_days) && isTRUE(needs_refresh)) { + timeout <- getPMoptions("update_timeout", warn = FALSE, quiet = TRUE) + if (is.null(timeout)) { + timeout <- getOption("Pmetrics.update_timeout", 1) + } + cache <- tryCatch(check_updates(verbose = FALSE, timeout = timeout), error = function(e) cache) + } + + pm_notify_outdated(cache) + invisible(cache) +} + + +#' @title Check for Pmetrics and R updates +#' @description +#' `r lifecycle::badge("stable")` +#' Performs an on-demand check for newer Pmetrics and R releases. +#' This function is intended for interactive use and avoids running network +#' checks automatically during package attach. +#' @param verbose Logical. If `TRUE`, emits a user-facing CLI summary. +#' @param timeout Numeric scalar. Network timeout in seconds used for this check. +#' @return An invisible list with installed/latest versions and outdated flags. +#' @export +check_updates <- function(verbose = interactive(), timeout = 2) { + timeout <- as.numeric(timeout) + if (!is.finite(timeout) || timeout <= 0) { + timeout <- 2 + } + + old_timeout <- getOption("timeout") + on.exit(options(timeout = old_timeout), add = TRUE) + options(timeout = timeout) + + installed_pmetrics <- packageVersion("Pmetrics") + latest_pmetrics <- tryCatch( + package_version( + jsonlite::fromJSON("https://lapkb.r-universe.dev/api/packages/Pmetrics")$Version + ), + error = function(e) NA + ) + + current_r <- getRversion() + latest_r_info <- tryCatch(latestR(), error = function(e) NULL) + latest_r <- if (!is.null(latest_r_info) && !is.null(latest_r_info$version)) { + package_version(latest_r_info$version) + } else { + NA + } + + pmetrics_outdated <- !is.na(latest_pmetrics) && installed_pmetrics < latest_pmetrics + r_outdated <- !is.na(latest_r) && current_r < latest_r + + result <- list( + installed_pmetrics = installed_pmetrics, + latest_pmetrics = latest_pmetrics, + pmetrics_outdated = pmetrics_outdated, + current_r = current_r, + latest_r = latest_r, + r_outdated = r_outdated, + checked_at = Sys.time() + ) + + pm_write_updates_cache(result) + + if (isTRUE(verbose)) { + ul <- cli::cli_ul() + + if (is.na(latest_pmetrics)) { + cli::cli_li("Unable to check latest Pmetrics version (network unavailable or endpoint unreachable).") + } else if (pmetrics_outdated) { + cli::cli_li("{.red Warning:} Your Pmetrics version ({installed_pmetrics}) is older than the latest release ({latest_pmetrics}). Update instructions are at https://github.com/LAPKB/Pmetrics.") + } else { + cli::cli_li("You are using the latest Pmetrics version: {installed_pmetrics}.") + } + + if (is.na(latest_r)) { + cli::cli_li("Unable to check latest R version (network unavailable or endpoint unreachable).") + } else if (r_outdated) { + cli::cli_li("{.red Warning:} Your R version ({current_r}) is older than the latest release ({latest_r}). Use {.help downloadR} to download the latest platform-specific installer.") + } else { + cli::cli_li("You are using the latest R version: {current_r}.") + } + + cli::cli_end(ul) + } + + invisible(result) +} + + +#' @title Download the latest platform-specific R installer +#' @description +#' `r lifecycle::badge("stable")` +#' Downloads the latest R installer (or source tarball on Linux) for the current +#' platform to the user's Downloads folder. +#' @param r_info Optional API response list. Defaults to [latestR()]. +#' @param destdir Destination directory. Defaults to the user's Downloads folder. +#' @return The file path of the downloaded installer/tarball. +#' @export +downloadR <- function(r_info = latestR(), destdir = path.expand("~/Downloads")) { + download_url <- r_info$URL + if (is.null(download_url) || length(download_url) == 0 || is.na(download_url)) { + download_url <- r_info$url + } + + if (is.null(download_url) || length(download_url) == 0 || is.na(download_url)) { + cli::cli_abort("No downloadable URL was returned by the rversions API for this platform.") + } + + if (!dir.exists(destdir)) { + dir.create(destdir, recursive = TRUE) + } + + destfile <- file.path(destdir, basename(download_url)) + utils::download.file(download_url, destfile = destfile, mode = "wb") + destfile +} diff --git a/R/model_transpiler.R b/R/model_transpiler.R index c4f78d941..d700ba7d0 100755 --- a/R/model_transpiler.R +++ b/R/model_transpiler.R @@ -243,21 +243,34 @@ expr_to_rust <- function(expr, params = NULL, covs = NULL, # map model name from R to rust rust_tem <- dplyr::case_when( tem == "one_comp_iv" ~ "one_compartment", - tem == "one_comp_iv_cl" ~ "", # TBD in rust + tem == "one_comp_iv_cl" ~ "CL", # TBD in rust tem == "two_comp_iv" ~ "two_compartments", - tem == "two_comp_iv_cl" ~ "", # TBD in rust + tem == "two_comp_iv_cl" ~ "CL", # TBD in rust tem == "two_comp_bolus" ~ "one_compartment_with_absorption", - tem == "two_comp_bolus_cl" ~ "", # TBD in rust + tem == "two_comp_bolus_cl" ~ "CL", # TBD in rust tem == "three_comp_iv" ~ "three_compartments", # TBD in R tem == "three_comp_iv_cl" ~ "", # TBD in rust tem == "three_comp_bolus" ~ "two_compartments_with_absorption", - tem == "three_comp_bolus_cl" ~ "", # TBD in rust + tem == "three_comp_bolus_cl" ~ "CL", # TBD in rust tem == "four_comp_bolus" ~ "three_compartments_with_absorption", # TBD in R - tem == "four_comp_bolus_cl" ~ "" # TBD in rust + tem == "four_comp_bolus_cl" ~ "CL", # TBD in rust + .default = "" ) - + if (rust_tem == "CL") { + cli::cli_abort(c( + "x" = "Clearance models are not yet supported in Rust.", + "i" = "Re-parameterize as a Ke model template or use ODEs directly in the EQN block." + )) + } else if (rust_tem == "") { + cli::cli_abort(c( + "x" = "Model template not recognized or not supported in Rust.", + "i" = "Supported templates: one_comp_iv, two_comp_iv, two_comp_bolus, three_comp_iv, three_comp_bolus, four_comp_bolus.", + "i" = "See {.fn model_lib} for details on supported templates." + )) + } + header <- sprintf( - " %s,\n |p, t, cov| {\n fetch_cov!(cov, t, %s);\n fetch_params!(&p, %s);", + " %s ,\n |p, t, cov| {\n fetch_cov!(cov, t, %s);\n fetch_params!(&p, %s);", rust_tem, paste(covs, collapse = ", "), paste(params, collapse = ", ") diff --git a/R/zzz.R b/R/zzz.R index 3a7e62c4a..2ef56a61e 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,20 +1,13 @@ .onAttach <- function(...) { if (interactive()) { installedVersion <- packageVersion("Pmetrics") - + # Check Rust installation rustcVersion <- tryCatch( system("rustc --version", intern = TRUE), error = function(e) NA ) - - # Check R version - currentR <- getRversion() - latestR <- tryCatch(package_version( - jsonlite::fromJSON("https://api.r-hub.io/rversions/r-release")$version - ), error = function(e) NA) - - + cli::cli_div(theme = list(span.red = list(color = "red", "font-weight" = "bold"))) cli::cli_h2("Welcome to Pmetrics {installedVersion}!") ul <- cli::cli_ul() @@ -22,19 +15,14 @@ cli::cli_li("For {.strong documentation}, use {.help PM_manual}.") cli::cli_li("View user {.strong options} with {.help setPMoptions}.") cli::cli_li("Model library loaded. View with {.help model_lib}.") - if (!is.na(latestR)){ - if(currentR < latestR) { - cli::cli_li("{.red Warning:} Your R version ({currentR}) is older than the latest release ({latestR}). Consider updating: https://cran.r-project.org.") - } else { - cli::cli_li("You are using the latest R version: {currentR}.") - } - } + cli::cli_li("Check for Pmetrics and R updates with {.help check_updates}.") if (is.na(rustcVersion) || length(rustcVersion) == 0) { cli::cli_li("{.red Warning:} Rust compiler not found. Please install Rust from https://www.rust-lang.org/tools/install") } else { cli::cli_li("Installed Rust version: {rustcVersion}") } cli::cli_end(ul) + pm_maybe_notify_updates() } diff --git a/_pkgdown.yml b/_pkgdown.yml index 47770eb84..fb45a2af4 100755 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -120,6 +120,10 @@ reference: - PMtest - PM_tutorial - setPMoptions + - check_updates + - latestR + - downloadR + - title: Internal desc: Internal and low-level functions - contents: diff --git a/data-raw/data-raw.R b/data-raw/data-raw.R index f772af6e7..8bfc2ef7b 100755 --- a/data-raw/data-raw.R +++ b/data-raw/data-raw.R @@ -87,7 +87,7 @@ usethis::use_data(badData, overwrite = T) # do the run # NPAG -run1 <- modEx$fit(data = dataEx, path = file.path(wd, "Runs"), run = 1, overwrite = TRUE) +run1 <- modEx$fit(data = dataEx, path = file.path(wd, "Runs"), run = 1, overwrite = TRUE, report = "none") NPex <- PM_load(path = file.path(wd, "Runs"), run = 1) # NPex$validate(limits = NA) diff --git a/data/NPex.rda b/data/NPex.rda index 1fba3609b..86262f4c8 100755 Binary files a/data/NPex.rda and b/data/NPex.rda differ diff --git a/data/dataEx.rda b/data/dataEx.rda index 139c722d0..7fec075d9 100755 Binary files a/data/dataEx.rda and b/data/dataEx.rda differ diff --git a/data/modEx.rda b/data/modEx.rda index afb126a3c..0031500e6 100755 Binary files a/data/modEx.rda and b/data/modEx.rda differ diff --git a/data/simEx.rda b/data/simEx.rda index 85d646f49..6b280e530 100755 Binary files a/data/simEx.rda and b/data/simEx.rda differ diff --git a/inst/options/PMoptions.json b/inst/options/PMoptions.json index 9772c9d49..863b7b91b 100755 --- a/inst/options/PMoptions.json +++ b/inst/options/PMoptions.json @@ -7,6 +7,9 @@ "imp_method": "percent_rmbawse", "ic_method": "aic", "report_template": "plotly", + "date_format": "%m/%d/%y", + "update_check": "weekly", + "update_timeout": 1, "backend": "rust", "model_template_path": "" } diff --git a/inst/report/templates/bestdose.Rmd b/inst/report/templates/bestdose.Rmd new file mode 100644 index 000000000..60b2e5a5a --- /dev/null +++ b/inst/report/templates/bestdose.Rmd @@ -0,0 +1,617 @@ +--- +title: "`r params$title`" +author: "Laboratory of Applied Pharmacokinetics and Bioinformatics (LAPKB)" +date: "`r Sys.Date()`" +output: + html_document: + toc: false +params: + bd: null + title: "BestDose Report" +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE) +library(Pmetrics) +library(dplyr) +library(DT) +library(htmltools) + +obj <- params$bd +report <- Pmetrics:::bd_report_build(obj) +digits <- getPMoptions("digits") +if (is.null(digits) || length(digits) == 0 || is.na(digits)) digits <- 2 +date_fmt <- getPMoptions("date_format", warn = FALSE, quiet = TRUE) +if (!is.character(date_fmt) || length(date_fmt) != 1 || !nzchar(date_fmt)) { + date_fmt <- if (grepl("en_US", Sys.getlocale("LC_TIME"), fixed = TRUE)) "%m/%d/%y" else "%d/%m/%y" +} +fmt_num <- function(x) { + if (is.numeric(x)) round(x, digits) else x +} + +parse_dt_col <- function(x) { + suppressWarnings(as.POSIXct(x, tz = Sys.timezone())) +} + +fmt_date_col <- function(x) { + dt <- parse_dt_col(x) + ifelse(is.na(dt), as.character(x), format(dt, date_fmt)) +} + +fmt_time_col <- function(x) { + dt <- parse_dt_col(x) + ifelse(is.na(dt), NA_character_, format(dt, "%H:%M:%S")) +} + +fmt_datetime_col <- function(x) { + d <- fmt_date_col(x) + t <- fmt_time_col(x) + ifelse(is.na(t), d, paste(d, t)) +} + +resize_plot <- function(p, scale = 0.8, base_height = 450, square = FALSE, no_title = FALSE, bottom_margin = NULL) { + if (is.null(p)) return(NULL) + h <- as.integer(base_height * scale) + p <- if (square) plotly::layout(p, height = h, width = h) else plotly::layout(p, height = h) + if (no_title) p <- plotly::layout(p, title = list(text = "")) + if (!is.null(bottom_margin)) p <- plotly::layout(p, margin = list(b = bottom_margin)) + p +} + +render_dt <- function(x, page_length = 10) { + if (is.null(x) || nrow(x) == 0) { + return("None") + } + if ("datetime" %in% names(x)) { + x <- x |> + dplyr::mutate(datetime = fmt_datetime_col(datetime)) + } + x <- x |> mutate(across(where(is.numeric), fmt_num)) + DT::datatable( + x, + rownames = FALSE, + options = list( + pageLength = page_length, + lengthChange = FALSE, + searching = FALSE, + info = FALSE, + autoWidth = TRUE + ) + ) +} +render_dose_table <- function(doses) { + if (is.null(doses) || nrow(doses) == 0) return("None") + status_vals <- if ("status" %in% names(doses)) doses$status else rep(NA_character_, nrow(doses)) + df <- doses |> + dplyr::mutate( + Date = fmt_date_col(datetime), + Time = fmt_time_col(datetime), + `Relative Hours` = time, + Dose = dose, + Route = dplyr::if_else(is.na(dur) | dur == 0, "Bolus", paste0("Infusion, ", dur, " hours")), + Status = status_vals + ) |> + dplyr::select(Date, Time, `Relative Hours`, Dose, Route, Status) + + render_dt(df, page_length = 10) +} +render_metrics <- function(x) { + if (is.null(x$metric_info)) { + return("None") + } + metric_vals <- x$metric_info$metric_vals + if (stringr::str_detect(getPMoptions("bias_method"), "percent_")) { + metric_vals <- metric_vals |> + mutate(across(everything(), ~ paste0(fmt_num(.x), "%"))) + } else { + metric_vals <- metric_vals |> + mutate(across(everything(), fmt_num)) + } + + tibble::tibble( + Metric = c(x$metric_info$metric_types$bias, x$metric_info$metric_types$imprecision), + Value = c(metric_vals$Bias, metric_vals$Imprecision) + ) |> + DT::datatable( + rownames = FALSE, + options = list(dom = "t", paging = FALSE, searching = FALSE, info = FALSE) + ) +} + +render_percent_metrics <- function(x) { + if (is.null(x$pe) || nrow(x$pe) == 0) { + return("None") + } + + bias_method <- stringr::str_replace(getPMoptions("bias_method"), "^percent_", "") + imp_method <- stringr::str_replace(getPMoptions("imp_method"), "^percent_", "") + + bias_val <- x$pe |> + dplyr::filter(type == bias_method) |> + dplyr::pull(percent) + imp_val <- x$pe |> + dplyr::filter(type == imp_method) |> + dplyr::pull(percent) + + bias_val <- if (length(bias_val) == 0) NA_real_ else bias_val[1] + imp_val <- if (length(imp_val) == 0) NA_real_ else imp_val[1] + + tibble::tibble( + Metric = c("%Bias", "%Imprecision"), + Value = c(paste0(fmt_num(bias_val), "%"), paste0(fmt_num(imp_val), "%")) + ) |> + DT::datatable( + rownames = FALSE, + width = "auto", + options = list(dom = "t", paging = FALSE, searching = FALSE, info = FALSE) + ) +} + +render_fit_table <- function(fit_tbl, page_length = 10) { + if (is.null(fit_tbl) || nrow(fit_tbl) == 0) { + return("None") + } + + has_datetime <- "datetime" %in% names(fit_tbl) + + tbl <- fit_tbl |> + dplyr::mutate( + Date = if (has_datetime) fmt_date_col(datetime) else NA_character_, + Time = if (has_datetime) fmt_time_col(datetime) else NA_character_, + `Relative Time` = time, + Observed = obs, + Predicted = pred, + Error = pred - obs, + `%Error` = (pred - obs) / obs * 100 + ) |> + dplyr::select(Date, Time, `Relative Time`, Observed, Predicted, Error, `%Error`) + + render_dt(tbl, page_length = page_length) +} + +render_auc_table <- function(auc_tbl, page_length = 10) { + if (is.null(auc_tbl) || nrow(auc_tbl) == 0) { + return("None") + } + + has_datetime <- "datetime" %in% names(auc_tbl) + + tbl <- auc_tbl |> + dplyr::mutate( + Number = dplyr::row_number(), + Date = if (has_datetime) fmt_date_col(datetime) else NA_character_, + Time = if (has_datetime) fmt_time_col(datetime) else NA_character_, + Hours = time, + Amount = dose, + `Post-dose` = postdose_auc, + `Cumulative` = cumulative_auc, + .source = source + ) |> + dplyr::select(Number, Date, Time, Hours, Amount, `Post-dose`, `Cumulative`, .source) |> + dplyr::mutate(across(c(Hours, Amount, `Post-dose`, `Cumulative`), fmt_num)) + + hdr <- htmltools::withTags(table( + class = 'display', + thead( + tr( + th(colspan = 5, style = "text-align:center; background:#f1f3f5; border-bottom:1px solid #d9d9d9;", "Dose"), + th(colspan = 2, style = "text-align:center; background:#e8f1ff; border-left:2px solid #9bbcff; border-bottom:1px solid #d9d9d9;", "AUC"), + th(style = "display:none;", "") + ), + tr( + th(style = "background:#f8f9fa;", "Number"), + th(style = "background:#f8f9fa;", "Date"), + th(style = "background:#f8f9fa;", "Time"), + th(style = "background:#f8f9fa;", "Hours"), + th(style = "background:#f8f9fa;", "Amount"), + th(style = "background:#f1f6ff; border-left:2px solid #9bbcff;", "Post-dose"), + th(style = "background:#f1f6ff;", "Cumulative"), + th("") + ) + ) + )) + + DT::datatable( + tbl, + container = hdr, + class = "compact nowrap", + width = "auto", + rownames = FALSE, + options = list( + pageLength = page_length, + lengthChange = FALSE, + searching = FALSE, + info = FALSE, + autoWidth = FALSE, + columnDefs = list( + list(visible = FALSE, targets = 7) + ) + ) + ) |> + DT::formatStyle( + c("Number", "Date", "Time", "Hours", "Amount"), + backgroundColor = "#fbfbfb" + ) |> + DT::formatStyle( + c("Post-dose", "Cumulative"), + backgroundColor = "#f5f9ff" + ) |> + DT::formatStyle( + "Post-dose", + borderLeft = "2px solid #9bbcff" + ) |> + DT::formatStyle( + ".source", + target = "row", + color = DT::styleEqual(c("Past", "Future"), c("black", "red")) + ) +} + +render_auc_plot <- function(auc_tbl, auc_plot = NULL) { + if (!is.null(auc_plot)) { + return(resize_plot(auc_plot, scale = 0.9)) + } + if (is.null(auc_tbl) || nrow(auc_tbl) == 0) { + return("No AUC plot available.") + } + + has_datetime <- "datetime" %in% names(auc_tbl) + if (!has_datetime) { + return("No AUC plot available.") + } + + date_fmt <- getPMoptions("date_format", warn = FALSE, quiet = TRUE) + if (!is.character(date_fmt) || length(date_fmt) != 1 || !nzchar(date_fmt)) { + date_fmt <- if (grepl("en_US", Sys.getlocale("LC_TIME"), fixed = TRUE)) "%m/%d/%y" else "%d/%m/%y" + } + + df <- auc_tbl |> + dplyr::mutate( + datetime = suppressWarnings(as.POSIXct(datetime, tz = Sys.timezone())), + dose_idx = dplyr::row_number(), + dose_amt = ifelse(is.na(dose), NA_character_, formatC(as.numeric(dose), format = "f", digits = 2)), + date_label = format(datetime, date_fmt), + time_label = format(datetime, "%H:%M:%S") + ) |> + dplyr::filter(!is.na(datetime)) + + if (nrow(df) == 0) { + return("No AUC plot available.") + } + + bar_cols <- ifelse(df$source == "Past", "black", "red") + + p <- plotly::plot_ly() |> + plotly::add_bars( + x = ~df$datetime, + y = ~df$postdose_auc, + marker = list(color = bar_cols), + opacity = 0.5, + name = "Post-dose AUC", + showlegend = FALSE, + text = paste0( + "Dose: ", df$dose_idx, + "
Amount: ", df$dose_amt, + "
Date: ", df$date_label, + "
Time: ", df$time_label, + "
Post-dose AUC: ", sprintf("%.2f", df$postdose_auc) + ), + hoverinfo = "text", + textposition = "none" + ) + + past_idx <- which(df$source == "Past") + future_idx <- which(df$source != "Past") + + if (length(past_idx) > 0) { + p <- p |> + plotly::add_trace( + x = df$datetime[past_idx], + y = df$cumulative_auc[past_idx], + type = "scatter", + mode = "lines+markers", + name = "Cumulative (Past)", + yaxis = "y2", + line = list(color = "black"), + marker = list(color = "black"), + showlegend = FALSE, + text = paste0( + "Dose: ", df$dose_idx[past_idx], + "
Amount: ", df$dose_amt[past_idx], + "
Date: ", df$date_label[past_idx], + "
Time: ", df$time_label[past_idx], + "
Cumulative AUC: ", sprintf("%.2f", df$cumulative_auc[past_idx]) + ), + hoverinfo = "text" + ) + } + + if (length(future_idx) > 0) { + p <- p |> + plotly::add_trace( + x = df$datetime[future_idx], + y = df$cumulative_auc[future_idx], + type = "scatter", + mode = "lines+markers", + name = "Cumulative (Future)", + yaxis = "y2", + line = list(color = "red"), + marker = list(color = "red"), + showlegend = FALSE, + text = paste0( + "Dose: ", df$dose_idx[future_idx], + "
Amount: ", df$dose_amt[future_idx], + "
Date: ", df$date_label[future_idx], + "
Time: ", df$time_label[future_idx], + "
Cumulative AUC: ", sprintf("%.2f", df$cumulative_auc[future_idx]) + ), + hoverinfo = "text" + ) + } + + if (length(past_idx) > 0 && length(future_idx) > 0) { + i_last_past <- max(past_idx) + i_first_future <- min(future_idx) + p <- p |> + plotly::add_trace( + x = c(df$datetime[i_last_past], df$datetime[i_first_future]), + y = c(df$cumulative_auc[i_last_past], df$cumulative_auc[i_first_future]), + type = "scatter", + mode = "lines", + yaxis = "y2", + line = list(color = "black", width = 2), + showlegend = FALSE, + hoverinfo = "skip" + ) + } + + ticktext <- paste0("Dose ", df$dose_idx) + + p |> + plotly::layout( + xaxis = list( + title = "", + tickvals = df$datetime, + ticktext = ticktext + ), + yaxis = list(title = "Post-dose AUC", zeroline = FALSE), + yaxis2 = list( + overlaying = "y", + side = "right", + title = list(text = "Cumulative AUC", standoff = 40), + automargin = TRUE, + zeroline = FALSE + ), + margin = list(t = 90), + bargap = 0.2, + showlegend = FALSE + ) |> + resize_plot(scale = 0.9) +} + +render_pd_table <- function(pd_tbl, page_length = 10) { + if (is.null(pd_tbl) || nrow(pd_tbl) == 0) { + return("None") + } + + has_datetime <- "datetime" %in% names(pd_tbl) + + tbl <- pd_tbl |> + dplyr::mutate( + `Dose number` = dose_number, + Date = if (has_datetime) fmt_date_col(datetime) else NA_character_, + Time = if (has_datetime) fmt_time_col(datetime) else NA_character_, + Hours = time, + `Probability` = cumulative_probability, + .source = source + ) |> + dplyr::select(`Dose number`, Date, Time, Hours, `Probability`, .source) |> + dplyr::mutate(`Probability` = fmt_num(`Probability`)) + + DT::datatable( + tbl, + class = "compact nowrap", + width = "auto", + rownames = FALSE, + options = list( + pageLength = page_length, + lengthChange = FALSE, + searching = FALSE, + info = FALSE, + autoWidth = FALSE, + columnDefs = list( + list(visible = FALSE, targets = 5) + ) + ) + ) |> + DT::formatStyle( + ".source", + target = "row", + color = DT::styleEqual(c("Past", "Future"), c("black", "red")) + ) +} + +fit_note <- function(metrics) { + metric_types <- metrics$metric_info$metric_types + paste0( + "Bias is (pred - obs) ", metric_types$bias, + ". Imprecision is ", metric_types$imprecision, + ". Change these with `setPMoptions()`." + ) +} +``` + +## Sections {.tabset .tabset-pills} + +### Overview + +```{r main-plot} +plotly::layout(report$plot, title = list(text = "")) +``` + +#### Future Doses +```{r optimized-doses} +render_dose_table(report$future_doses) +``` + +### Fit {.tabset .tabset-pills} + +#### Past observations + +
+Average + +
+ +```{r fit-past-rainbow} +if (!is.null(report$past_rainbow_plot)) resize_plot(report$past_rainbow_plot, bottom_margin = 5) +``` + +
+ +
+ +```{r fit-past-metrics} +render_percent_metrics(report$past_fit_metrics) +``` + +
+```{r fit-past-notes-1, results = 'asis'} +cat(fit_note(report$past_fit_metrics)) +``` + +
+ +
+Detailed + +
+ +```{r fit-past-plot} +if (!is.null(report$past_fit_plot)) resize_plot(report$past_fit_plot, scale = 0.9, square = TRUE, no_title = TRUE) else "No past observations available." +``` + +```{r fit-past-table} +render_fit_table(report$past_fit, page_length = 10) +``` + +
+```{r fit-past-notes-2, results = 'asis'} +cat(fit_note(report$past_fit_metrics)) +``` + +
+ + +#### Future targets + +
+Average + +
+ + +```{r fit-future-rainbow} +if (!is.null(report$future_rainbow_plot)) resize_plot(report$future_rainbow_plot) +``` + +
+ +
+ +```{r fit-future-metrics} +render_percent_metrics(report$future_fit_metrics) +``` + +```{r fit-future-notes-1, results = 'asis'} +cat(fit_note(report$future_fit_metrics)) +``` + +
+
+ +
+Detailed + +```{r fit-future-table} +render_fit_table(report$future_fit, page_length = 10) +``` + +```{r fit-future-notes-2, results = 'asis'} +cat(fit_note(report$future_fit_metrics)) +``` + +
+ +### AUC + +```{r auc-plot} +render_auc_plot(report$auc_table, report$auc_plot) +``` + +
+ +```{r auc-table} +render_auc_table(report$auc_table, page_length = 10) +``` + +
+ +### PD + +```{r pd-summary, results = 'asis'} +if (!is.null(report$pd_target_summary) && nzchar(report$pd_target_summary)) { + cat("

", + report$pd_target_summary, "

") +} +``` + +```{r pd-table} +render_pd_table(report$pd_table, page_length = 10) +``` + +### Parameters {.tabset .tabset-pills} + +#### Prior vs posterior shift + +```{r parameter-shift-note, results = 'asis'} +cat("

", + "Marginal prior distribution is shown with gray circle markers.", + "Posterior marginal distribution is superimposed with red circle markers at 50% opacity.", + "Each parameter panel uses its own x-axis value range; y-axis shows linear probability.", + "

") +``` + +```{r parameter-shift-plot} +if (!is.null(report$parameter_shift_plot)) { + resize_plot(report$parameter_shift_plot, scale = 1.0) +} else { + "No prior/posterior parameter shift plot available." +} +``` + +```{r parameter-shift-summary} +if (!is.null(report$parameter_shift_summary)) { + render_dt(report$parameter_shift_summary, page_length = 10) +} else { + "No prior/posterior parameter shift summary available." +} +``` + +#### Weighted summary + +```{r posterior-summary} +render_dt(report$posterior_summary, page_length = 10) +``` + +#### Full posterior support + +```{r posterior-table} +render_dt(report$posterior_table, page_length = 15) +``` + +### Summary + +```{r overview} +render_dt(report$overview, page_length = 20) +``` diff --git a/man/PM_compare.Rd b/man/PM_compare.Rd index a81bc2033..971603910 100755 --- a/man/PM_compare.Rd +++ b/man/PM_compare.Rd @@ -18,8 +18,9 @@ PM_compare(..., icen = "median", outeq = 1, plot = FALSE) } \value{ A highlighted table comparing the selected models with the following columns. In each metric column, -the best (lowest) value is highlighted in red. In the final best column, the red highlighting applies to the model -with the most "best" metrics. +the best value is highlighted in red. In the final best column, the red highlighting applies to the model +with the most "best" metrics. For bias, imprecision, and regression intercept, the best value is the one closest to zero. +For regression slope and R-squared, the best value is the one closest to 1. For -2*LL, AIC, and BIC, the best value is the lowest. \itemize{ \item \strong{run} The run number of the data \item \strong{nvar} Number of random parameters in the model diff --git a/man/PM_model.Rd b/man/PM_model.Rd index 7695c6de1..44809e66c 100755 --- a/man/PM_model.Rd +++ b/man/PM_model.Rd @@ -503,7 +503,8 @@ This is the main method to run a population analysis. seed = 23, overwrite = FALSE, algorithm = "NPAG", - report = getPMoptions("report_template") + report = getPMoptions("report_template"), + quiet = FALSE )}\if{html}{\out{}} } @@ -596,6 +597,8 @@ time = \code{tad} after the last dose} \item{\code{report}}{If missing, the default Pmetrics report template as specified in \link{getPMoptions} is used. Otherwise can be "plotly", "ggplot", or "none".} +\item{\code{quiet}}{Boolean operator to suppress messages during the run. Default is \code{FALSE}.} + \item{\code{intern}}{Run NPAG in the R console without a batch script. Default is TRUE.} } \if{html}{\out{}} @@ -661,7 +664,7 @@ and the \code{algorithm} argument is set to "POSTPROB" automatically.} \subsection{Method \code{sim()}}{ Simulate data from the model using a set of parameter values. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PM_model$sim(data, theta)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{PM_model$sim(data, theta, quiet = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -672,6 +675,8 @@ Simulate data from the model using a set of parameter values. \item{\code{theta}}{A matrix of parameter values to use for the simulation. The \code{theta} matrix should have the same number of columns as the number of primary parameters in the model. Each row of \code{theta} represents a different set of parameter values.} + +\item{\code{quiet}}{Logical, if TRUE, suppresses messages during simulation.} } \if{html}{\out{}} } @@ -688,14 +693,20 @@ the \code{data} object. \subsection{Method \code{compile()}}{ Compile the model to a binary file. \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PM_model$compile()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{PM_model$compile(quiet = FALSE)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{quiet}}{Logical, if TRUE, suppresses messages during compilation.} +} +\if{html}{\out{
}} +} \subsection{Details}{ This method write the model to a Rust file in a temporary path, updates the \code{binary_path} field for the model, and compiles that file to a binary file that can be used for fitting or simulation. -If the model is already compiled, the method does nothing. } } diff --git a/man/PMcheck.Rd b/man/PMcheck.Rd index bb386609a..f55766a27 100755 --- a/man/PMcheck.Rd +++ b/man/PMcheck.Rd @@ -4,7 +4,7 @@ \alias{PMcheck} \title{Check Pmetrics Inputs for Errors} \usage{ -PMcheck(data, path, fix = FALSE, quiet = FALSE) +PMcheck(data, path = ".", fix = FALSE, quiet = FALSE) } \arguments{ \item{data}{The name of a Pmetrics .csv matrix file in the current working directory, diff --git a/man/check_updates.Rd b/man/check_updates.Rd new file mode 100644 index 000000000..fa900c203 --- /dev/null +++ b/man/check_updates.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PMutilities.R +\name{check_updates} +\alias{check_updates} +\title{Check for Pmetrics and R updates} +\usage{ +check_updates(verbose = interactive(), timeout = 2) +} +\arguments{ +\item{verbose}{Logical. If \code{TRUE}, emits a user-facing CLI summary.} + +\item{timeout}{Numeric scalar. Network timeout in seconds used for this check.} +} +\value{ +An invisible list with installed/latest versions and outdated flags. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +Performs an on-demand check for newer Pmetrics and R releases. +This function is intended for interactive use and avoids running network +checks automatically during package attach. +} diff --git a/man/downloadR.Rd b/man/downloadR.Rd new file mode 100644 index 000000000..78e8dd24a --- /dev/null +++ b/man/downloadR.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PMutilities.R +\name{downloadR} +\alias{downloadR} +\title{Download the latest platform-specific R installer} +\usage{ +downloadR(r_info = latestR(), destdir = path.expand("~/Downloads")) +} +\arguments{ +\item{r_info}{Optional API response list. Defaults to \code{\link[=latestR]{latestR()}}.} + +\item{destdir}{Destination directory. Defaults to the user's Downloads folder.} +} +\value{ +The file path of the downloaded installer/tarball. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +Downloads the latest R installer (or source tarball on Linux) for the current +platform to the user's Downloads folder. +} diff --git a/man/latestR.Rd b/man/latestR.Rd new file mode 100644 index 000000000..fc7d4bb01 --- /dev/null +++ b/man/latestR.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/PMutilities.R +\name{latestR} +\alias{latestR} +\title{Get latest platform-specific R release metadata} +\usage{ +latestR() +} +\value{ +A list containing all fields returned by the API response. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +Retrieves metadata for the latest R release available for the current +platform from the r-hub rversions API. +} diff --git a/src/rust/Cargo.lock b/src/rust/Cargo.lock deleted file mode 100755 index e29e95c55..000000000 --- a/src/rust/Cargo.lock +++ /dev/null @@ -1,2359 +0,0 @@ -# This file is automatically @generated by Cargo. -# It is not intended for manual editing. -version = 4 - -[[package]] -name = "ahash" -version = "0.8.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e89da841a80418a9b391ebaea17f5c112ffaaa96f621d2c285b5174da76b9011" -dependencies = [ - "cfg-if", - "once_cell", - "version_check", - "zerocopy", -] - -[[package]] -name = "aho-corasick" -version = "1.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916" -dependencies = [ - "memchr", -] - -[[package]] -name = "allocator-api2" -version = "0.2.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "45862d1c77f2228b9e10bc609d5bc203d86ebc9b87ad8d5d5167a6c9abf739d9" - -[[package]] -name = "anyhow" -version = "1.0.100" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a23eb6b1614318a8071c9b2521f36b424b2c83db5eb3a0fead4a6c0809af6e61" - -[[package]] -name = "approx" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cab112f0a86d568ea0e627cc1d6be74a1e9cd55214684db5561995f6dad897c6" -dependencies = [ - "num-traits", -] - -[[package]] -name = "argmin" -version = "0.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e7ab7ca97779074715a402e5e8045fae27e7191acaec9b4c5653276316e9e404" -dependencies = [ - "anyhow", - "argmin-math", - "num-traits", - "paste", - "rand 0.9.2", - "rand_xoshiro", - "thiserror 2.0.17", - "web-time", -] - -[[package]] -name = "argmin-math" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ba6958a87117ff5e1d0d7716856a4303752518012ec4a67a68446b6631a1a54d" -dependencies = [ - "anyhow", - "cfg-if", - "num-complex", - "num-integer", - "num-traits", - "rand 0.9.2", - "thiserror 2.0.17", -] - -[[package]] -name = "atomic-wait" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a55b94919229f2c42292fd71ffa4b75e83193bffdd77b1e858cd55fd2d0b0ea8" -dependencies = [ - "libc", - "windows-sys 0.42.0", -] - -[[package]] -name = "autocfg" -version = "1.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ace50bade8e6234aa140d9a2f552bbee1db4d353f69b8217bc503490fc1a9f26" - -[[package]] -name = "bitflags" -version = "2.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b048fb63fd8b5923fc5aa7b340d8e156aec7ec02f0c78fa8a6ddc2613f6f71de" - -[[package]] -name = "block-buffer" -version = "0.10.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3078c7629b62d3f0439517fa394996acacc5cbc91c5a20d8c658e77abd503a71" -dependencies = [ - "generic-array", -] - -[[package]] -name = "bumpalo" -version = "3.16.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "79296716171880943b8470b5f8d03aa55eb2e645a4874bdbb28adb49162e012c" - -[[package]] -name = "bytemuck" -version = "1.24.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1fbdf580320f38b612e485521afda1ee26d10cc9884efaaa750d383e13e3c5f4" -dependencies = [ - "bytemuck_derive", -] - -[[package]] -name = "bytemuck_derive" -version = "1.10.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9abbd1bc6865053c427f7198e6af43bfdedc55ab791faed4fbd361d789575ff" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "byteorder" -version = "1.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1fd0f2584146f6f2ef48085050886acf353beff7305ebd1ae69500e27c67f64b" - -[[package]] -name = "cached" -version = "0.56.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "801927ee168e17809ab8901d9f01f700cd7d8d6a6527997fee44e4b0327a253c" -dependencies = [ - "ahash", - "cached_proc_macro", - "cached_proc_macro_types", - "hashbrown", - "once_cell", - "thiserror 2.0.17", - "web-time", -] - -[[package]] -name = "cached_proc_macro" -version = "0.25.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9225bdcf4e4a9a4c08bf16607908eb2fbf746828d5e0b5e019726dbf6571f201" -dependencies = [ - "darling", - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "cached_proc_macro_types" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ade8366b8bd5ba243f0a58f036cc0ca8a2f069cff1a2351ef1cac6b083e16fc0" - -[[package]] -name = "cc" -version = "1.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fd9de9f2205d5ef3fd67e685b0df337994ddd4495e2a28d185500d0e1edfea47" -dependencies = [ - "shlex", -] - -[[package]] -name = "cfg-if" -version = "1.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd" - -[[package]] -name = "cpufeatures" -version = "0.2.16" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "16b80225097f2e5ae4e7179dd2266824648f3e2f49d9134d584b76389d31c4c3" -dependencies = [ - "libc", -] - -[[package]] -name = "crossbeam" -version = "0.8.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1137cd7e7fc0fb5d3c5a8678be38ec56e819125d8d7907411fe24ccb943faca8" -dependencies = [ - "crossbeam-channel", - "crossbeam-deque", - "crossbeam-epoch", - "crossbeam-queue", - "crossbeam-utils", -] - -[[package]] -name = "crossbeam-channel" -version = "0.5.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "82b8f8f868b36967f9606790d1903570de9ceaf870a7bf9fbbd3016d636a2cb2" -dependencies = [ - "crossbeam-utils", -] - -[[package]] -name = "crossbeam-deque" -version = "0.8.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "613f8cc01fe9cf1a3eb3d7f488fd2fa8388403e97039e2f73692932e291a770d" -dependencies = [ - "crossbeam-epoch", - "crossbeam-utils", -] - -[[package]] -name = "crossbeam-epoch" -version = "0.9.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b82ac4a3c2ca9c3460964f020e1402edd5753411d7737aa39c3714ad1b5420e" -dependencies = [ - "crossbeam-utils", -] - -[[package]] -name = "crossbeam-queue" -version = "0.3.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0f58bbc28f91df819d0aa2a2c00cd19754769c2fad90579b3592b1c9ba7a3115" -dependencies = [ - "crossbeam-utils", -] - -[[package]] -name = "crossbeam-utils" -version = "0.8.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "22ec99545bb0ed0ea7bb9b8e1e9122ea386ff8a48c0922e43f36d45ab09e0e80" - -[[package]] -name = "crunchy" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7a81dae078cea95a014a339291cec439d2f232ebe854a9d672b796c6afafa9b7" - -[[package]] -name = "crypto-common" -version = "0.1.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1bfb12502f3fc46cca1bb51ac28df9d618d813cdc3d2f25b9fe775a34af26bb3" -dependencies = [ - "generic-array", - "typenum", -] - -[[package]] -name = "csv" -version = "1.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "acdc4883a9c96732e4733212c01447ebd805833b7275a73ca3ee080fd77afdaf" -dependencies = [ - "csv-core", - "itoa", - "ryu", - "serde", -] - -[[package]] -name = "csv-core" -version = "0.1.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5efa2b3d7902f4b634a20cae3c9c4e6209dc4779feb6863329607560143efa70" -dependencies = [ - "memchr", -] - -[[package]] -name = "darling" -version = "0.20.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6f63b86c8a8826a49b8c21f08a2d07338eec8d900540f8630dc76284be802989" -dependencies = [ - "darling_core", - "darling_macro", -] - -[[package]] -name = "darling_core" -version = "0.20.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "95133861a8032aaea082871032f5815eb9e98cef03fa916ab4500513994df9e5" -dependencies = [ - "fnv", - "ident_case", - "proc-macro2", - "quote", - "strsim", - "syn 2.0.110", -] - -[[package]] -name = "darling_macro" -version = "0.20.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d336a2a514f6ccccaa3e09b02d41d35330c07ddf03a62165fcec10bb561c7806" -dependencies = [ - "darling_core", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "defer" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "930c7171c8df9fb1782bdf9b918ed9ed2d33d1d22300abb754f9085bc48bf8e8" - -[[package]] -name = "deranged" -version = "0.3.11" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b42b6fa04a440b495c8b04d0e71b707c585f83cb9cb28cf8cd0d976c315e31b4" -dependencies = [ - "powerfmt", -] - -[[package]] -name = "diffsol" -version = "0.7.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fcb280582d6bf3f01ad1bc197c38f0d88793e22e300ce96866381e237f5fc684" -dependencies = [ - "faer", - "faer-traits", - "nalgebra 0.34.1", - "nalgebra-sparse", - "num-traits", - "petgraph", - "serde", - "thiserror 2.0.17", -] - -[[package]] -name = "digest" -version = "0.10.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9ed9a281f7bc9b7576e61468ba615a66a5c8cfdff42420a70aa82701a3b1e292" -dependencies = [ - "block-buffer", - "crypto-common", -] - -[[package]] -name = "dyn-stack" -version = "0.13.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1c4713e43e2886ba72b8271aa66c93d722116acf7a75555cce11dcde84388fe8" -dependencies = [ - "bytemuck", - "dyn-stack-macros", -] - -[[package]] -name = "dyn-stack-macros" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e1d926b4d407d372f141f93bb444696142c29d32962ccbd3531117cf3aa0bfa9" - -[[package]] -name = "either" -version = "1.13.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "60b1af1c220855b6ceac025d3f6ecdd2b7c4894bfe9cd9bda4fbb4bc7c0d4cf0" - -[[package]] -name = "enum-as-inner" -version = "0.6.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a1e6a265c649f3f5979b601d26f1d05ada116434c87741c9493cb56218f76cbc" -dependencies = [ - "heck", - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "equator" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c35da53b5a021d2484a7cc49b2ac7f2d840f8236a286f84202369bd338d761ea" -dependencies = [ - "equator-macro 0.2.1", -] - -[[package]] -name = "equator" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4711b213838dfee0117e3be6ac926007d7f433d7bbe33595975d4190cb07e6fc" -dependencies = [ - "equator-macro 0.4.2", -] - -[[package]] -name = "equator-macro" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3bf679796c0322556351f287a51b49e48f7c4986e727b5dd78c972d30e2e16cc" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "equator-macro" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "44f23cf4b44bfce11a86ace86f8a73ffdec849c9fd00a386a53d278bd9e81fb3" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "equivalent" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5443807d6dff69373d433ab9ef5378ad8df50ca6298caf15de6e52e24aaf54d5" - -[[package]] -name = "extendr-api" -version = "0.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67505d96c7faa49d20e749dba7ba2447db52c40a788fd88cc2b6bef02c02277a" -dependencies = [ - "extendr-macros", - "libR-sys", - "once_cell", - "paste", -] - -[[package]] -name = "extendr-macros" -version = "0.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "81b58838056f294411d0b2c35ac1a2b24c507d6828b75f2c1e74f00ee9b99267" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "faer" -version = "0.23.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3cb922206162d9405f9fc059052b3f997bdc92745da7bfd620645f5092df20d1" -dependencies = [ - "bytemuck", - "dyn-stack", - "equator 0.4.2", - "faer-macros", - "faer-traits", - "gemm", - "generativity", - "libm", - "nano-gemm", - "npyz", - "num-complex", - "num-traits", - "private-gemm-x86", - "pulp", - "rand 0.9.2", - "rand_distr 0.5.1", - "rayon", - "reborrow", - "spindle", -] - -[[package]] -name = "faer-ext" -version = "0.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "aa4d037166f25435671ecc6054ae76b964f17da513353f1617690470680efdf0" -dependencies = [ - "faer", - "nalgebra 0.34.1", - "ndarray", - "num-complex", -] - -[[package]] -name = "faer-macros" -version = "0.22.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2cc4b8cd876795d3b19ddfd59b03faa303c0b8adb9af6e188e81fc647c485bb9" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "faer-traits" -version = "0.23.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "24b69235b5f54416286c485fb047f2f499fc935a4eee2caadf4757f3c94c7b62" -dependencies = [ - "bytemuck", - "dyn-stack", - "faer-macros", - "generativity", - "libm", - "num-complex", - "num-traits", - "pulp", - "qd", - "reborrow", -] - -[[package]] -name = "fixedbitset" -version = "0.5.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1d674e81391d1e1ab681a28d99df07927c6d4aa5b027d7da16ba32d1d21ecd99" - -[[package]] -name = "fnv" -version = "1.0.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" - -[[package]] -name = "foldhash" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d9c4f5dac5e15c24eb999c26181a6ca40b39fe946cbe4c263c7209467bc83af2" - -[[package]] -name = "gemm" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ab96b703d31950f1aeddded248bc95543c9efc7ac9c4a21fda8703a83ee35451" -dependencies = [ - "dyn-stack", - "gemm-c32", - "gemm-c64", - "gemm-common", - "gemm-f16", - "gemm-f32", - "gemm-f64", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "seq-macro", -] - -[[package]] -name = "gemm-c32" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f6db9fd9f40421d00eea9dd0770045a5603b8d684654816637732463f4073847" -dependencies = [ - "dyn-stack", - "gemm-common", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "seq-macro", -] - -[[package]] -name = "gemm-c64" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dfcad8a3d35a43758330b635d02edad980c1e143dc2f21e6fd25f9e4eada8edf" -dependencies = [ - "dyn-stack", - "gemm-common", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "seq-macro", -] - -[[package]] -name = "gemm-common" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a352d4a69cbe938b9e2a9cb7a3a63b7e72f9349174a2752a558a8a563510d0f3" -dependencies = [ - "bytemuck", - "dyn-stack", - "half", - "libm", - "num-complex", - "num-traits", - "once_cell", - "paste", - "pulp", - "raw-cpuid", - "rayon", - "seq-macro", - "sysctl", -] - -[[package]] -name = "gemm-f16" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cff95ae3259432f3c3410eaa919033cd03791d81cebd18018393dc147952e109" -dependencies = [ - "dyn-stack", - "gemm-common", - "gemm-f32", - "half", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "rayon", - "seq-macro", -] - -[[package]] -name = "gemm-f32" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bc8d3d4385393304f407392f754cd2dc4b315d05063f62cf09f47b58de276864" -dependencies = [ - "dyn-stack", - "gemm-common", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "seq-macro", -] - -[[package]] -name = "gemm-f64" -version = "0.18.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "35b2a4f76ce4b8b16eadc11ccf2e083252d8237c1b589558a49b0183545015bd" -dependencies = [ - "dyn-stack", - "gemm-common", - "num-complex", - "num-traits", - "paste", - "raw-cpuid", - "seq-macro", -] - -[[package]] -name = "generativity" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5881e4c3c2433fe4905bb19cfd2b5d49d4248274862b68c27c33d9ba4e13f9ec" - -[[package]] -name = "generator" -version = "0.8.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "605183a538e3e2a9c1038635cc5c2d194e2ee8fd0d1b66b8349fad7dbacce5a2" -dependencies = [ - "cc", - "cfg-if", - "libc", - "log", - "rustversion", - "windows", -] - -[[package]] -name = "generic-array" -version = "0.14.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" -dependencies = [ - "typenum", - "version_check", -] - -[[package]] -name = "getrandom" -version = "0.2.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c4567c8db10ae91089c99af84c68c38da3ec2f087c3f82960bcdbf3656b6f4d7" -dependencies = [ - "cfg-if", - "libc", - "wasi", -] - -[[package]] -name = "getrandom" -version = "0.3.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "899def5c37c4fd7b2664648c28120ecec138e4d395b459e5ca34f9cce2dd77fd" -dependencies = [ - "cfg-if", - "libc", - "r-efi", - "wasip2", -] - -[[package]] -name = "glam" -version = "0.14.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "333928d5eb103c5d4050533cec0384302db6be8ef7d3cebd30ec6a35350353da" - -[[package]] -name = "glam" -version = "0.15.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3abb554f8ee44336b72d522e0a7fe86a29e09f839a36022fa869a7dfe941a54b" - -[[package]] -name = "glam" -version = "0.16.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4126c0479ccf7e8664c36a2d719f5f2c140fbb4f9090008098d2c291fa5b3f16" - -[[package]] -name = "glam" -version = "0.17.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e01732b97afd8508eee3333a541b9f7610f454bb818669e66e90f5f57c93a776" - -[[package]] -name = "glam" -version = "0.18.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "525a3e490ba77b8e326fb67d4b44b4bd2f920f44d4cc73ccec50adc68e3bee34" - -[[package]] -name = "glam" -version = "0.19.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b8509e6791516e81c1a630d0bd7fbac36d2fa8712a9da8662e716b52d5051ca" - -[[package]] -name = "glam" -version = "0.20.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f43e957e744be03f5801a55472f593d43fabdebf25a4585db250f04d86b1675f" - -[[package]] -name = "glam" -version = "0.21.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "518faa5064866338b013ff9b2350dc318e14cc4fcd6cb8206d7e7c9886c98815" - -[[package]] -name = "glam" -version = "0.22.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "12f597d56c1bd55a811a1be189459e8fad2bbc272616375602443bdfb37fa774" - -[[package]] -name = "glam" -version = "0.23.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e4afd9ad95555081e109fe1d21f2a30c691b5f0919c67dfa690a2e1eb6bd51c" - -[[package]] -name = "glam" -version = "0.24.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b5418c17512bdf42730f9032c74e1ae39afc408745ebb2acf72fbc4691c17945" - -[[package]] -name = "glam" -version = "0.25.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "151665d9be52f9bb40fc7966565d39666f2d1e69233571b71b87791c7e0528b3" - -[[package]] -name = "glam" -version = "0.27.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9e05e7e6723e3455f4818c7b26e855439f7546cf617ef669d1adedb8669e5cb9" - -[[package]] -name = "glam" -version = "0.28.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "779ae4bf7e8421cf91c0b3b64e7e8b40b862fba4d393f59150042de7c4965a94" - -[[package]] -name = "glam" -version = "0.29.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8babf46d4c1c9d92deac9f7be466f76dfc4482b6452fc5024b5e8daf6ffeb3ee" - -[[package]] -name = "glam" -version = "0.30.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd47b05dddf0005d850e5644cae7f2b14ac3df487979dbfff3b56f20b1a6ae46" - -[[package]] -name = "half" -version = "2.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6dd08c532ae367adf81c312a4580bc67f1d0fe8bc9c460520283f4c0ff277888" -dependencies = [ - "bytemuck", - "cfg-if", - "crunchy", - "num-traits", -] - -[[package]] -name = "hashbrown" -version = "0.15.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3a9bfc1af68b1726ea47d3d5109de126281def866b33970e10fbab11b5dafab3" -dependencies = [ - "allocator-api2", - "equivalent", - "foldhash", -] - -[[package]] -name = "heck" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" - -[[package]] -name = "hermit-abi" -version = "0.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc0fef456e4baa96da950455cd02c081ca953b141298e41db3fc7e36b1da849c" - -[[package]] -name = "ident_case" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" - -[[package]] -name = "indexmap" -version = "2.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "707907fe3c25f5424cce2cb7e1cbcafee6bdbe735ca90ef77c29e84591e5b9da" -dependencies = [ - "equivalent", - "hashbrown", -] - -[[package]] -name = "interpol" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eb58032ba748f4010d15912a1855a8a0b1ba9eaad3395b0c171c09b3b356ae50" -dependencies = [ - "proc-macro2", - "quote", - "syn 1.0.109", -] - -[[package]] -name = "itoa" -version = "1.0.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "540654e97a3f4470a492cd30ff187bc95d89557a903a2bbf112e2fae98104ef2" - -[[package]] -name = "js-sys" -version = "0.3.72" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6a88f1bda2bd75b0452a14784937d796722fdebfe50df998aeb3f0b7603019a9" -dependencies = [ - "wasm-bindgen", -] - -[[package]] -name = "lazy_static" -version = "1.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bbd2bcb4c963f2ddae06a2efc7e9f3591312473c50c6685e1f298068316e66fe" - -[[package]] -name = "libR-sys" -version = "0.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "06ac9752bc1e83f5a354a62b9e81bd8db4468b1008e29f262441e7f0e91e6bb3" - -[[package]] -name = "libc" -version = "0.2.164" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "433bfe06b8c75da9b2e3fbea6e5329ff87748f0b144ef75306e674c3f6f7c13f" - -[[package]] -name = "libloading" -version = "0.8.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d7c4b02199fee7c5d21a5ae7d8cfa79a6ef5bb2fc834d6e9058e89c825efdc55" -dependencies = [ - "cfg-if", - "windows-link 0.2.1", -] - -[[package]] -name = "libm" -version = "0.2.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9fbbcab51052fe104eb5e5d351cf728d30a5be1fe14d9be8a3b097481fb97de" - -[[package]] -name = "log" -version = "0.4.22" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a7a70ba024b9dc04c27ea2f0c0548feb474ec5c54bba33a7f72f873a39d07b24" - -[[package]] -name = "loom" -version = "0.7.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "419e0dc8046cb947daa77eb95ae174acfbddb7673b4151f56d1eed8e93fbfaca" -dependencies = [ - "cfg-if", - "generator", - "scoped-tls", - "tracing", - "tracing-subscriber", -] - -[[package]] -name = "matchers" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d1525a2a28c7f4fa0fc98bb91ae755d1e2d1505079e05539e35bc876b5d65ae9" -dependencies = [ - "regex-automata", -] - -[[package]] -name = "matrixmultiply" -version = "0.3.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9380b911e3e96d10c1f415da0876389aaf1b56759054eeb0de7df940c456ba1a" -dependencies = [ - "autocfg", - "rawpointer", -] - -[[package]] -name = "memchr" -version = "2.7.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "78ca9ab1a0babb1e7d5695e3530886289c18cf2f87ec19a575a0abdce112e3a3" - -[[package]] -name = "nalgebra" -version = "0.33.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "26aecdf64b707efd1310e3544d709c5c0ac61c13756046aaaba41be5c4f66a3b" -dependencies = [ - "approx", - "matrixmultiply", - "num-complex", - "num-rational", - "num-traits", - "rand 0.8.5", - "rand_distr 0.4.3", - "simba", - "typenum", -] - -[[package]] -name = "nalgebra" -version = "0.34.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c4d5b3eff5cd580f93da45e64715e8c20a3996342f1e466599cf7a267a0c2f5f" -dependencies = [ - "approx", - "glam 0.14.0", - "glam 0.15.2", - "glam 0.16.0", - "glam 0.17.3", - "glam 0.18.0", - "glam 0.19.0", - "glam 0.20.5", - "glam 0.21.3", - "glam 0.22.0", - "glam 0.23.0", - "glam 0.24.2", - "glam 0.25.0", - "glam 0.27.0", - "glam 0.28.0", - "glam 0.29.3", - "glam 0.30.9", - "matrixmultiply", - "nalgebra-macros", - "num-complex", - "num-rational", - "num-traits", - "simba", - "typenum", -] - -[[package]] -name = "nalgebra-macros" -version = "0.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "973e7178a678cfd059ccec50887658d482ce16b0aa9da3888ddeab5cd5eb4889" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "nalgebra-sparse" -version = "0.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "df054d7815152d4e66955fc59a1f97f4036e5103134a381b6b54ec55babfa6b7" -dependencies = [ - "nalgebra 0.34.1", - "num-traits", - "pest", - "pest_derive", -] - -[[package]] -name = "nano-gemm" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bb5ba2bea1c00e53de11f6ab5bd0761ba87dc0045d63b0c87ee471d2d3061376" -dependencies = [ - "equator 0.2.2", - "nano-gemm-c32", - "nano-gemm-c64", - "nano-gemm-codegen", - "nano-gemm-core", - "nano-gemm-f32", - "nano-gemm-f64", - "num-complex", -] - -[[package]] -name = "nano-gemm-c32" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a40449e57a5713464c3a1208c4c3301c8d29ee1344711822cf022bc91373a91b" -dependencies = [ - "nano-gemm-codegen", - "nano-gemm-core", - "num-complex", -] - -[[package]] -name = "nano-gemm-c64" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "743a6e6211358fba85d1009616751e4107da86f4c95b24e684ce85f25c25b3bf" -dependencies = [ - "nano-gemm-codegen", - "nano-gemm-core", - "num-complex", -] - -[[package]] -name = "nano-gemm-codegen" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "963bf7c7110d55430169dc74c67096375491ed580cd2ef84842550ac72e781fa" - -[[package]] -name = "nano-gemm-core" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fe3fc4f83ae8861bad79dc3c016bd6b0220da5f9de302e07d3112d16efc24aa6" - -[[package]] -name = "nano-gemm-f32" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4e3681b7ce35658f79da94b7f62c60a005e29c373c7111ed070e3bf64546a8bb" -dependencies = [ - "nano-gemm-codegen", - "nano-gemm-core", -] - -[[package]] -name = "nano-gemm-f64" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bc1e619ed04d801809e1f63e61b669d380c4119e8b0cdd6ed184c6b111f046d8" -dependencies = [ - "nano-gemm-codegen", - "nano-gemm-core", -] - -[[package]] -name = "ndarray" -version = "0.16.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "882ed72dce9365842bf196bdeedf5055305f11fc8c03dee7bb0194a6cad34841" -dependencies = [ - "matrixmultiply", - "num-complex", - "num-integer", - "num-traits", - "portable-atomic", - "portable-atomic-util", - "rawpointer", - "rayon", -] - -[[package]] -name = "npyz" -version = "0.8.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9f0e759e014e630f90af745101b614f761306ddc541681e546649068e25ec1b9" -dependencies = [ - "byteorder", - "num-bigint", - "py_literal", -] - -[[package]] -name = "nu-ansi-term" -version = "0.50.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7957b9740744892f114936ab4a57b3f487491bbeafaf8083688b16841a4240e5" -dependencies = [ - "windows-sys 0.59.0", -] - -[[package]] -name = "num-bigint" -version = "0.4.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a5e44f723f1133c9deac646763579fdb3ac745e418f2a7af9cd0c431da1f20b9" -dependencies = [ - "num-integer", - "num-traits", -] - -[[package]] -name = "num-complex" -version = "0.4.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "73f88a1307638156682bada9d7604135552957b7818057dcef22705b4d509495" -dependencies = [ - "bytemuck", - "num-traits", - "rand 0.8.5", -] - -[[package]] -name = "num-conv" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "51d515d32fb182ee37cda2ccdcb92950d6a3c2893aa280e540671c2cd0f3b1d9" - -[[package]] -name = "num-integer" -version = "0.1.46" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7969661fd2958a5cb096e56c8e1ad0444ac2bbcd0061bd28660485a44879858f" -dependencies = [ - "num-traits", -] - -[[package]] -name = "num-rational" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f83d14da390562dca69fc84082e73e548e1ad308d24accdedd2720017cb37824" -dependencies = [ - "num-bigint", - "num-integer", - "num-traits", -] - -[[package]] -name = "num-traits" -version = "0.2.19" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" -dependencies = [ - "autocfg", - "libm", -] - -[[package]] -name = "num_cpus" -version = "1.17.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "91df4bbde75afed763b708b7eee1e8e7651e02d97f6d5dd763e89367e957b23b" -dependencies = [ - "hermit-abi", - "libc", -] - -[[package]] -name = "once_cell" -version = "1.20.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1261fe7e33c73b354eab43b1273a57c8f967d0391e80353e51f764ac02cf6775" - -[[package]] -name = "paste" -version = "1.0.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "57c0d7b74b563b49d38dae00a0c37d4d6de9b432382b2892f0574ddcae73fd0a" - -[[package]] -name = "pest" -version = "2.7.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "879952a81a83930934cbf1786752d6dedc3b1f29e8f8fb2ad1d0a36f377cf442" -dependencies = [ - "memchr", - "thiserror 1.0.69", - "ucd-trie", -] - -[[package]] -name = "pest_derive" -version = "2.7.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d214365f632b123a47fd913301e14c946c61d1c183ee245fa76eb752e59a02dd" -dependencies = [ - "pest", - "pest_generator", -] - -[[package]] -name = "pest_generator" -version = "2.7.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eb55586734301717aea2ac313f50b2eb8f60d2fc3dc01d190eefa2e625f60c4e" -dependencies = [ - "pest", - "pest_meta", - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "pest_meta" -version = "2.7.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b75da2a70cf4d9cb76833c990ac9cd3923c9a8905a8929789ce347c84564d03d" -dependencies = [ - "once_cell", - "pest", - "sha2", -] - -[[package]] -name = "petgraph" -version = "0.8.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8701b58ea97060d5e5b155d383a69952a60943f0e6dfe30b04c287beb0b27455" -dependencies = [ - "fixedbitset", - "hashbrown", - "indexmap", - "serde", -] - -[[package]] -name = "pharmsol" -version = "0.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "98b8e2ab3a0e91cd4b20c28544cb3676e8df31aa490cf5680ec0531259b5fa4e" -dependencies = [ - "argmin", - "argmin-math", - "cached", - "csv", - "diffsol", - "libloading", - "nalgebra 0.34.1", - "ndarray", - "rand 0.9.2", - "rand_distr 0.5.1", - "rayon", - "serde", - "serde_json", - "statrs", - "thiserror 2.0.17", - "tracing", -] - -[[package]] -name = "pin-project-lite" -version = "0.2.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "915a1e146535de9163f3987b8944ed8cf49a18bb0056bcebcdcece385cece4ff" - -[[package]] -name = "pm_rs" -version = "0.1.0" -dependencies = [ - "anyhow", - "extendr-api", - "pmcore", - "rayon", - "tracing", - "tracing-subscriber", -] - -[[package]] -name = "pmcore" -version = "0.21.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "703e83f4a6a919cc60b85936d560840947b1b07a2d8ccfa7c87144d1722b6d63" -dependencies = [ - "anyhow", - "argmin", - "argmin-math", - "csv", - "faer", - "faer-ext", - "ndarray", - "pharmsol", - "rand 0.9.2", - "rayon", - "serde", - "serde_json", - "sobol_burley", - "tracing", - "tracing-subscriber", -] - -[[package]] -name = "portable-atomic" -version = "1.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cc9c68a3f6da06753e9335d63e27f6b9754dd1920d941135b7ea8224f141adb2" - -[[package]] -name = "portable-atomic-util" -version = "0.2.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8a2f0d8d040d7848a709caf78912debcc3f33ee4b3cac47d73d1e1069e83507" -dependencies = [ - "portable-atomic", -] - -[[package]] -name = "powerfmt" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "439ee305def115ba05938db6eb1644ff94165c5ab5e9420d1c1bcedbba909391" - -[[package]] -name = "ppv-lite86" -version = "0.2.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "77957b295656769bb8ad2b6a6b09d897d94f05c41b069aede1fcdaa675eaea04" -dependencies = [ - "zerocopy", -] - -[[package]] -name = "private-gemm-x86" -version = "0.1.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b8138b380908e85071bdd6b2841a38b0858ef09848b754a15219d0b9ca90928" -dependencies = [ - "crossbeam", - "defer", - "interpol", - "num_cpus", - "raw-cpuid", - "rayon", - "spindle", - "sysctl", -] - -[[package]] -name = "proc-macro2" -version = "1.0.103" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5ee95bc4ef87b8d5ba32e8b7714ccc834865276eab0aed5c9958d00ec45f49e8" -dependencies = [ - "unicode-ident", -] - -[[package]] -name = "pulp" -version = "0.21.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "96b86df24f0a7ddd5e4b95c94fc9ed8a98f1ca94d3b01bdce2824097e7835907" -dependencies = [ - "bytemuck", - "cfg-if", - "libm", - "num-complex", - "reborrow", - "version_check", -] - -[[package]] -name = "py_literal" -version = "0.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "102df7a3d46db9d3891f178dcc826dc270a6746277a9ae6436f8d29fd490a8e1" -dependencies = [ - "num-bigint", - "num-complex", - "num-traits", - "pest", - "pest_derive", -] - -[[package]] -name = "qd" -version = "0.7.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ff8bb755b6008c3b41bf8a0866c8dd4e1245a2f011ceaa22a13ee55c538493e2" -dependencies = [ - "bytemuck", - "libm", - "num-traits", - "pulp", -] - -[[package]] -name = "quote" -version = "1.0.42" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a338cc41d27e6cc6dce6cefc13a0729dfbb81c262b1f519331575dd80ef3067f" -dependencies = [ - "proc-macro2", -] - -[[package]] -name = "r-efi" -version = "5.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "69cdb34c158ceb288df11e18b4bd39de994f6657d83847bdffdbd7f346754b0f" - -[[package]] -name = "rand" -version = "0.8.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "34af8d1a0e25924bc5b7c43c079c942339d8f0a8b57c39049bef581b46327404" -dependencies = [ - "libc", - "rand_chacha 0.3.1", - "rand_core 0.6.4", -] - -[[package]] -name = "rand" -version = "0.9.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6db2770f06117d490610c7488547d543617b21bfa07796d7a12f6f1bd53850d1" -dependencies = [ - "rand_chacha 0.9.0", - "rand_core 0.9.3", -] - -[[package]] -name = "rand_chacha" -version = "0.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e6c10a63a0fa32252be49d21e7709d4d4baf8d231c2dbce1eaa8141b9b127d88" -dependencies = [ - "ppv-lite86", - "rand_core 0.6.4", -] - -[[package]] -name = "rand_chacha" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d3022b5f1df60f26e1ffddd6c66e8aa15de382ae63b3a0c1bfc0e4d3e3f325cb" -dependencies = [ - "ppv-lite86", - "rand_core 0.9.3", -] - -[[package]] -name = "rand_core" -version = "0.6.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ec0be4795e2f6a28069bec0b5ff3e2ac9bafc99e6a9a7dc3547996c5c816922c" -dependencies = [ - "getrandom 0.2.15", -] - -[[package]] -name = "rand_core" -version = "0.9.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "99d9a13982dcf210057a8a78572b2217b667c3beacbf3a0d8b454f6f82837d38" -dependencies = [ - "getrandom 0.3.4", -] - -[[package]] -name = "rand_distr" -version = "0.4.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32cb0b9bc82b0a0876c2dd994a7e7a2683d3e7390ca40e6886785ef0c7e3ee31" -dependencies = [ - "num-traits", - "rand 0.8.5", -] - -[[package]] -name = "rand_distr" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6a8615d50dcf34fa31f7ab52692afec947c4dd0ab803cc87cb3b0b4570ff7463" -dependencies = [ - "num-traits", - "rand 0.9.2", -] - -[[package]] -name = "rand_xoshiro" -version = "0.7.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f703f4665700daf5512dcca5f43afa6af89f09db47fb56be587f80636bda2d41" -dependencies = [ - "rand_core 0.9.3", -] - -[[package]] -name = "raw-cpuid" -version = "11.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "498cd0dc59d73224351ee52a95fee0f1a617a2eae0e7d9d720cc622c73a54186" -dependencies = [ - "bitflags", -] - -[[package]] -name = "rawpointer" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "60a357793950651c4ed0f3f52338f53b2f809f32d83a07f72909fa13e4c6c1e3" - -[[package]] -name = "rayon" -version = "1.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "368f01d005bf8fd9b1206fb6fa653e6c4a81ceb1466406b81792d87c5677a58f" -dependencies = [ - "either", - "rayon-core", -] - -[[package]] -name = "rayon-core" -version = "1.13.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "22e18b0f0062d30d4230b2e85ff77fdfe4326feb054b9783a3460d8435c8ab91" -dependencies = [ - "crossbeam-deque", - "crossbeam-utils", -] - -[[package]] -name = "reborrow" -version = "0.5.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "03251193000f4bd3b042892be858ee50e8b3719f2b08e5833ac4353724632430" - -[[package]] -name = "regex-automata" -version = "0.4.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "809e8dc61f6de73b46c85f4c96486310fe304c434cfa43669d7b40f711150908" -dependencies = [ - "aho-corasick", - "memchr", - "regex-syntax", -] - -[[package]] -name = "regex-syntax" -version = "0.8.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b15c43186be67a4fd63bee50d0303afffcef381492ebe2c5d87f324e1b8815c" - -[[package]] -name = "rustversion" -version = "1.0.22" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" - -[[package]] -name = "ryu" -version = "1.0.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f3cb5ba0dc43242ce17de99c180e96db90b235b8a9fdc9543c96d2209116bd9f" - -[[package]] -name = "safe_arch" -version = "0.7.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c3460605018fdc9612bce72735cba0d27efbcd9904780d44c7e3a9948f96148a" -dependencies = [ - "bytemuck", -] - -[[package]] -name = "same-file" -version = "1.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" -dependencies = [ - "winapi-util", -] - -[[package]] -name = "scoped-tls" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e1cf6437eb19a8f4a6cc0f7dca544973b0b78843adbfeb3683d1a94a0024a294" - -[[package]] -name = "seq-macro" -version = "0.3.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a3f0bf26fd526d2a95683cd0f87bf103b8539e2ca1ef48ce002d67aad59aa0b4" - -[[package]] -name = "serde" -version = "1.0.215" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6513c1ad0b11a9376da888e3e0baa0077f1aed55c17f50e7b2397136129fb88f" -dependencies = [ - "serde_derive", -] - -[[package]] -name = "serde_derive" -version = "1.0.215" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ad1e866f866923f252f05c889987993144fb74e722403468a4ebd70c3cd756c0" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "serde_json" -version = "1.0.133" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c7fceb2473b9166b2294ef05efcb65a3db80803f0b03ef86a5fc88a2b85ee377" -dependencies = [ - "itoa", - "memchr", - "ryu", - "serde", -] - -[[package]] -name = "sha2" -version = "0.10.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "793db75ad2bcafc3ffa7c68b215fee268f537982cd901d132f89c6343f3a3dc8" -dependencies = [ - "cfg-if", - "cpufeatures", - "digest", -] - -[[package]] -name = "sharded-slab" -version = "0.1.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f40ca3c46823713e0d4209592e8d6e826aa57e928f09752619fc696c499637f6" -dependencies = [ - "lazy_static", -] - -[[package]] -name = "shlex" -version = "1.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" - -[[package]] -name = "simba" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b3a386a501cd104797982c15ae17aafe8b9261315b5d07e3ec803f2ea26be0fa" -dependencies = [ - "approx", - "num-complex", - "num-traits", - "paste", - "wide", -] - -[[package]] -name = "smallvec" -version = "1.13.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3c5e1a9a646d36c3599cd173a41282daf47c44583ad367b8e6837255952e5c67" - -[[package]] -name = "sobol_burley" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "09f37cae1d97c4078377153ede7a26f7813b689ad5c6b76ff45dc52e53afe1d1" - -[[package]] -name = "spindle" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f794dedb367e82477aa6bbf83ea9bbce9bc074b3caacaa82fc4ba398ec9b701d" -dependencies = [ - "atomic-wait", - "crossbeam", - "equator 0.4.2", - "loom", - "rayon", -] - -[[package]] -name = "statrs" -version = "0.18.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2a3fe7c28c6512e766b0874335db33c94ad7b8f9054228ae1c2abd47ce7d335e" -dependencies = [ - "approx", - "nalgebra 0.33.2", - "num-traits", - "rand 0.8.5", -] - -[[package]] -name = "strsim" -version = "0.11.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" - -[[package]] -name = "syn" -version = "1.0.109" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "72b64191b275b66ffe2469e8af2c1cfe3bafa67b529ead792a6d0160888b4237" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] - -[[package]] -name = "syn" -version = "2.0.110" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a99801b5bd34ede4cf3fc688c5919368fea4e4814a4664359503e6015b280aea" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] - -[[package]] -name = "sysctl" -version = "0.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "01198a2debb237c62b6826ec7081082d951f46dbb64b0e8c7649a452230d1dfc" -dependencies = [ - "bitflags", - "byteorder", - "enum-as-inner", - "libc", - "thiserror 1.0.69", - "walkdir", -] - -[[package]] -name = "thiserror" -version = "1.0.69" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6aaf5339b578ea85b50e080feb250a3e8ae8cfcdff9a461c9ec2904bc923f52" -dependencies = [ - "thiserror-impl 1.0.69", -] - -[[package]] -name = "thiserror" -version = "2.0.17" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f63587ca0f12b72a0600bcba1d40081f830876000bb46dd2337a3051618f4fc8" -dependencies = [ - "thiserror-impl 2.0.17", -] - -[[package]] -name = "thiserror-impl" -version = "1.0.69" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "thiserror-impl" -version = "2.0.17" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3ff15c8ecd7de3849db632e14d18d2571fa09dfc5ed93479bc4485c7a517c913" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "thread_local" -version = "1.1.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b9ef9bad013ada3808854ceac7b46812a6465ba368859a37e2100283d2d719c" -dependencies = [ - "cfg-if", - "once_cell", -] - -[[package]] -name = "time" -version = "0.3.36" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5dfd88e563464686c916c7e46e623e520ddc6d79fa6641390f2e3fa86e83e885" -dependencies = [ - "deranged", - "itoa", - "num-conv", - "powerfmt", - "serde", - "time-core", - "time-macros", -] - -[[package]] -name = "time-core" -version = "0.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ef927ca75afb808a4d64dd374f00a2adf8d0fcff8e7b184af886c3c87ec4a3f3" - -[[package]] -name = "time-macros" -version = "0.2.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3f252a68540fde3a3877aeea552b832b40ab9a69e318efd078774a01ddee1ccf" -dependencies = [ - "num-conv", - "time-core", -] - -[[package]] -name = "tracing" -version = "0.1.41" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "784e0ac535deb450455cbfa28a6f0df145ea1bb7ae51b821cf5e7927fdcfbdd0" -dependencies = [ - "pin-project-lite", - "tracing-attributes", - "tracing-core", -] - -[[package]] -name = "tracing-attributes" -version = "0.1.30" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "81383ab64e72a7a8b8e13130c49e3dab29def6d0c7d76a03087b3cf71c5c6903" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "tracing-core" -version = "0.1.34" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b9d12581f227e93f094d3af2ae690a574abb8a2b9b7a96e7cfe9647b2b617678" -dependencies = [ - "once_cell", - "valuable", -] - -[[package]] -name = "tracing-log" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ee855f1f400bd0e5c02d150ae5de3840039a3f54b025156404e34c23c03f47c3" -dependencies = [ - "log", - "once_cell", - "tracing-core", -] - -[[package]] -name = "tracing-subscriber" -version = "0.3.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2054a14f5307d601f88daf0553e1cbf472acc4f2c51afab632431cdcd72124d5" -dependencies = [ - "matchers", - "nu-ansi-term", - "once_cell", - "regex-automata", - "sharded-slab", - "smallvec", - "thread_local", - "time", - "tracing", - "tracing-core", - "tracing-log", -] - -[[package]] -name = "typenum" -version = "1.17.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "42ff0bf0c66b8238c6f3b578df37d0b7848e55df8577b3f74f92a69acceeb825" - -[[package]] -name = "ucd-trie" -version = "0.1.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2896d95c02a80c6d6a5d6e953d479f5ddf2dfdb6a244441010e373ac0fb88971" - -[[package]] -name = "unicode-ident" -version = "1.0.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "adb9e6ca4f869e1180728b7950e35922a7fc6397f7b641499e8f3ef06e50dc83" - -[[package]] -name = "valuable" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "830b7e5d4d90034032940e4ace0d9a9a057e7a45cd94e6c007832e39edb82f6d" - -[[package]] -name = "version_check" -version = "0.9.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" - -[[package]] -name = "walkdir" -version = "2.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" -dependencies = [ - "same-file", - "winapi-util", -] - -[[package]] -name = "wasi" -version = "0.11.0+wasi-snapshot-preview1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423" - -[[package]] -name = "wasip2" -version = "1.0.1+wasi-0.2.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0562428422c63773dad2c345a1882263bbf4d65cf3f42e90921f787ef5ad58e7" -dependencies = [ - "wit-bindgen", -] - -[[package]] -name = "wasm-bindgen" -version = "0.2.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "128d1e363af62632b8eb57219c8fd7877144af57558fb2ef0368d0087bddeb2e" -dependencies = [ - "cfg-if", - "once_cell", - "wasm-bindgen-macro", -] - -[[package]] -name = "wasm-bindgen-backend" -version = "0.2.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cb6dd4d3ca0ddffd1dd1c9c04f94b868c37ff5fac97c30b97cff2d74fce3a358" -dependencies = [ - "bumpalo", - "log", - "once_cell", - "proc-macro2", - "quote", - "syn 2.0.110", - "wasm-bindgen-shared", -] - -[[package]] -name = "wasm-bindgen-macro" -version = "0.2.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e79384be7f8f5a9dd5d7167216f022090cf1f9ec128e6e6a482a2cb5c5422c56" -dependencies = [ - "quote", - "wasm-bindgen-macro-support", -] - -[[package]] -name = "wasm-bindgen-macro-support" -version = "0.2.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "26c6ab57572f7a24a4985830b120de1594465e5d500f24afe89e16b4e833ef68" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", - "wasm-bindgen-backend", - "wasm-bindgen-shared", -] - -[[package]] -name = "wasm-bindgen-shared" -version = "0.2.95" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "65fc09f10666a9f147042251e0dda9c18f166ff7de300607007e96bdebc1068d" - -[[package]] -name = "web-time" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a6580f308b1fad9207618087a65c04e7a10bc77e02c8e84e9b00dd4b12fa0bb" -dependencies = [ - "js-sys", - "wasm-bindgen", -] - -[[package]] -name = "wide" -version = "0.7.30" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "58e6db2670d2be78525979e9a5f9c69d296fd7d670549fe9ebf70f8708cb5019" -dependencies = [ - "bytemuck", - "safe_arch", -] - -[[package]] -name = "winapi-util" -version = "0.1.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cf221c93e13a30d793f7645a0e7762c55d169dbb0a49671918a2319d289b10bb" -dependencies = [ - "windows-sys 0.59.0", -] - -[[package]] -name = "windows" -version = "0.61.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9babd3a767a4c1aef6900409f85f5d53ce2544ccdfaa86dad48c91782c6d6893" -dependencies = [ - "windows-collections", - "windows-core", - "windows-future", - "windows-link 0.1.3", - "windows-numerics", -] - -[[package]] -name = "windows-collections" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3beeceb5e5cfd9eb1d76b381630e82c4241ccd0d27f1a39ed41b2760b255c5e8" -dependencies = [ - "windows-core", -] - -[[package]] -name = "windows-core" -version = "0.61.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c0fdd3ddb90610c7638aa2b3a3ab2904fb9e5cdbecc643ddb3647212781c4ae3" -dependencies = [ - "windows-implement", - "windows-interface", - "windows-link 0.1.3", - "windows-result", - "windows-strings", -] - -[[package]] -name = "windows-future" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc6a41e98427b19fe4b73c550f060b59fa592d7d686537eebf9385621bfbad8e" -dependencies = [ - "windows-core", - "windows-link 0.1.3", - "windows-threading", -] - -[[package]] -name = "windows-implement" -version = "0.60.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "053e2e040ab57b9dc951b72c264860db7eb3b0200ba345b4e4c3b14f67855ddf" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "windows-interface" -version = "0.59.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3f316c4a2570ba26bbec722032c4099d8c8bc095efccdc15688708623367e358" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] - -[[package]] -name = "windows-link" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5e6ad25900d524eaabdbbb96d20b4311e1e7ae1699af4fb28c17ae66c80d798a" - -[[package]] -name = "windows-link" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f0805222e57f7521d6a62e36fa9163bc891acd422f971defe97d64e70d0a4fe5" - -[[package]] -name = "windows-numerics" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9150af68066c4c5c07ddc0ce30421554771e528bde427614c61038bc2c92c2b1" -dependencies = [ - "windows-core", - "windows-link 0.1.3", -] - -[[package]] -name = "windows-result" -version = "0.3.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "56f42bd332cc6c8eac5af113fc0c1fd6a8fd2aa08a0119358686e5160d0586c6" -dependencies = [ - "windows-link 0.1.3", -] - -[[package]] -name = "windows-strings" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "56e6c93f3a0c3b36176cb1327a4958a0353d5d166c2a35cb268ace15e91d3b57" -dependencies = [ - "windows-link 0.1.3", -] - -[[package]] -name = "windows-sys" -version = "0.42.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a3e1820f08b8513f676f7ab6c1f99ff312fb97b553d30ff4dd86f9f15728aa7" -dependencies = [ - "windows_aarch64_gnullvm 0.42.2", - "windows_aarch64_msvc 0.42.2", - "windows_i686_gnu 0.42.2", - "windows_i686_msvc 0.42.2", - "windows_x86_64_gnu 0.42.2", - "windows_x86_64_gnullvm 0.42.2", - "windows_x86_64_msvc 0.42.2", -] - -[[package]] -name = "windows-sys" -version = "0.59.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1e38bc4d79ed67fd075bcc251a1c39b32a1776bbe92e5bef1f0bf1f8c531853b" -dependencies = [ - "windows-targets", -] - -[[package]] -name = "windows-targets" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9b724f72796e036ab90c1021d4780d4d3d648aca59e491e6b98e725b84e99973" -dependencies = [ - "windows_aarch64_gnullvm 0.52.6", - "windows_aarch64_msvc 0.52.6", - "windows_i686_gnu 0.52.6", - "windows_i686_gnullvm", - "windows_i686_msvc 0.52.6", - "windows_x86_64_gnu 0.52.6", - "windows_x86_64_gnullvm 0.52.6", - "windows_x86_64_msvc 0.52.6", -] - -[[package]] -name = "windows-threading" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b66463ad2e0ea3bbf808b7f1d371311c80e115c0b71d60efc142cafbcfb057a6" -dependencies = [ - "windows-link 0.1.3", -] - -[[package]] -name = "windows_aarch64_gnullvm" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "597a5118570b68bc08d8d59125332c54f1ba9d9adeedeef5b99b02ba2b0698f8" - -[[package]] -name = "windows_aarch64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32a4622180e7a0ec044bb555404c800bc9fd9ec262ec147edd5989ccd0c02cd3" - -[[package]] -name = "windows_aarch64_msvc" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e08e8864a60f06ef0d0ff4ba04124db8b0fb3be5776a5cd47641e942e58c4d43" - -[[package]] -name = "windows_aarch64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "09ec2a7bb152e2252b53fa7803150007879548bc709c039df7627cabbd05d469" - -[[package]] -name = "windows_i686_gnu" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c61d927d8da41da96a81f029489353e68739737d3beca43145c8afec9a31a84f" - -[[package]] -name = "windows_i686_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8e9b5ad5ab802e97eb8e295ac6720e509ee4c243f69d781394014ebfe8bbfa0b" - -[[package]] -name = "windows_i686_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0eee52d38c090b3caa76c563b86c3a4bd71ef1a819287c19d586d7334ae8ed66" - -[[package]] -name = "windows_i686_msvc" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "44d840b6ec649f480a41c8d80f9c65108b92d89345dd94027bfe06ac444d1060" - -[[package]] -name = "windows_i686_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "240948bc05c5e7c6dabba28bf89d89ffce3e303022809e73deaefe4f6ec56c66" - -[[package]] -name = "windows_x86_64_gnu" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8de912b8b8feb55c064867cf047dda097f92d51efad5b491dfb98f6bbb70cb36" - -[[package]] -name = "windows_x86_64_gnu" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "147a5c80aabfbf0c7d901cb5895d1de30ef2907eb21fbbab29ca94c5b08b1a78" - -[[package]] -name = "windows_x86_64_gnullvm" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "26d41b46a36d453748aedef1486d5c7a85db22e56aff34643984ea85514e94a3" - -[[package]] -name = "windows_x86_64_gnullvm" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "24d5b23dc417412679681396f2b49f3de8c1473deb516bd34410872eff51ed0d" - -[[package]] -name = "windows_x86_64_msvc" -version = "0.42.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9aec5da331524158c6d1a4ac0ab1541149c0b9505fde06423b02f5ef0106b9f0" - -[[package]] -name = "windows_x86_64_msvc" -version = "0.52.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "589f6da84c646204747d1270a2a5661ea66ed1cced2631d546fdfb155959f9ec" - -[[package]] -name = "wit-bindgen" -version = "0.46.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f17a85883d4e6d00e8a97c586de764dabcc06133f7f1d55dce5cdc070ad7fe59" - -[[package]] -name = "zerocopy" -version = "0.7.35" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1b9b4fd18abc82b8136838da5d50bae7bdea537c574d8dc1a34ed098d6c166f0" -dependencies = [ - "byteorder", - "zerocopy-derive", -] - -[[package]] -name = "zerocopy-derive" -version = "0.7.35" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fa4f8080344d4671fb4e831a13ad1e68092748387dfc4f55e356242fae12ce3e" -dependencies = [ - "proc-macro2", - "quote", - "syn 2.0.110", -] diff --git a/src/rust/Cargo.toml b/src/rust/Cargo.toml index 2ee9e7262..7d784d7ec 100755 --- a/src/rust/Cargo.toml +++ b/src/rust/Cargo.toml @@ -9,8 +9,10 @@ name = 'pm_rs' [dependencies] extendr-api = '*' -pmcore = {version ="=0.21.1", features = ["exa"]} # pmcore = { path = "../../../PMcore", features = ["exa"] } +# pmcore = { git = "https://github.com/LAPKB/PMcore", branch = "feat/new-bestdose-api", features = ["exa"] } +pmcore = { version = "=0.22.1", features = ["exa"] } +libloading = "0.9" rayon = "1.10.0" anyhow = "1.0.97" diff --git a/src/rust/src/executor.rs b/src/rust/src/executor.rs index 2866673a7..2f22bbabe 100755 --- a/src/rust/src/executor.rs +++ b/src/rust/src/executor.rs @@ -42,7 +42,7 @@ pub(crate) fn fit( let data = data::read_pmetrics(data.to_str().unwrap()).expect("Failed to read data"); //dbg!(&data); let mut algorithm = dispatch_algorithm(settings, eq, data)?; - let result = algorithm.fit()?; + let mut result = algorithm.fit()?; result.write_outputs()?; Ok(()) } diff --git a/src/rust/src/lib.rs b/src/rust/src/lib.rs index d280ceff1..5c5028b63 100755 --- a/src/rust/src/lib.rs +++ b/src/rust/src/lib.rs @@ -1,4 +1,5 @@ // mod build; + mod executor; mod logs; mod settings; @@ -117,7 +118,6 @@ fn simulate_all( rows.into_dataframe().unwrap() } - /// Fits the model at the given path to the data at the given path using the provided parameters. /// @param model_path Path to the compiled model file. /// @param data Path to the data file. @@ -276,10 +276,10 @@ fn setup_logs() -> anyhow::Result<()> { use tracing_subscriber::filter::LevelFilter; // Create a subscriber with our custom layer using the global timer - // Filter to show only INFO and above (INFO, WARN, ERROR) + // Filter to show only WARN and above (WARN, ERROR) by default let subscriber = tracing_subscriber::registry() .with(RFormatLayer::new()) - .with(LevelFilter::from_level(Level::INFO)); + .with(LevelFilter::from_level(Level::WARN)); // Set as global default - this will fail if already set, which is fine // We just ignore the error @@ -288,9 +288,10 @@ fn setup_logs() -> anyhow::Result<()> { Ok(()) } -// Macro to generate exports. -// This ensures exported functions are registered with R. -// See corresponding C code in `entrypoint.c`. + + + + extendr_module! { mod Pmetrics; fn simulate_one; @@ -302,9 +303,10 @@ extendr_module! { fn model_parameters; fn temporary_path; fn setup_logs; + } // To generate the exported function in R, run the following command: // rextendr::document() // Optional: reload Pmetrics -// devtools::load_all() \ No newline at end of file +// devtools::load_all() diff --git a/src/rust/src/settings.rs b/src/rust/src/settings.rs index 72da7057f..8a23163d9 100755 --- a/src/rust/src/settings.rs +++ b/src/rust/src/settings.rs @@ -90,6 +90,7 @@ pub(crate) fn settings( settings.set_prior(prior); settings.set_output_path(output_path.to_string()); settings.set_write_logs(true); + settings.set_log_level(LogLevel::INFO); settings.write()?; Ok(settings) } diff --git a/vignettes/Citations.bib b/vignettes/Citations.bib deleted file mode 100755 index 4aed171d9..000000000 --- a/vignettes/Citations.bib +++ /dev/null @@ -1,33 +0,0 @@ - -@article{goutelle_nonparametric_2022, - title = {Nonparametric {Methods} in {Population} {Pharmacokinetics}}, - volume = {62}, - issn = {0091-2700, 1552-4604}, - url = {https://onlinelibrary.wiley.com/doi/10.1002/jcph.1650}, - doi = {10.1002/jcph.1650}, - abstract = {Population pharmacokinetic (PK) modeling is a widely used approach to analyze PK data obtained from groups of individuals, in both industry and academic research. The approach can also be used to analyze pharmacodynamic (PD) data and pooled PK/PD data. There are 2 main families of population PK methods: parametric and nonparametric. The objectives of this article are to present an overview of nonparametric methods used in population pharmacokinetic modeling and to explain their specific characteristics to inform scientists and clinicians about their potential value for data analysis, simulation, dosage design, and therapeutic drug monitoring (TDM). Nonparametric methods have several interesting characteristics for population PK analysis, including computation of exact likelihoods, the ability to accommodate parameter probability distributions of any shape (eg, non-Gaussian), and to detect subpopulations and outliers. Nonparametric population methods are also highly relevant for model-based TDM and design of individualized drug dosage regimens. Several algorithms have been developed to estimate model parameter values within an individual and compute that individual’s dosage to achieve target drug exposure with maximum precision and accuracy. Nonparametric modeling methods for both population and individual PK analysis are available under user-friendly packages.}, - language = {en}, - number = {2}, - urldate = {2022-01-21}, - journal = {The Journal of Clinical Pharmacology}, - author = {Goutelle, Sylvain and Woillard, Jean‐Baptiste and Neely, Michael and Yamada, Walter and Bourguignon, Laurent}, - month = feb, - year = {2022}, - pages = {142--157}, - file = {Goutelle et al. - 2022 - Nonparametric Methods in Population Pharmacokineti.pdf:/Users/mneely/Zotero/storage/4BPIKLTX/Goutelle et al. - 2022 - Nonparametric Methods in Population Pharmacokineti.pdf:application/pdf}, -} - -@article{bealWaysFitPK2001a, - title = {Ways to Fit a {{PK}} Model with Some Data below the Quantification Limit.}, - author = {Beal, S.L.}, - year = 2001, - month = oct, - journal = {Journal of Pharmacokinetics and Pharmacodynamics}, - volume = {28}, - number = {5}, - pages = {481--504}, - abstract = {Pharmacokinetic data consist of drug concentration measurements, as well as reports of some measured concentrations being below the quantification limit of the assay (BQL). A pharmacokinetic model may befit to these data, and for this purpose, the BQL observations must be either discarded or handled in a special way. In this paper, seven methods for dealing with BQL observations are evaluated. Both single-subject and population data are simulated from a one-compartment model. A moderate amount of data is simulated for each individual. The actual cv of concentration measurements at the quantification limit is assumed to be no greater than 20\%, in accord with the FDA Guidance. The results of this paper should be interpreted in this context. The methods include handling BQL observations as fixed-point censored observations, i.e., by using the likelihoods that these observations are in fact BQL. This method is shown to have some overall statistical advantage. However, the gain in using this method over that of simply discarding the BQL observations is not always much, and this is especially so when the frequency of BQL observations is small. Some simple methods entailing (i) replacing one or more BQL observations with the value 0, or (ii) replacing them with the value QL/2, where QL is the quantification limit, are also included. The first of these two approaches should not be used With population data, use of the second approach can result in some noticeably improved estimation of the typical value of a parameter, but then there is also marked degradation in the estimation of the population variance of the parameter.}, - langid = {english}, - pmid = {11768292}, - file = {/Users/mneely/Zotero/storage/RQW9SN7C/J Pharmacokinet Pharmacodyn 2001 Beal.pdf} -} diff --git a/vignettes/Data/ObjectsLegacy.csv b/vignettes/Data/ObjectsLegacy.csv deleted file mode 100755 index 1fee0e65b..000000000 --- a/vignettes/Data/ObjectsLegacy.csv +++ /dev/null @@ -1,81 +0,0 @@ -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" -,\$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. -,\$id,Subject identification -,\$obs,Observation -,\$obsSD,Calculated standard deviation (error) of the observation based on the assay error polynomial -,\$outeq, -,\$pred,Predicted value -,\$pred.type,"Type of prediction, i.e. based on the population parameter values or Bayesian posterior parameter values" -,\$time,Observation time in relative decimal hours -,\$wd,"\$d, weighted by the \$obsSD" -,\$wds,"\$ds, weighted by the \$obsSD" -"final (class: PMfinal, list)",\$ab,"Matrix of boundaries for random parameter values. For NPAG, this is specified by the user prior to the run; for IT2B, it is calculated as a user specified multiple of the SD for the parameter value distribution" -,\$gridpts,(NPAG only) The initial number of support points -,\$popCor,The final cycle correlation matrix for each random parameter distribution -,\$popCov,The final cycle covariance matrix for each random parameter distribution -,\$popCV,The final cycle coefficient of variation for each random parameter distribution -,\$popMean,The final cycle mean for each random parameter distribution -,\$popMedian,The final cycle median for each random parameter distribution -,\$popPoints,(NPAG only) Data.frame of the final cycle joint population density of grid points with column names equal to the name of each random parameter plus \$prob for the associated probability of that point -,\$popRanFix,The final cycle values for all fixed but random parameters -,\$popSD,The final cycle standard deviation for each random parameter distribution -,\$popVar,The final cycle variance for each random parameter distribution -,\$postCor,An array of correlation matrices for posterior parameter values for each subject -,\$postCov,An array of covariance matrices for posterior parameter values for each subject -,\$postMean,A matrix of means of posterior distributions for each subject and parameter -,\$postPoints,"(NPAG only) Data frame of the Bayesian posterior parameter points for each of the first 100 subjects, with the following columns:" -,,id: subject ID -,,point: point number for that subject -,,parameters: parameters in the model -,,prob: probability of each point in the posterior for each patient -,\$postSD,A matrix of SDs of posterior distributions for each subject and parameter -,\$postVar,A matrix of variances of posterior distributions for each subject and parameter -,\$shrinkage,Shrinkage values for each random population parameter -"cycle (class: PMcycle, list)",\$aic,A matrix of cycle number and Akaike Information Criterion at each cycle -,\$bic,A matrix of cycle number and Bayesian (Schwartz) Information Criterion at each cycle -,\$gamlam,A matrix of cycle number and gamma or lambda at each cycle (see item #16 under NPAG Runs below for a discussion of gamma and lambda) -,\$ll,Matrix of cycle number and -2*Log-likelihood at each cycle -,\$mean,"A matrix of cycle number and the mean of each random parameter at each cycle, normalized to initial mean" -,\$median,"A matrix of cycle number and the median of each random parameter at each cycle, normalized to initial standard deviation" -,\$names,Vector of names of the random parameters -,\$sd,"A matrix of cycle number and the standard deviation of each random parameter at each cycle, normalized to initial standard deviation" -"cov (class: PMcov, data.frame)",\$icen,Median (default) or mean of the covariates and parameter value distributions. -,\$id,Subject identification -,\$time,Time for each covariate entry -,covariates...,"Covariate values for each subject at each time, extracted from the raw data file" -,parameters...,"Mean, median, or mode of Bayesian posterior distribution for each random parameter in the model. Mode summaries are available for NPAG output only, and the default is median. Values are recycled for each row within a given subject, with the number of rows driven by the number of covariate entries" -"pop (class: PMpop, data.frame)",\$id,Subject identification -"post (class: PMpost, data.frame)",\$time,"Time of each prediction at a frequency specified in the NPrun() command, with a default of 12 minutes." -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 -"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. -,, -This object will only be present if you have run \$validate(…) after a run is completed. ,, -"valid\$simdata (class: PMsim, list)",\$obs,"A data frame with \$id, \$time, \$out, \$outeq columns containing simulated observations at each time and output equation number in the template data file. If simulations from multiple template subjects have been combined (see Simulator Runs), then \$id will be of the form x.y, where x is the simulation number, and y is the template number." -,, -,, -,\$amt,"A data frame with \$id, \$time, \$out, \$comp columns containing simulated amounts in each compartment." -,\$parValues,"A data frame with \$id, ... columns containing the parameter value sets for each simulated subject with “...” signifying the columns named according to the names of the random parameters in the model" -,\$totalSets,"The total number of simulated sets of parameters, which may be greater than the requested number if limits were specified in the simulation (see Simulator Runs)." -,\$totalMeans,The means of the parameter values in the total simulated sets which can be used as a check of the adequacy of the simulation to reproduce the requested mean values when limits were applied. The final truncated set will likely not have the requested mean values. -,\$totalCov,The covariances of the parameter values in the total simulated sets which can be used as a check of the adequacy of the simulation to reproduce the requested covariance values when limits were applied. The final truncated set will likely not have the requested covariance values. -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. -,\$tad,Time after dose -,\$PRED_bin,Median prediction for each bin -,\$pcObs,Prediction corrected observation (based on bin) -,\$timeBinNum,Number of each time bin -,\$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 diff --git a/vignettes/Data/ObjectsR6.csv b/vignettes/Data/ObjectsR6.csv deleted file mode 100755 index e106368bc..000000000 --- a/vignettes/Data/ObjectsR6.csv +++ /dev/null @@ -1,107 +0,0 @@ -Objects,Fields,Comments -"cov (class: PM_cov, R6)",$clone,Method: Create copy of PM_cov object -,$data,"Data frame, class: PM_cov_data, with columns:" -,,id: Subject identification -,,time: Time for each covariate entry -,,"covariates...Covariate values for each subject at each time, extracted from the raw data file" -,,"parameters...Mean, median, or mode of Bayesian posterior distribution for each random parameter in the model. Mode summaries are available for NPAG output only, and the default is median. Values are recycled for each row within a given subject, with the number of rows driven by the number of covariate entries" -,,icen: Median (default) or mean of the covariates and parameter value distributions. -,$initialize,"Method: Called by PM_cov\$new(), creates new PM_cov object, happens automatically at end of run, generally not a user function" -,$plot,Method: Plot the PM_cov object with plot.PMcov() -,$print,Method: display the PM_cov object as a data frame -,$summary,"Method: summarize the PM_cov object with summary.PMcov(), same function as for Legacy" -"cycle (class: PM_cycle, R6)",$clone,Method: Create copy of PM_cycle object -,$data,"List with all data fields, class: PM_cycle_data" -,$gamlam,A matrix of cycle number and gamma or lambda at each cycle (see item #16 under NPAG Runs below for a discussion of gamma and lambda) -,$initialize,"Method: Called by PM_cycle\$new(), creates new PM_cycle object, happens automatically at end of run, generally not a user function" -,$mean,"A matrix of cycle number and the mean of each random parameter at each cycle, normalized to initial mean" -,$median,"A matrix of cycle number and the median of each random parameter at each cycle, normalized to initial standard deviation" -,$names,Vector of names of the random parameters -,$objective,"A matrix of cycle number and -2*Log-likelihood (-2*LL), Akaike Information Criterion (AIC), and Bayesian (Schwartz) Information Criterion (BIC) at each cycle" -,$plot,Method: Plot the PM_cycle object with plot.PMcycle() -,$sd,"A matrix of cycle number and the standard deviation of each random parameter at each cycle, normalized to initial standard deviation" -"data (class: PM_data, R6)",See Pmetrics Input Files.,Your original raw data file. -"final (class: PM_final, R6)",$ab,"Matrix of boundaries for random parameter values. For NPAG, this is specified by the user prior to the run; for IT2B, it is calculated as a user specified multiple of the SD for the parameter value distribution" -,$clone,Method: Create copy of PM_final object -,$data,"Data frame with all data fields, class: PM_final_data" -,$gridpts,(NPAG only) The initial number of support points -,$initialize,"Method: Called by PM_fiinal\$new(), creates new PM_final object, happens automatically at end of run, generally not a user function" -,$nsub,Number of subjects -,$plot,Method: Plot the PM_final object with plot.PM_final() -,$popCor,The final cycle correlation matrix for each random parameter distribution -,$popCov,The final cycle covariance matrix for each random parameter distribution -,$popCV,The final cycle coefficient of variation for each random parameter distribution -,$popMean,The final cycle mean for each random parameter distribution -,$popMedian,The final cycle median for each random parameter distribution -,$popPoints,(NPAG only) Data frame of the final cycle joint population density of grid points with column names equal to the name of each random parameter plus \$prob for the associated probability of that point -,$popRanFix,The final cycle values for all fixed but random parameters -,$popSD,The final cycle standard deviation for each random parameter distribution -,$popVar,The final cycle variance for each random parameter distribution -,$postCor,An array of correlation matrices for posterior parameter values for each subject -,$postCov,An array of covariance matrices for posterior parameter values for each subject -,$postMean,A matrix of means of posterior distributions for each subject and parameter -,$postPoints,"(NPAG only) Data frame of the Bayesian posterior parameter points for each of the first 100 subjects, with the following columns:" -,,id: subject ID -,,point: point number for that subject -,,parameters: parameters in the model -,,prob: probability of each point in the posterior for each patient -,$postSD,A matrix of SDs of posterior distributions for each subject and parameter -,$postVar,A matrix of variances of posterior distributions for each subject and parameter -,$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: makeAUC() 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" -,$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" -,$ds,Squared difference between pred and obs -,$icen,Median (default) or mean of the parameter distributions used to calculate the predicted values. -,$id,Subject identification -,$initialize,"Method: Called by PM_op\$new(), creates new PM_op object, happens automatically at end of run, generally not a user function" -,$obs,Observation -,$obsSD,Calculated standard deviation (error) of the observation based on the assay error polynomial -,$outeq,Output equation for each observation -,$cens,"If any observation is censored (bloq, aloq) or none." -,$plot,Method: Plot the PM_op object with plot.PM_op() -,$pred,Predicted value -,$pred.type,"Type of prediction, i.e. based on the population parameter values or Bayesian posterior parameter values" -,$summary,"Method: summarize the PM_op object with summary.PMop(), same function as for Legacy" -,$time,Observation time in relative decimal hours -,$wd,"\$d, weighted by the \$obsSD" -,$wds,"\$ds, weighted by the \$obsSD" -"pop (class: PM_pop, R6)",$auc,Method: makeAUC() to calculate area under time concentration curve -"post (class: PM_post, R6)",$block,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. -,$id,Subject identification -,$initialize,"Method: Called by PM_pop\$new() or PM_post\$new(), creates new PM_pop or PM_post object, happens automatically at end of run, generally not a user function" -,$outeq,Output equation for each prediction -,$pred,Population prior (PMpop) or Bayesian posterior (PMpost) predictions for each output equation -,$time,"Time of each prediction at a frequency specified in the NPrun() command, with a default of 12 minutes." -"valid (class: PM_valid, R6)","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. -This object will only be present if you have run $validate(…) after a run is completed. ,, -"valid$simdata (class: PM_sim, R6)",$amt,"A data frame with \$id, \$time, \$out, \$comp columns containing simulated amounts in each compartment." -,$auc,Method: calculate area under the curves of simulated profiles using makeAUC() -,$clone,Method: Create copy -,$data,A list with all the fields in \$simdata -,$obs,"A data frame with \$id, \$time, \$out, \$outeq columns containing simulated observations at each time and output equation number in the template data file. If simulations from multiple template subjects have been combined (see Simulator Runs), then \$id will be of the form x.y, where x is the simulation number, and y is the template number." -,$parValues,"A data frame with \$id, ... columns containing the parameter value sets for each simulated subject with “...” signifying the columns named according to the names of the random parameters in the model" -,$pta,Method: perform a probability of target attainment using PM_pta$new() -,$summary,Method: summarize simulation -,$totalSets,"The total number of simulated sets of parameters, which may be greater than the requested number if limits were specified in the simulation (see Simulator Runs)." -,$totalMeans,The means of the parameter values in the total simulated sets which can be used as a check of the adequacy of the simulation to reproduce the requested mean values when limits were applied. The final truncated set will likely not have the requested mean values. -,$totalCov,The covariances of the parameter values in the total simulated sets which can be used as a check of the adequacy of the simulation to reproduce the requested covariance values when limits were applied. The final truncated set will likely not have the requested covariance values. -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. -,$tad,Time after dose -,$PRED_bin,Median prediction for each bin -,$pcObs,Prediction corrected observation (based on bin) -,$timeBinNum,Number of each time bin -,$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 diff --git a/vignettes/Data/PM_result.xlsx b/vignettes/Data/PM_result.xlsx deleted file mode 100755 index 78a6ee668..000000000 Binary files a/vignettes/Data/PM_result.xlsx and /dev/null differ diff --git a/vignettes/Data/PM_result_fields.csv b/vignettes/Data/PM_result_fields.csv deleted file mode 100644 index 39391c828..000000000 --- a/vignettes/Data/PM_result_fields.csv +++ /dev/null @@ -1,73 +0,0 @@ -Objects,Fields,Methods,Comments -$op (class: PM_op),$id,,Subject identification -,$time,,Observation time in relative decimal hours -,$obs,,Observation -,$cens,,"If any observation is censored (bloq, aloq) or none." -,$pred,,Predicted value -,$pred.type,,"Type of prediction, i.e. based on the population parameter values or Bayesian posterior parameter values" -,$icen,,Median (default) or mean of the parameter distributions used to calculate the predicted values. -,$outeq,,Output equation number -,$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" -,$obsSD,,Calculated standard deviation (error) of the observation based on the assay error polynomial -,$d,,Difference between pred and obs -,$ds,,Squared difference between pred and obs -,$wd,,"\$d, weighted by the \$obsSD" -,$wds,,"\$ds, weighted by the \$obsSD" -,$data,,All of the above fields as a single data frame -,,$plot,See plot.PMop for details -,,$summary,See summary.PMop for details -,,$auc,See makeAUC for details -$final (class: PM_final),$popPoints,,(NPAG only) Data frame of the final cycle joint population density of grid points with column names equal to the name of each random parameter plus \$prob for the associated probability of that point -,$popMean,,The final cycle mean for each random parameter distribution -,$popSD,,The final cycle standard deviation for each random parameter distribution -,$popCV,,The final cycle coefficient of variation for each random parameter distribution -,$popVar,,The final cycle variance for each random parameter distribution -,$popCov,,The final cycle covariance matrix for each random parameter distribution -,$popCor,,The final cycle correlation matrix for each random parameter distribution -,$popMedian,,The final cycle median for each random parameter distribution -,$popRanFix,,The final cycle values for all fixed but random parameters -,$postPoints,,"(NPAG only) Data frame of the Bayesian posterior parameter points for each of the first 100 subjects, with the following columns:" -,,,id: subject ID -,,,point: point number for that subject -,,,parameters: parameters in the model -,,,prob: probability of each point in the posterior for each patient -,$postMean,,A matrix of means of posterior distributions for each subject and parameter -,$postSD,,A matrix of SDs of posterior distributions for each subject and parameter -,$postVar,,A matrix of variances of posterior distributions for each subject and parameter -,$postCov,,An array of covariance matrices for posterior parameter values for each subject -,$postCor,,An array of correlation matrices for posterior parameter values for each subject -,$gridpts,,(NPAG only) The initial number of support points -,$ab,,"Matrix of boundaries for random parameter values. For NPAG, this is specified by the user prior to the run; for IT2B, it is calculated as a user specified multiple of the SD for the parameter value distribution" -,$data,,All of the above fields as a single list -,,$plot,See plot.PMfinal for details -,,$summary,See summary.PMfinal for details -$cycle (class: PM_cycle),$names,,Vector of names of the random parameters -,$ll,,Matrix of cycle number and -2*Log-likelihood at each cycle -,$gamlam,,A matrix of cycle number and gamma or lambda at each cycle (see item #16 under NPAG Runs below for a discussion of gamma and lambda) -,$mean,,"A matrix of cycle number and the mean of each random parameter at each cycle, normalized to initial mean" -,$sd,,"A matrix of cycle number and the standard deviation of each random parameter at each cycle, normalized to initial standard deviation" -,$median,,"A matrix of cycle number and the median of each random parameter at each cycle, normalized to initial standard deviation" -,$aic,,A matrix of cycle number and Akaike Information Criterion at each cycle -,$bic,,A matrix of cycle number and Bayesian (Schwartz) Information Criterion at each cycle -,$data,,All of the above fields as a single list -,,$plot,See plot.PMcycle for details -$cov (class: PM_cov),$id,,Subject identification -,$time,,Time for each covariate entry -,covariates...,,"Covariate values for each subject at each time, extracted from the raw data file" -,parameters...,,"Mean, median, or mode of Bayesian posterior distribution for each random parameter in the model. Mode summaries are available for NPAG output only, and the default is median. Values are recycled for each row within a given subject, with the number of rows driven by the number of covariate entries" -,$icen,,Median (default) or mean of the covariates and parameter value distributions. -,$data,,All of the above fields as a single list -,,$plot,See plot.PMcov for details -,,$summary,See summary.PMcov for details -$pop (class: PM_pop),$id,,Subject identification -$post (class: PM_post),$time,,"Time of each prediction at a frequency specified in the NPrun() command, with a default of 12 minutes." -(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 -,,$auc,See makeAUC for details -,,$nca,See makeNCA for details -$data (class: PM_data),,,"Your original raw data object , see PM_data for details" -$model (class: PM_model),,,"Your original model object, see PM_model for details" -$errfile,,,Name of error file if it exists -$success,,,Boolean for successful run \ No newline at end of file diff --git a/vignettes/Data/PM_result_methods.csv b/vignettes/Data/PM_result_methods.csv deleted file mode 100644 index 0e98c7d0d..000000000 --- a/vignettes/Data/PM_result_methods.csv +++ /dev/null @@ -1,12 +0,0 @@ -Methods,Comments -$new,"This method is not called directly, but new PM_result objects are created using PM_load()" -$plot,"Alternative method to plot objects, e.g. PM_result$plot(""op"") = PM_result$op$plot() = plot(PM_result$op)" -$summary,"Alternative method to summarize objects, e.g. PM_result$summary(""final"") = PM_result$final$summary() = summary(PM_result$final)" -$fit,Fit data using the model in the PM_result object -$auc,"Calculate auc by supplying a src, e.g. PM_result$auc(""op"")" -$report,Regenerate the report -$sim,Simulate using the model in the PM_result object -$save,Save the PM_result object -$validate,Validate by simuation to create VPC or NPDE as a PM_valid object -$step,Stepwise forward/backward linear regression between covariates and model parameter values -$opt,Optimal sampling to create a PM_opt object \ No newline at end of file diff --git a/vignettes/Data/R6_Legacy_compare.xlsx b/vignettes/Data/R6_Legacy_compare.xlsx deleted file mode 100755 index 146afb938..000000000 Binary files a/vignettes/Data/R6_Legacy_compare.xlsx and /dev/null differ diff --git a/vignettes/Data/RLcomp_data.csv b/vignettes/Data/RLcomp_data.csv deleted file mode 100755 index f4b088fd6..000000000 --- a/vignettes/Data/RLcomp_data.csv +++ /dev/null @@ -1,7 +0,0 @@ -Function,R6,Legacy -Read data file,PM_data$new(),PMreadMatrix() -Check data file,Embedded in PM_data$new(),PMcheck() -Write data file,PM_data$save(),PMwriteMatrix() -Convert calendar dates and clock times,Embedded in PM_data$new(),PMmatrixReltime() -Convert from old USC\*PACK .wrk format,PMwrk2csv(),PMwrk2csv() -Convert from NONMEM ,NM2PM(),NM2PM() diff --git a/vignettes/Data/RLcomp_other.csv b/vignettes/Data/RLcomp_other.csv deleted file mode 100755 index a02cd82f9..000000000 --- a/vignettes/Data/RLcomp_other.csv +++ /dev/null @@ -1,4 +0,0 @@ -Function,R6,Legacy -Calculate AUC,"$auc() method for PM_result$op/$post/$pop, or PM_sim",makeAUC() -Simulate,PM_result$sim() or PM_sim$new(),SIMrun() -Probability of target attainment,PM_sim$pta() or PM_pta$new(),makePTA() diff --git a/vignettes/Data/RLcomp_valid.csv b/vignettes/Data/RLcomp_valid.csv deleted file mode 100755 index e7e246dea..000000000 --- a/vignettes/Data/RLcomp_valid.csv +++ /dev/null @@ -1,6 +0,0 @@ -Function,R6,Legacy -Compare models,"PM_compare(PM_result1, PMresult2,…)","PMcompare(1, 2, …)" -Plot residuals,"PM_result$op$plot(resid = T,…)","plot(op, resid = T)" -"Construct VPC, pcVPC, NPDE",PM_result$valid() or PM_valid$new(),makeValid() -"Plot VPC, pcVPC, NPDE",PM_valid$plot(),plot(PMvalid) -Stepwise covariate regression,PM_result$step(),PMstep() \ No newline at end of file diff --git a/vignettes/Data/fortran1.csv b/vignettes/Data/fortran1.csv deleted file mode 100755 index 9ad8b9a6f..000000000 --- a/vignettes/Data/fortran1.csv +++ /dev/null @@ -1,6 +0,0 @@ -Arithmetic Operator,Meaning -+,addition --,subtraction -*,multiplication -/,division -**,exponentiation \ No newline at end of file diff --git a/vignettes/Data/fortran2.csv b/vignettes/Data/fortran2.csv deleted file mode 100755 index 2f8baa9ff..000000000 --- a/vignettes/Data/fortran2.csv +++ /dev/null @@ -1,7 +0,0 @@ -Relational Operator,Alternative,Meaning -\<,.LT.,less than -\<=,.LE.,less than or equal -\>,.GT.,greater than -\>=,.GE.,greater than or equal -==,.EQ.,equal -/=,.NE.,not equal \ No newline at end of file diff --git a/vignettes/Data/mdata.csv b/vignettes/Data/mdata.csv deleted file mode 100755 index 6a9f15e2b..000000000 --- a/vignettes/Data/mdata.csv +++ /dev/null @@ -1,14 +0,0 @@ -ID,EVID,TIME,DUR,DOSE,ADDL,II,INPUT,OUT,OUTEQ,CENS,C0,C1,C2,C3,COV -GH,1,0,0,400,.,.,1,.,.,.,.,.,.,.,10 -GH,0,0.5,.,.,.,.,.,0.42,1,none,.,.,.,.,. -GH,0,1,.,.,.,.,.,0.46,1,none,.,.,.,.,. -GH,0,2,.,.,.,.,.,2.47,1,none,.,.,.,.,. -GH,4,0,0,150,.,.,1,.,.,.,.,.,.,.,. -GH,1,3.5,0.5,150,.,.,1,.,.,.,.,.,.,.,. -GH,0,5.12,.,.,.,.,.,0.55,1,none,.,.,.,.,. -GH,0,24,.,.,.,.,.,0.52,1,none,.,.,.,.,. -1423,1,0,1,400,-1,12,1,.,.,.,.,.,.,.,34.5 -1423,1,0.1,0,100,.,.,2,.,.,.,.,.,.,.,. -1423,0,1,.,.,.,.,.,-99,1,none,0.01,0.1,0,0,. -1423,0,2,.,.,.,.,.,0.38,1,none,0.01,0.1,0,0,. -1423,0,2,.,.,.,.,.,1.6,2,none,0.05,0.2,-0.11,0.002,. \ No newline at end of file diff --git a/vignettes/Data/reserved.csv b/vignettes/Data/reserved.csv deleted file mode 100755 index 950f3d3e3..000000000 --- a/vignettes/Data/reserved.csv +++ /dev/null @@ -1,9 +0,0 @@ -Reserved Variable,Function in Pmetrics -t,time -x,array of compartment amounts -dx,array of first derivative of compartment amounts -p,array of primary parameters -rateiv / r,infusion vector -bolus / b,bolus vector -cov,covariate hashmap -y,output vector \ No newline at end of file diff --git a/vignettes/Images/Pmetrics_logo.png b/vignettes/Images/Pmetrics_logo.png deleted file mode 100755 index 4e724d274..000000000 Binary files a/vignettes/Images/Pmetrics_logo.png and /dev/null differ diff --git a/vignettes/Images/Rlogo.png b/vignettes/Images/Rlogo.png deleted file mode 100644 index be48e3074..000000000 Binary files a/vignettes/Images/Rlogo.png and /dev/null differ diff --git a/vignettes/Images/Slide1.png b/vignettes/Images/Slide1.png deleted file mode 100755 index be28fc4c1..000000000 Binary files a/vignettes/Images/Slide1.png and /dev/null differ diff --git a/vignettes/Images/Slide2.png b/vignettes/Images/Slide2.png deleted file mode 100755 index a77bef734..000000000 Binary files a/vignettes/Images/Slide2.png and /dev/null differ diff --git a/vignettes/Images/downloadPNG.png b/vignettes/Images/downloadPNG.png deleted file mode 100755 index a68f42190..000000000 Binary files a/vignettes/Images/downloadPNG.png and /dev/null differ diff --git a/vignettes/Images/export.png b/vignettes/Images/export.png deleted file mode 100755 index b17e15bb2..000000000 Binary files a/vignettes/Images/export.png and /dev/null differ diff --git a/vignettes/Images/installPkg.png b/vignettes/Images/installPkg.png deleted file mode 100755 index 08733da3e..000000000 Binary files a/vignettes/Images/installPkg.png and /dev/null differ diff --git a/vignettes/Images/model_builder/covariates.png b/vignettes/Images/model_builder/covariates.png deleted file mode 100755 index 1efe665da..000000000 Binary files a/vignettes/Images/model_builder/covariates.png and /dev/null differ diff --git a/vignettes/Images/model_builder/eqn.png b/vignettes/Images/model_builder/eqn.png deleted file mode 100755 index 4b83c95fd..000000000 Binary files a/vignettes/Images/model_builder/eqn.png and /dev/null differ diff --git a/vignettes/Images/model_builder/front.png b/vignettes/Images/model_builder/front.png deleted file mode 100755 index 6ecc11a4d..000000000 Binary files a/vignettes/Images/model_builder/front.png and /dev/null differ diff --git a/vignettes/Images/model_builder/lag.png b/vignettes/Images/model_builder/lag.png deleted file mode 100755 index fc43d9169..000000000 Binary files a/vignettes/Images/model_builder/lag.png and /dev/null differ diff --git a/vignettes/Images/model_builder/output.png b/vignettes/Images/model_builder/output.png deleted file mode 100755 index 542b010cd..000000000 Binary files a/vignettes/Images/model_builder/output.png and /dev/null differ diff --git a/vignettes/Images/model_builder/output2.png b/vignettes/Images/model_builder/output2.png deleted file mode 100755 index 821b28f78..000000000 Binary files a/vignettes/Images/model_builder/output2.png and /dev/null differ diff --git a/vignettes/Images/model_builder/primary.png b/vignettes/Images/model_builder/primary.png deleted file mode 100755 index 5bc082ad5..000000000 Binary files a/vignettes/Images/model_builder/primary.png and /dev/null differ diff --git a/vignettes/Images/model_builder/secondary.png b/vignettes/Images/model_builder/secondary.png deleted file mode 100755 index db7e2c94c..000000000 Binary files a/vignettes/Images/model_builder/secondary.png and /dev/null differ diff --git a/vignettes/Images/multi-bv40.png b/vignettes/Images/multi-bv40.png deleted file mode 100755 index 730bd3261..000000000 Binary files a/vignettes/Images/multi-bv40.png and /dev/null differ diff --git a/vignettes/Images/plotBrowser.png b/vignettes/Images/plotBrowser.png deleted file mode 100755 index 67c7ea87a..000000000 Binary files a/vignettes/Images/plotBrowser.png and /dev/null differ diff --git a/vignettes/Images/pta1.png b/vignettes/Images/pta1.png deleted file mode 100755 index 24051bc42..000000000 Binary files a/vignettes/Images/pta1.png and /dev/null differ diff --git a/vignettes/Images/pta2.png b/vignettes/Images/pta2.png deleted file mode 100755 index 3c6a32ab6..000000000 Binary files a/vignettes/Images/pta2.png and /dev/null differ diff --git a/vignettes/Images/rust-logo-64x64.png b/vignettes/Images/rust-logo-64x64.png deleted file mode 100644 index 1eaa7709d..000000000 Binary files a/vignettes/Images/rust-logo-64x64.png and /dev/null differ diff --git a/vignettes/Images/schemaTop.png b/vignettes/Images/schemaTop.png deleted file mode 100755 index ad1e57f8a..000000000 Binary files a/vignettes/Images/schemaTop.png and /dev/null differ diff --git a/vignettes/Images/unibv40.png b/vignettes/Images/unibv40.png deleted file mode 100755 index 429c90feb..000000000 Binary files a/vignettes/Images/unibv40.png and /dev/null differ diff --git a/vignettes/Styles/style.css b/vignettes/Styles/style.css deleted file mode 100755 index 1b972a501..000000000 --- a/vignettes/Styles/style.css +++ /dev/null @@ -1,46 +0,0 @@ -.caption { - color: #777; - margin-top: 10px; -} - -.legacy { - background-color: #98a4a6; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.r6 { - background-color: #5296d5; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.update { - background-color: #d65645; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.to-be-reviewed { - background-color: red; - color: white; - text-shadow: 1px 1px black; - padding: 3px; -} - -.script { - font-family: Arial, Helvetica, sans-serif; - background-color: lightgrey; - color: #446e9b; -} - -/* Change color of section numbering */ -span.header-section-number { - color:rgb(191, 194, 193); -} diff --git a/vignettes/Styles/style_old.css b/vignettes/Styles/style_old.css deleted file mode 100755 index 91ca11c85..000000000 --- a/vignettes/Styles/style_old.css +++ /dev/null @@ -1,225 +0,0 @@ -.caption { - color: #777; - margin-top: 10px; -} - -.legacy { - background-color: #98a4a6; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.r6 { - background-color: #5296d5; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.update { - background-color: #d65645; - color: white; - text-shadow: 1px 1px black; - border-radius: 5px; - padding: 3px; -} - -.to-be-reviewed { - background-color: red; - color: white; - text-shadow: 1px 1px black; - padding: 3px; -} - -.script { - font-family: Arial, Helvetica, sans-serif; - background-color: lightgrey; - color: #446e9b; -} - - -body { -background-color: #fff; -margin: 1em auto; -max-width: 700px; -overflow: visible; -padding-left: 2em; -padding-right: 2em; -font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; -font-size: 14px; -line-height: 1.35; -} - -#TOC { -clear: both; -margin: 0 0 10px 10px; -padding: 4px; -width: 400px; -border: 1px solid #CCCCCC; -border-radius: 5px; -background-color: #f6f6f6; -font-size: 13px; -line-height: 1.3; -} -#TOC .toctitle { -font-weight: bold; -font-size: 15px; -margin-left: 5px; -} -#TOC ul { -padding-left: 40px; -margin-left: -1.5em; -margin-top: 5px; -margin-bottom: 5px; -} -#TOC ul ul { -margin-left: -2em; -} -#TOC li { -line-height: 16px; -} -table { -margin: 1em auto; -border-width: 1px; -border-color: #DDDDDD; -border-style: outset; -border-collapse: collapse; -} -table th { -border-width: 2px; -padding: 5px; -border-style: inset; -} -table td { -border-width: 1px; -border-style: inset; -line-height: 18px; -padding: 5px 5px; -} -table, table th, table td { -border-left-style: none; -border-right-style: none; -} -table thead, table tr.even { -background-color: #f7f7f7; -} -p { -margin: 0.5em 0; -} -blockquote { -background-color: #f6f6f6; -padding: 0.25em 0.75em; -} -hr { -border-style: solid; -border: none; -border-top: 1px solid #777; -margin: 28px 0; -} -dl { -margin-left: 0; -} -dl dd { -margin-bottom: 13px; -margin-left: 13px; -} -dl dt { -font-weight: bold; -} -ul { -margin-top: 0; -} -ul li { -list-style: circle outside; -} -ul ul { -margin-bottom: 0; -} -pre, code { -background-color: #f7f7f7; -border-radius: 3px; -color: #333; -white-space: pre-wrap; -} -pre { -border-radius: 3px; -margin: 5px 0px 10px 0px; -padding: 10px; -} -pre:not([class]) { -background-color: #f7f7f7; -} -code { -font-family: Consolas, Monaco, 'Courier New', monospace; -font-size: 85%; -} -p > code, li > code { -padding: 2px 0px; -} -div.figure { -text-align: center; -} -img { -background-color: #FFFFFF; -padding: 2px; -border: 1px solid #DDDDDD; -border-radius: 3px; -border: 1px solid #CCCCCC; -margin: 0 5px; -} -h1 { -margin-top: 0; -font-size: 35px; -line-height: 40px; -color: #5296d5; -} -h2 { -border-bottom: 4px solid #f7f7f7; -padding-top: 10px; -padding-bottom: 2px; -font-size: 145%; -} -h3 { -border-bottom: 2px solid #f7f7f7; -padding-top: 10px; -font-size: 120%; -} -h4 { -border-bottom: 1px solid #f7f7f7; -margin-left: 8px; -font-size: 105%; -} -h5, h6 { -border-bottom: 1px solid #ccc; -font-size: 105%; -} -a { -color: #0033dd; -text-decoration: none; -} -a:hover { -color: #6666ff; } -a:visited { -color: #800080; } -a:visited:hover { -color: #BB00BB; } -a[href^="http:"] { -text-decoration: underline; } -a[href^="https:"] { -text-decoration: underline; } - -code > span.kw { color: #555; font-weight: bold; } -code > span.dt { color: #902000; } -code > span.dv { color: #40a070; } -code > span.bn { color: #d14; } -code > span.fl { color: #d14; } -code > span.ch { color: #d14; } -code > span.st { color: #d14; } -code > span.co { color: #888888; font-style: italic; } -code > span.ot { color: #007020; } -code > span.al { color: #ff0000; font-weight: bold; } -code > span.fu { color: #900; font-weight: bold; } -code > span.er { color: #a61717; background-color: #e3d2d2; } \ No newline at end of file