Skip to content

Commit d53c20e

Browse files
mhovdmhovd
committed
Lint
1 parent daabff3 commit d53c20e

22 files changed

+1634
-1483
lines changed

‎R/PM_fit.R

Lines changed: 74 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ PM_fit <- R6::R6Class(
3030
model = NULL,
3131
#' @field backend Backend used for calculations; default is value in PMoptions.
3232
backend = NULL,
33-
33+
3434
#' @description
3535
#' Create a new object
3636
#' @param data Either the name of a [PM_data]
@@ -60,45 +60,45 @@ PM_fit <- R6::R6Class(
6060
if (!inherits(model, "PM_model")) {
6161
cli::cli_abort(c("x" = "{.code model} must be a {.cls PM_model} object"))
6262
}
63-
63+
6464
#### checks
65-
65+
6666
# covariates
6767
dataCov <- tolower(getCov(data)$covnames)
6868
modelCov <- tolower(sapply(model$model_list$cov, function(x) x$covariate))
69-
if(length(modelCov)==0){
69+
if (length(modelCov) == 0) {
7070
modelCov <- NA
7171
}
72-
if(!all(is.na(dataCov)) && !all(is.na(modelCov))){ # if there are covariates
73-
if(!identical(dataCov, modelCov)){ # if not identical, abort
72+
if (!all(is.na(dataCov)) && !all(is.na(modelCov))) { # if there are covariates
73+
if (!identical(dataCov, modelCov)) { # if not identical, abort
7474
msg <- glue::glue("Model covariates: {paste(modelCov, collapse = ', ')}; Data covariates: {paste(dataCov, collapse = ', ')}")
7575
cli::cli_abort(c(
7676
"x" = "Error: Covariates in data and model do not match.",
7777
"i" = msg
7878
))
7979
}
80-
}
81-
82-
#output equations
83-
80+
}
81+
82+
# output equations
83+
8484
if (!is.null(data$standard_data$outeq)) {
8585
dataOut <- max(data$standard_data$outeq, na.rm = TRUE)
8686
} else {
8787
dataOut <- 1
8888
}
89-
89+
9090
modelOut <- length(model$model_list$out)
91-
if(dataOut != modelOut){
91+
if (dataOut != modelOut) {
9292
cli::cli_abort(c(
9393
"x" = "Error: Number of output equations in data and model do not match.",
9494
"i" = "Check the number of output equations in the data and model."
9595
))
9696
}
97-
97+
9898
self$data <- data
9999
self$model <- model
100100
self$backend <- backend
101-
101+
102102
if (backend == "rust") {
103103
private$setup_rust_execution()
104104
}
@@ -111,10 +111,10 @@ PM_fit <- R6::R6Class(
111111
#' the simplest execution of this method is
112112
#' `$run()`.
113113
#' @param run Specify the run number of the output folder. Default if missing is the next available number.
114-
#' @param include Vector of subject id values in the data file to include in the analysis.
114+
#' @param include Vector of subject id values in the data file to include in the analysis.
115115
#' The default (missing) is all.
116116
#' @param exclude A vector of subject IDs to exclude in the analysis, e.g. `c(4,6:14,16:20)`
117-
# #' @param ode Ordinary Differential Equation solver log tolerance or stiffness.
117+
# #' @param ode Ordinary Differential Equation solver log tolerance or stiffness.
118118
# Default is -4, i.e. 0.0001. Higher values will result in faster
119119
# #' runs, but parameter estimates may not be as accurate.
120120
# #' @param tol Tolerance for convergence of NPAG. Smaller numbers make it harder to converge.
@@ -126,16 +126,16 @@ PM_fit <- R6::R6Class(
126126
#' * The default is "sobol", which is a semi-random distribution. This is the distribution
127127
#' typically used when fitting a new model to the data. An example of this is
128128
#' on our [website](https://www.lapk.org/images/sobol_3d_plot.html).
129-
#'
129+
#'
130130
#' The following all specify non-random, informative prior distributions. They
131131
#' are useful for either continuing a previous
132132
#' run which did not converge or for fitting a model to new data, whether to simply
133133
#' calculate Bayesian posteriors with `cycles = 0` or to revise the model to a new
134134
#' covergence with the new data.
135135
#' * The name of a suitable [PM_result] object from a prior run loaded with [PM_load].
136-
#' This starts from the non-uniform, informative distribution obtained at the end of a prior NPAG run.
136+
#' This starts from the non-uniform, informative distribution obtained at the end of a prior NPAG run.
137137
#' Example: `run1 <- PM_load(1); fit1$run(prior = run1)`.
138-
#'
138+
#'
139139
#' * A character string with the filename of a csv file containing a prior distribution with
140140
#' format as for 'theta.csv' in the output folder of a prior run: column headers are parameter
141141
#' names, and rows are the support point values. A final column with probabilities
@@ -147,21 +147,21 @@ PM_fit <- R6::R6Class(
147147
#' * A data frame obtained from reading an approriate file, such that the data frame
148148
#' is in the required format described in the filename option above. Example:
149149
#' `mytheta <- read_csv("mytheta.csv"); fit1$run(prior = mytheta)`.
150-
#'
151-
#' @param density0 The proportion of the volume of the model parameter
150+
#'
151+
#' @param density0 The proportion of the volume of the model parameter
152152
#' hyperspace used to calculate the initial number of support points if one of
153153
#' the semi-random, uniform distributions are selected in the `prior` argument
154-
#' above. The initial points are
154+
#' above. The initial points are
155155
#' spread through that hyperspace and begin the search for the optimal
156156
#' parameter value distribution (support points) in the population.
157157
#' The volume of the parameter space is the product of the ranges for all parameters.
158158
#' For example if using two parameters `Ke` and `V`, with ranges of \[0, 5\] and \[10, 100\],
159159
#' the volume is (5 - 0) x (100 - 10) = 450 The default value of `density0` is 0.01, so the initial
160160
#' number of support points will be 0.01 x 450 = 4.5, increased to the nearest integer,
161-
#' which is 5. The greater the initial number of points, the less chance of
162-
#' missing the globally maximally likely parameter value distribution,
161+
#' which is 5. The greater the initial number of points, the less chance of
162+
#' missing the globally maximally likely parameter value distribution,
163163
#' but the slower the run.
164-
#'
164+
#'
165165
# #' @param indpts Index of starting grid point number. Default is missing, which allows NPAG to choose depending on the number of random parameters:
166166
# #' 1 or 2 = index of 1; 3 = 3; 4 = 4, 5 = 6,
167167
# #' 6 or more is 10+number of multiples for each parameter greater than 5, e.g. 6 = 101; 7 = 102, up to 108 for 13 or more parameters.
@@ -191,7 +191,7 @@ PM_fit <- R6::R6Class(
191191
#'
192192
#' @author Michael Neely
193193
#' @export
194-
194+
195195
run = function(run = NULL,
196196
include = NULL, exclude = NULL,
197197
# ode, tol, salt,
@@ -211,9 +211,9 @@ PM_fit <- R6::R6Class(
211211
report = getPMoptions("report_template"),
212212
artifacts = TRUE) {
213213
cwd <- getwd()
214-
intern <- TRUE #always true until (if) rust can run separately from R
215-
216-
214+
intern <- TRUE # always true until (if) rust can run separately from R
215+
216+
217217
# make new output directory
218218
if (is.null(run)) {
219219
olddir <- list.dirs(recursive = FALSE)
@@ -231,7 +231,7 @@ PM_fit <- R6::R6Class(
231231
newdir <- as.character(run)
232232
}
233233
}
234-
234+
235235
if (file.exists(newdir)) {
236236
if (overwrite) {
237237
unlink(newdir, recursive = TRUE)
@@ -244,77 +244,84 @@ PM_fit <- R6::R6Class(
244244
}
245245
dir.create(newdir)
246246
setwd(newdir)
247-
247+
248248
algorithm <- tolower(algorithm)
249-
249+
250250
if (getPMoptions()$backend != "rust") {
251251
setwd(cwd)
252252
cli::cli_abort(c(
253253
"x" = "Error: unsupported backend.",
254254
"i" = "See help for {.fn setPMoptions}"
255255
))
256256
}
257-
257+
258258
if (artifacts) {
259259
self$model$write("model.txt")
260260
}
261-
261+
262262
#### Include or exclude subjects ####
263263
if (is.null(include)) include <- unique(self$data$standard_data$id)
264264
if (is.null(exclude)) exclude <- NA
265265
data_filtered <- self$data$standard_data %>% includeExclude(include, exclude)
266-
266+
267267
if (nrow(data_filtered) == 0) {
268268
cli::cli_abort("x" = "No subjects remain after filtering.")
269269
setwd(cwd)
270270
return(invisible(NULL))
271271
}
272-
273-
274-
275-
276-
272+
273+
274+
275+
276+
277277
#### Save objects ####
278278
self$data <- PM_data$new(data_filtered, quiet = TRUE)
279279
self$data$write("gendata.csv", header = FALSE)
280280
save(self, file = "fit.Rdata")
281-
281+
282282
# Get ranges and calculate points
283-
283+
284284
ranges <- lapply(self$model$model_list$pri, function(x) {
285285
c(x$min, x$max)
286286
})
287287
names(ranges) <- tolower(names(ranges))
288-
288+
289289
# Set initial grid points (only applies for sobol)
290-
290+
291291
vol <- prod(sapply(ranges, function(x) x[2] - x[1]))
292292
points <- ceiling(density0 * vol)
293-
294-
295-
293+
294+
295+
296296
# set prior
297-
if(prior != "sobol"){
298-
if(is.numeric(prior)){ # prior specified as a run number
299-
if ( !file.exists(glue::glue({prior},"/outputs/theta.csv"))){
297+
if (prior != "sobol") {
298+
if (is.numeric(prior)) { # prior specified as a run number
299+
if (!file.exists(glue::glue(
300+
{
301+
prior
302+
},
303+
"/outputs/theta.csv"
304+
))) {
300305
cli::cli_abort(c(
301306
"x" = "Error: {.arg prior} file does not exist.",
302307
"i" = "Check the file path."
303308
))
304-
}
305-
file.copy(glue::glue({prior},"/outputs/theta.csv"), "theta.csv")
309+
}
310+
file.copy(glue::glue(
311+
{
312+
prior
313+
},
314+
"/outputs/theta.csv"
315+
), "theta.csv")
306316
prior <- "theta.csv"
307-
308-
309-
} else if (is.character(prior)) { # prior specified as a filename
317+
} else if (is.character(prior)) { # prior specified as a filename
310318
if (!file.exists(prior)) {
311319
cli::cli_abort(c(
312320
"x" = "Error: {.arg prior} file does not exist.",
313321
"i" = "Check the file path."
314322
))
315323
}
316-
file.copy(prior, overwrite = TRUE) #ensure in current working directory
317-
324+
file.copy(prior, overwrite = TRUE) # ensure in current working directory
318325
} else {
319326
cli::cli_abort(c(
320327
"x" = "Error: {.arg prior} must be a numeric run number or character filename.",
@@ -324,11 +331,11 @@ PM_fit <- R6::R6Class(
324331
} else {
325332
prior <- "sobol"
326333
}
327-
334+
328335
if (intern) {
329336
### CALL RUST
330337
out_path <- file.path(getwd(), "outputs")
331-
338+
332339
rlang::try_fetch(
333340
fit(
334341
self$model$binary_path,
@@ -337,14 +344,14 @@ PM_fit <- R6::R6Class(
337344
ranges = ranges,
338345
algorithm = algorithm,
339346
gamlam = c(self$model$model_list$out$Y1$err$model$additive, self$model$model_list$out$Y1$err$model$proportional),
340-
error_type = c("additive","proportional")[1+is.null(self$model$model_list$out$Y1$err$model$additive)],
347+
error_type = c("additive", "proportional")[1 + is.null(self$model$model_list$out$Y1$err$model$additive)],
341348
error_coefficients = t(sapply(self$model$model_list$out, function(x) {
342349
y <- x$err$assay$coefficients
343-
if(length(y) < 6){
344-
y <- c(y,0,0)
350+
if (length(y) < 6) {
351+
y <- c(y, 0, 0)
345352
}
346-
y}
347-
)), # matrix numeqt x 6
353+
y
354+
})), # matrix numeqt x 6
348355
max_cycles = cycles,
349356
prior = prior,
350357
ind_points = points,
@@ -356,7 +363,7 @@ PM_fit <- R6::R6Class(
356363
return(NULL)
357364
}
358365
)
359-
366+
360367
PM_parse("outputs")
361368
res <- PM_load(file = "PMout.Rdata")
362369
PM_report(res, outfile = "report.html", template = report)
@@ -375,7 +382,7 @@ PM_fit <- R6::R6Class(
375382
save = function(file_name = "PMfit.rds") {
376383
saveRDS(self, file_name)
377384
},
378-
385+
379386
#' @description
380387
#' `PM_fit` objects contain a `save` method which invokes [saveRDS] to write
381388
#' the object to the hard drive as an .rds file. This is the corresponding load
@@ -403,7 +410,6 @@ PM_fit <- R6::R6Class(
403410
# check if compiled and if not, do so
404411
self$model$compile()
405412
}
406-
407413
) # end private
408414
) # end PM_fit
409415

@@ -418,6 +424,6 @@ PM_fit$load <- function(file_name = "PMfit.rds") {
418424
if (!is.logical(bool)) {
419425
stop("This functions expects a logical value")
420426
}
421-
427+
422428
rust_logical <- ifelse(bool, "true", "false")
423429
}

0 commit comments

Comments
 (0)