diff --git a/.gitignore b/.gitignore
index bff4a2199..ed5327c28 100755
--- a/.gitignore
+++ b/.gitignore
@@ -10,6 +10,7 @@
.DS_Store
PmetricsGit.Rproj
+
# Build/check artifacts
/*.tar.gz
/*.Rcheck/
diff --git a/Learn/Rscript/Learn.R b/Learn/Rscript/Learn.R
new file mode 100644
index 000000000..d3c1ec096
--- /dev/null
+++ b/Learn/Rscript/Learn.R
@@ -0,0 +1,11 @@
+# This is an R script you can use to accompany the "Introduction to Pmetrics" online book.
+# You can find the book at https://lapkb.github.io/PM_tutorial/
+
+
+##### EXECUTE THIS CODE
+
+library(Pmetrics) # load the Pmetrics library
+wd <- "/Users/mneely/Library/CloudStorage/OneDrive-CHILDRENSHOSPITALLOSANGELES/Documents/LAPK/Development/Pmetrics_rust/Learn"
+setwd(wd) # all needed files will be here
+
+##### PASTE THE CODE FROM THE BOOK BELOW THIS LINE
diff --git a/Learn/src/ex.csv b/Learn/src/ex.csv
new file mode 100644
index 000000000..6559d3605
--- /dev/null
+++ b/Learn/src/ex.csv
@@ -0,0 +1,260 @@
+id,time,dose,out,wt,africa,age,gender,height
+1,0,600,.,46.7,1,21,1,160
+1,24,600,.,46.7,1,21,1,160
+1,48,600,.,46.7,1,21,1,160
+1,72,600,.,46.7,1,21,1,160
+1,96,600,.,46.7,1,21,1,160
+1,120,.,10.44,46.7,1,21,1,160
+1,120,600,.,46.7,1,21,1,160
+1,121,.,12.89,46.7,1,21,1,160
+1,122,.,14.98,46.7,1,21,1,160
+1,125.99,.,16.69,46.7,1,21,1,160
+1,129,.,20.15,46.7,1,21,1,160
+1,132,.,14.97,46.7,1,21,1,160
+1,143.98,.,12.57,46.7,1,21,1,160
+2,0,600,.,66.5,1,30,1,174
+2,24,600,.,66.5,1,30,1,174
+2,48,600,.,66.5,1,30,1,174
+2,72,600,.,66.5,1,30,1,174
+2,96,600,.,66.5,1,30,1,174
+2,120,.,3.56,66.5,1,30,1,174
+2,120,600,.,66.5,1,30,1,174
+2,120.98,.,5.84,66.5,1,30,1,174
+2,121.98,.,6.54,66.5,1,30,1,174
+2,126,.,6.14,66.5,1,30,1,174
+2,129.02,.,6.56,66.5,1,30,1,174
+2,132.02,.,4.44,66.5,1,30,1,174
+2,144,.,3.76,66.5,1,30,1,174
+3,0,600,.,46.7,1,24,0,164
+3,24,600,.,46.7,1,24,0,164
+3,48,600,.,46.7,1,24,0,164
+3,72,600,.,46.7,1,24,0,164
+3,96,600,.,46.7,1,24,0,164
+3,120,600,.,46.7,1,24,0,164
+3,120.08,.,4.06,46.7,1,24,0,164
+3,121.07,.,3.24,46.7,1,24,0,164
+3,122.08,.,3.09,46.7,1,24,0,164
+3,126.08,.,7.98,46.7,1,24,0,164
+3,129.05,.,7.23,46.7,1,24,0,164
+3,132.1,.,4.71,46.7,1,24,0,164
+3,144.08,.,3.82,46.7,1,24,0,164
+4,0,600,.,50.8,1,25,1,165
+4,24,600,.,50.8,1,25,1,165
+4,48,600,.,50.8,1,25,1,165
+4,72,600,.,50.8,1,25,1,165
+4,96,600,.,50.8,1,25,1,165
+4,120,.,2.1,50.8,1,25,1,165
+4,120,600,.,50.8,1,25,1,165
+4,121,.,3.05,50.8,1,25,1,165
+4,122.02,.,5.21,50.8,1,25,1,165
+4,126,.,5.09,50.8,1,25,1,165
+4,129.03,.,4.24,50.8,1,25,1,165
+4,132,.,3.69,50.8,1,25,1,165
+4,144.02,.,1.96,50.8,1,25,1,165
+5,0,600,.,65.8,1,22,1,181
+5,24,600,.,65.8,1,22,1,181
+5,48,600,.,65.8,1,22,1,181
+5,72,600,.,65.8,1,22,1,181
+5,96,600,.,65.8,1,22,1,181
+5,120,.,2.93,65.8,1,22,1,181
+5,120,600,.,65.8,1,22,1,181
+5,121,.,2.64,65.8,1,22,1,181
+5,122,.,4.8,65.8,1,22,1,181
+5,126,.,3.7,65.8,1,22,1,181
+5,129.02,.,4.13,65.8,1,22,1,181
+5,132,.,2.81,65.8,1,22,1,181
+5,144,.,2.21,65.8,1,22,1,181
+6,0,600,.,65,1,23,1,177
+6,24,600,.,65,1,23,1,177
+6,48,600,.,65,1,23,1,177
+6,72,600,.,65,1,23,1,177
+6,96,600,.,65,1,23,1,177
+6,120,.,6.92,65,1,23,1,177
+6,120,600,.,65,1,23,1,177
+6,121,.,6.89,65,1,23,1,177
+6,121.98,.,6.64,65,1,23,1,177
+6,126,.,13.72,65,1,23,1,177
+6,129,.,12.69,65,1,23,1,177
+6,131.98,.,10.58,65,1,23,1,177
+6,144.98,.,6.62,65,1,23,1,177
+7,0,600,.,51.7,1,27,0,161
+7,24,600,.,51.7,1,27,0,161
+7,48,600,.,51.7,1,27,0,161
+7,72,600,.,51.7,1,27,0,161
+7,96,600,.,51.7,1,27,0,161
+7,120,.,5.41,51.7,1,27,0,161
+7,120,600,.,51.7,1,27,0,161
+7,121.03,.,4.46,51.7,1,27,0,161
+7,122.03,.,4.54,51.7,1,27,0,161
+7,126.02,.,12.19,51.7,1,27,0,161
+7,129.08,.,12.1,51.7,1,27,0,161
+7,132.03,.,8.61,51.7,1,27,0,161
+7,144.03,.,6.37,51.7,1,27,0,161
+8,0,600,.,51.2,1,22,1,163
+8,24,600,.,51.2,1,22,1,163
+8,48,600,.,51.2,1,22,1,163
+8,72,600,.,51.2,1,22,1,163
+8,96,600,.,51.2,1,22,1,163
+8,120,.,6.19,51.2,1,22,1,163
+8,120,600,.,51.2,1,22,1,163
+8,121.03,.,6.33,51.2,1,22,1,163
+8,122,.,6.24,51.2,1,22,1,163
+8,125.98,.,13.03,51.2,1,22,1,163
+8,128.98,.,11.86,51.2,1,22,1,163
+8,132,.,11.45,51.2,1,22,1,163
+8,143.98,.,7.83,51.2,1,22,1,163
+9,0,600,.,55,1,23,1,174
+9,24,600,.,55,1,23,1,174
+9,48,600,.,55,1,23,1,174
+9,72,600,.,55,1,23,1,174
+9,96,600,.,55,1,23,1,174
+9,120,.,2.85,55,1,23,1,174
+9,120,600,.,55,1,23,1,174
+9,120.97,.,3.7,55,1,23,1,174
+9,122,.,6.65,55,1,23,1,174
+9,125.98,.,6.81,55,1,23,1,174
+9,128.98,.,6.51,55,1,23,1,174
+9,132,.,7.48,55,1,23,1,174
+9,143.98,.,4.51,55,1,23,1,174
+10,0,600,.,52.1,1,32,1,163
+10,24,600,.,52.1,1,32,1,163
+10,48,600,.,52.1,1,32,1,163
+10,72,600,.,52.1,1,32,1,163
+10,96,600,.,52.1,1,32,1,163
+10,120,.,2.93,52.1,1,32,1,163
+10,120,600,.,52.1,1,32,1,163
+10,121,.,4.36,52.1,1,32,1,163
+10,122.02,.,7.79,52.1,1,32,1,163
+10,126,.,11.02,52.1,1,32,1,163
+10,129,.,8.86,52.1,1,32,1,163
+10,131.97,.,6.09,52.1,1,32,1,163
+10,144,.,4.15,52.1,1,32,1,163
+11,0,600,.,56.5,1,34,1,165
+11,24,600,.,56.5,1,34,1,165
+11,48,600,.,56.5,1,34,1,165
+11,72,600,.,56.5,1,34,1,165
+11,96,600,.,56.5,1,34,1,165
+11,120,.,2.09,56.5,1,34,1,165
+11,120,600,.,56.5,1,34,1,165
+11,121.03,.,2.68,56.5,1,34,1,165
+11,122,.,4.71,56.5,1,34,1,165
+11,125.98,.,7.71,56.5,1,34,1,165
+11,129,.,6.31,56.5,1,34,1,165
+11,132,.,5.82,56.5,1,34,1,165
+11,144.13,.,2.63,56.5,1,34,1,165
+12,0,600,.,47.9,1,54,0,160
+12,24,600,.,47.9,1,54,0,160
+12,48,600,.,47.9,1,54,0,160
+12,72,600,.,47.9,1,54,0,160
+12,96,600,.,47.9,1,54,0,160
+12,120,.,7.09,47.9,1,54,0,160
+12,120,600,.,47.9,1,54,0,160
+12,121.03,.,6.18,47.9,1,54,0,160
+12,122.13,.,8.66,47.9,1,54,0,160
+12,126,.,11.16,47.9,1,54,0,160
+12,129,.,9.51,47.9,1,54,0,160
+12,132,.,8.14,47.9,1,54,0,160
+12,144,.,7.89,47.9,1,54,0,160
+13,0,600,.,60.5,1,24,1,180
+13,24,600,.,60.5,1,24,1,180
+13,48,600,.,60.5,1,24,1,180
+13,72,600,.,60.5,1,24,1,180
+13,96,600,.,60.5,1,24,1,180
+13,120,.,6.62,60.5,1,24,1,180
+13,120,600,.,60.5,1,24,1,180
+13,121,.,3.18,60.5,1,24,1,180
+13,122,.,5.41,60.5,1,24,1,180
+13,126,.,10.18,60.5,1,24,1,180
+13,129.02,.,12.84,60.5,1,24,1,180
+13,132,.,12.35,60.5,1,24,1,180
+13,144,.,8.06,60.5,1,24,1,180
+14,0,600,.,59.2,1,26,1,174
+14,24,600,.,59.2,1,26,1,174
+14,48,600,.,59.2,1,26,1,174
+14,72,600,.,59.2,1,26,1,174
+14,96,600,.,59.2,1,26,1,174
+14,120,.,3.63,59.2,1,26,1,174
+14,120,600,.,59.2,1,26,1,174
+14,121,.,4.49,59.2,1,26,1,174
+14,122,.,5.5,59.2,1,26,1,174
+14,126,.,7.28,59.2,1,26,1,174
+14,129,.,5.27,59.2,1,26,1,174
+14,132,.,4.89,59.2,1,26,1,174
+14,144,.,2.68,59.2,1,26,1,174
+15,0,450,.,43,1,19,0,150
+15,24,450,.,43,1,19,0,150
+15,48,450,.,43,1,19,0,150
+15,72,450,.,43,1,19,0,150
+15,96,450,.,43,1,19,0,150
+15,120,.,5.53,43,1,19,0,150
+15,120,450,.,43,1,19,0,150
+15,121,.,4.81,43,1,19,0,150
+15,122,.,8.14,43,1,19,0,150
+15,126,.,9.96,43,1,19,0,150
+15,129,.,8.55,43,1,19,0,150
+15,132.05,.,7.54,43,1,19,0,150
+15,144.05,.,5.74,43,1,19,0,150
+16,0,600,.,64.4,1,25,1,173
+16,24,600,.,64.4,1,25,1,173
+16,48,600,.,64.4,1,25,1,173
+16,72,600,.,64.4,1,25,1,173
+16,96,600,.,64.4,1,25,1,173
+16,120,.,5.48,64.4,1,25,1,173
+16,120,600,.,64.4,1,25,1,173
+16,121,.,6.59,64.4,1,25,1,173
+16,122,.,8.91,64.4,1,25,1,173
+16,126,.,10.57,64.4,1,25,1,173
+16,129,.,9.52,64.4,1,25,1,173
+16,132,.,7.83,64.4,1,25,1,173
+16,143.97,.,4.96,64.4,1,25,1,173
+17,0,600,.,54.8,1,23,1,170
+17,24,600,.,54.8,1,23,1,170
+17,48,600,.,54.8,1,23,1,170
+17,72,600,.,54.8,1,23,1,170
+17,96,600,.,54.8,1,23,1,170
+17,120,.,2.11,54.8,1,23,1,170
+17,120,600,.,54.8,1,23,1,170
+17,121.02,.,1.86,54.8,1,23,1,170
+17,122.02,.,6.92,54.8,1,23,1,170
+17,126,.,9.11,54.8,1,23,1,170
+17,129,.,6.96,54.8,1,23,1,170
+17,132,.,5.64,54.8,1,23,1,170
+17,144.08,.,3.59,54.8,1,23,1,170
+18,0,450,.,44.3,1,20,0,164
+18,24,450,.,44.3,1,20,0,164
+18,48,450,.,44.3,1,20,0,164
+18,72,450,.,44.3,1,20,0,164
+18,96,450,.,44.3,1,20,0,164
+18,120,.,7.95,44.3,1,20,0,164
+18,120,450,.,44.3,1,20,0,164
+18,120.98,.,7.47,44.3,1,20,0,164
+18,121.98,.,8.67,44.3,1,20,0,164
+18,126,.,13.83,44.3,1,20,0,164
+18,129.17,.,14.01,44.3,1,20,0,164
+18,132.17,.,8.97,44.3,1,20,0,164
+18,143.97,.,8.4,44.3,1,20,0,164
+19,0,600,.,50,1,36,1,168
+19,24,600,.,50,1,36,1,168
+19,48,600,.,50,1,36,1,168
+19,72,600,.,50,1,36,1,168
+19,96,600,.,50,1,36,1,168
+19,120,.,5.42,50,1,36,1,168
+19,120,600,.,50,1,36,1,168
+19,121,.,7.08,50,1,36,1,168
+19,122,.,7.27,50,1,36,1,168
+19,125.98,.,20.07,50,1,36,1,168
+19,128.98,.,18.24,50,1,36,1,168
+19,132,.,15.36,50,1,36,1,168
+19,144,.,10.92,50,1,36,1,168
+20,0,600,.,59,1,31,1,170
+20,24,600,.,59,1,31,1,170
+20,48,600,.,59,1,31,1,170
+20,72,600,.,59,1,31,1,170
+20,96,600,.,59,1,31,1,170
+20,120,.,4.71,59,1,31,1,170
+20,120,600,.,59,1,31,1,170
+20,120.77,.,4.5,59,1,31,1,170
+20,121.75,.,3.35,59,1,31,1,170
+20,125.67,.,12.35,59,1,31,1,170
+20,128.67,.,11.56,59,1,31,1,170
+20,143.67,.,6.45,59,1,31,1,170
diff --git a/R/DataDescriptions.R b/R/DataDescriptions.R
index dce4f0bf6..bcf73ca83 100755
--- a/R/DataDescriptions.R
+++ b/R/DataDescriptions.R
@@ -195,15 +195,3 @@
"locales"
-
-
-#' @name model
-#' @docType data
-#' @title Pmetrics model
-#' @usage model
-#' @format Sample model text
-#' @author Michael Neely
-#' @keywords datasets
-
-
-"model"
diff --git a/R/PM_model.R b/R/PM_model.R
index bdcf4c6b7..bbb0da2d6 100644
--- a/R/PM_model.R
+++ b/R/PM_model.R
@@ -4,7 +4,6 @@
# Use menu item Code -> Jump To... for rapid navigation
# Keyboard Option+Command+O (Mac) or Alt+O (Windows) to fold all
-
# R6 ----------------------------------------------------------------------
@@ -14,8 +13,8 @@
#' @description
#' `r lifecycle::badge("stable")`
#'
-#' PM_model objects contain the variables, covariates, equations and error models
-#' necessary to run a population analysis.
+#' 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
@@ -24,9 +23,9 @@
#' population analysis, i.e. estimating the probability distribution of model equation
#' paramter values in the population. The PM_model object is created using the
#' a model building app (coming soon), by defining a list
-#' directly in R, or by reading a model text file. When reading a model text file,
+#' directly in R, or by reading a model text file. When reading a model text file,
#' the list code is generated and copied to the clipboard for pasting in to scripts.
-#' Model files will be deprecated in future versions of Pmetrics.
+#' Model files will be deprecated in future versions of Pmetrics.
#'
#' **Some notes on the example at the end of this help page:**
#'
@@ -87,7 +86,7 @@ PM_model <- R6::R6Class(
#' @field binary_path The full path and filename of the compiled model
binary_path = NULL,
#' @description
- #' This is the method to create a new `PM_model` object.
+ #' This is the method to create a new `PM_model` object.
#'
#' The first argument allows creation of a model from a variety of pre-existing
#' sources, and if used, all the subsequent arguments will be ignored. If a model
@@ -131,7 +130,7 @@ PM_model <- R6::R6Class(
#' * Quoted name of a model text file in the
#' working directory which will be read and passed to Rust engine. **Note:** Model
#' text files are being deprecated in future versions of Pmetrics.
- #'
+ #'
#' * List that defines the model directly in R. This will be in the same format as if
#' all the subsequent arguments were used. For example:
#' ```
@@ -410,9 +409,8 @@ PM_model <- R6::R6Class(
))
}
self$arg_list <- private$R6fromFile(x) # read file and populate fields
- cli::cli_inform(c("i" = "{.strong Note:} Model files will be deprecated in future versions of Pmetrics."))
+ # cli::cli_inform(c("i" = "{.strong Note:} Model files will be deprecated in future versions of Pmetrics."))
self$copy() # copy to clipboard
-
} else if (is.list(x)) { # x is a list in R
purrr::walk(model_sections, \(s) {
if (s %in% names(x)) {
@@ -479,7 +477,6 @@ 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
@@ -1089,11 +1086,6 @@ PM_model <- R6::R6Class(
}
-
- # if (getPMoptions()$backend != "rust") {
- # 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)
@@ -1345,17 +1337,15 @@ PM_model <- R6::R6Class(
temp_csv <- tempfile(fileext = ".csv")
data$save(temp_csv, header = FALSE)
- if (getPMoptions()$backend == "rust") {
+
+ if (is.null(self$binary_path)) {
+ self$compile()
if (is.null(self$binary_path)) {
- self$compile()
- if (is.null(self$binary_path)) {
- cli::cli_abort(c("x" = "Model must be compiled before simulating."))
- }
+ cli::cli_abort(c("x" = "Model must be compiled before simulating."))
}
- sim <- simulate_all(temp_csv, self$binary_path, theta, kind = tolower(self$model_list$type))
- } else {
- cli::cli_abort(c("x" = "This function can only be used with the rust backend."))
}
+ sim <- simulate_all(temp_csv, self$binary_path, theta, kind = tolower(self$model_list$type))
+
return(sim)
},
#' @description
@@ -1377,7 +1367,7 @@ PM_model <- R6::R6Class(
output_path <- tempfile(pattern = "model_", fileext = ".pmx")
cli::cli_inform(c("i" = "Compiling model..."))
# path inside Pmetrics package
- template_path <- if (Sys.getenv("env") == "Development") { temporary_path() } else { system.file(package = "Pmetrics")}
+ 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."
@@ -1398,19 +1388,33 @@ PM_model <- R6::R6Class(
return(invisible(self))
}, # end compile method
+ #' @description
+ #' Save model to file (deprecated).
+ #' @details
+ #' This method is deprecated. Existing or manually created model files may be read with `PM_model$new(filename)`,
+ #' but including model code in scripts is preferred, as this makes models used in runs transparent and more easily edited.
+ #' Use the `PM_model$copy()` method instead to copy the model code to the clipboard and paste into scripts.
+ save = function(){
+ cli::cli_warn(c("x" = "Saving model files is deprecated.",
+ "i" = "Model list copied to clipboard."))
+ self$copy()
+ return(invisible(self))
+ },
+
+
+
+
#' @description
#' Copy model code to clipboard.
#' @details
#' This method copies the R code to create the model to the clipboard.
- #' This is useful for saving the model code in a script, as model files
- #' will be deprecated in future versions of Pmetrics.
+ #' This is useful for saving the model code in a script.
copy = function() {
arg_list <- self$arg_list
-
+
# pri
pri <- c(
" pri = list(\n",
-
purrr::map_chr(names(arg_list$pri), \(i) {
sprintf(" %s = ab(%.3f, %.3f)", i, arg_list$pri[[i]]$min, arg_list$pri[[i]]$max)
}) %>% paste(collapse = ",\n"),
@@ -1488,37 +1492,37 @@ PM_model <- R6::R6Class(
err <- c(
"\n err = list(\n",
purrr::map_chr((arg_list$err), \(i) {
- sprintf(" %s(%i, c(%.1f, %.1f, %.1f, %.1f)%s)",
- i$type,
- i$initial,
- ifelse(length(i$coeff) >= 1, i$coeff[1], 0),
- ifelse(length(i$coeff) >= 2, i$coeff[2], 0),
- ifelse(length(i$coeff) >= 3, i$coeff[3], 0),
- ifelse(length(i$coeff) >= 4, i$coeff[4], 0),
- ifelse(i$fixed, ", fixed = TRUE", "")
- )
- }) %>% paste(collapse = ",\n"),
- "\n )"
- )
-
- model_copy <- c(
- "mod <- PM_model$new(\n",
- paste0(c(pri, cov, sec, fa, ini, lag, eqn, out, err), collapse = ""),
- "\n)"
- )
- cli::cli_inform(c(
- ">" = "Model code copied to clipboard.",
- ">" = "Paste the code into your script for future use, renaming the assigned variable if needed."))
- if (requireNamespace("clipr", quietly = TRUE)) {
- clipr::write_clip(model_copy)
- } else {
- cli::cli_inform(c("i" = "Please install the {.pkg clipr} package to enable clipboard functionality."))
- cat(model_copy, sep = "\n")
- }
- return(invisible(self))
-
+ sprintf(
+ " %s(%i, c(%.1f, %.1f, %.1f, %.1f)%s)",
+ i$type,
+ i$initial,
+ ifelse(length(i$coeff) >= 1, i$coeff[1], 0),
+ ifelse(length(i$coeff) >= 2, i$coeff[2], 0),
+ ifelse(length(i$coeff) >= 3, i$coeff[3], 0),
+ ifelse(length(i$coeff) >= 4, i$coeff[4], 0),
+ ifelse(i$fixed, ", fixed = TRUE", "")
+ )
+ }) %>% paste(collapse = ",\n"),
+ "\n )"
+ )
+
+ model_copy <- c(
+ "mod <- PM_model$new(\n",
+ paste0(c(pri, cov, sec, fa, ini, lag, eqn, out, err), collapse = ""),
+ "\n)"
+ )
+ cli::cli_inform(c(
+ ">" = "Model code copied to clipboard.",
+ ">" = "Paste the code into your script for future use, renaming the assigned variable if needed."
+ ))
+ if (requireNamespace("clipr", quietly = TRUE)) {
+ clipr::write_clip(model_copy)
+ } else {
+ cli::cli_inform(c("i" = "Please install the {.pkg clipr} package to enable clipboard functionality."))
+ cat(model_copy, sep = "\n")
+ }
+ return(invisible(self))
} # end copy
-
), # end public list
private = list(
# read file
@@ -1686,7 +1690,7 @@ PM_model <- R6::R6Class(
flush.console()
return(arg_list)
}, # end R6fromFile
-
+
write_model_to_rust = function(file_path = "main.rs") {
# Check if model_list is not NULL
if (is.null(self$model_list)) {
@@ -1720,256 +1724,253 @@ PM_model <- R6::R6Class(
},
get_primary = function() {
return(tolower(self$model_list$parameters))
- }
- ) # end private
-) # end R6Class PM_model
-
-##### These functions create various model components
-
-#' @title Additive error model
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Create an additive (lambda) error model
-#' @param initial Initial value for lambda
-#' @param coeff Vector of coefficients defining assay error polynomial
-#' @param fixed Estimate if `FALSE` (default).
-#' @export
-additive <- function(initial, coeff, fixed = FALSE) {
- PM_err$new(type = "additive", initial = initial, coeff = coeff, fixed = fixed)
-}
-
-
-
-#' @title Proportional error model
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Create an proportional (gamma) error model
-#' @param initial Initial value for gamma
-#' @param coeff Vector of coefficients defining assay error polynomial
-#' @param fixed Estimate if `FALSE` (default).
-#' @export
-proportional <- function(initial, coeff, fixed = FALSE) {
- PM_err$new(type = "proportional", initial = initial, coeff = coeff, fixed = fixed)
-}
-
-PM_err <- R6::R6Class(
- "PM_err",
- public = list(
- #' @field type Type of error model, either "additive" or "proportional".
- type = NULL,
- #' @field initial Initial value for the error model.
- initial = NULL,
- #' @field coeff Coefficients for the assay error polynomial.
- coeff = NULL,
- #' @field fixed If `TRUE`, the error model is fixed and not estimated.
- fixed = NULL,
- initialize = function(type, initial, coeff, fixed) {
- self$type <- type
- self$initial <- initial
- self$coeff <- coeff
- self$fixed <- fixed
- },
- print = function() {
- if (self$fixed) {
- cli::cli_text("{.strong {tools::toTitleCase(self$type)}}, with fixed value of {.emph {self$initial}} and coefficients {.emph {paste(self$coeff, collapse = ', ')}}.")
- } else {
- cli::cli_text("{.strong {tools::toTitleCase(self$type)}}, with initial value of {.emph {self$initial}} and coefficients {.emph {paste(self$coeff, collapse = ', ')}}.")
}
- },
- flatten = function() {
- list(initial = self$initial, coeff = self$coeff, type = self$type, fixed = self$fixed)
- }
+ ) # end private
+ ) # end R6Class PM_model
+
+ ##### These functions create various model components
+
+ #' @title Additive error model
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Create an additive (lambda) error model
+ #' @param initial Initial value for lambda
+ #' @param coeff Vector of coefficients defining assay error polynomial
+ #' @param fixed Estimate if `FALSE` (default).
+ #' @export
+ additive <- function(initial, coeff, fixed = FALSE) {
+ PM_err$new(type = "additive", initial = initial, coeff = coeff, fixed = fixed)
+ }
+
+
+ #' @title Proportional error model
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Create an proportional (gamma) error model
+ #' @param initial Initial value for gamma
+ #' @param coeff Vector of coefficients defining assay error polynomial
+ #' @param fixed Estimate if `FALSE` (default).
+ #' @export
+ proportional <- function(initial, coeff, fixed = FALSE) {
+ PM_err$new(type = "proportional", initial = initial, coeff = coeff, fixed = fixed)
+ }
+
+ PM_err <- R6::R6Class(
+ "PM_err",
+ public = list(
+ #' @field type Type of error model, either "additive" or "proportional".
+ type = NULL,
+ #' @field initial Initial value for the error model.
+ initial = NULL,
+ #' @field coeff Coefficients for the assay error polynomial.
+ coeff = NULL,
+ #' @field fixed If `TRUE`, the error model is fixed and not estimated.
+ fixed = NULL,
+ initialize = function(type, initial, coeff, fixed) {
+ self$type <- type
+ self$initial <- initial
+ self$coeff <- coeff
+ self$fixed <- fixed
+ },
+ print = function() {
+ if (self$fixed) {
+ cli::cli_text("{.strong {tools::toTitleCase(self$type)}}, with fixed value of {.emph {self$initial}} and coefficients {.emph {paste(self$coeff, collapse = ', ')}}.")
+ } else {
+ cli::cli_text("{.strong {tools::toTitleCase(self$type)}}, with initial value of {.emph {self$initial}} and coefficients {.emph {paste(self$coeff, collapse = ', ')}}.")
+ }
+ },
+ flatten = function() {
+ list(initial = self$initial, coeff = self$coeff, type = self$type, fixed = self$fixed)
+ }
+ )
)
-)
-
-#' @title Primary parameter values
-#' @description
-#' `r lifecycle::badge("experimental")`
-#' Define primary model parameter object.
-#' This is used internally by the `PM_model` class.
-#' @keywords internal
-PM_pri <- R6::R6Class(
- "PM_pri",
- public = list(
- #' @field min Minimum value of the range.
- min = NULL,
- #' @field max Maximum value of the range.
- max = NULL,
- #' @field mean Mean value of the range, calculated as (min + max) / 2.
- mean = NULL,
- #' @field sd Standard deviation of the range, calculated as (max - min) / 6.
- sd = NULL,
- #' @description
- #' Initialize a new range object.
- #' @param min Minimum value of the range.
- #' @param max Maximum value of the range.
- initialize = function(min, max) {
- self$min <- min
- self$max <- max
- self$mean <- (min + max) / 2
- self$sd <- (max - min) / 6
- },
- #' @description
- #' Print the range.
- print = function() {
- cli::cli_text("[{.strong {self$min}}, {.strong {self$max}}], {.emph ~N({round(self$mean,2)}}, {.emph {round(self$sd,2)})}")
- }
+
+ #' @title Primary parameter values
+ #' @description
+ #' `r lifecycle::badge("experimental")`
+ #' Define primary model parameter object.
+ #' This is used internally by the `PM_model` class.
+ #' @keywords internal
+ PM_pri <- R6::R6Class(
+ "PM_pri",
+ public = list(
+ #' @field min Minimum value of the range.
+ min = NULL,
+ #' @field max Maximum value of the range.
+ max = NULL,
+ #' @field mean Mean value of the range, calculated as (min + max) / 2.
+ mean = NULL,
+ #' @field sd Standard deviation of the range, calculated as (max - min) / 6.
+ sd = NULL,
+ #' @description
+ #' Initialize a new range object.
+ #' @param min Minimum value of the range.
+ #' @param max Maximum value of the range.
+ initialize = function(min, max) {
+ self$min <- min
+ self$max <- max
+ self$mean <- (min + max) / 2
+ self$sd <- (max - min) / 6
+ },
+ #' @description
+ #' Print the range.
+ print = function() {
+ cli::cli_text("[{.strong {self$min}}, {.strong {self$max}}], {.emph ~N({round(self$mean,2)}}, {.emph {round(self$sd,2)})}")
+ }
+ )
)
-)
-
-
-#' @title Initial range for primary parameter values
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Define primary model parameter initial values as range. For nonparametric,
-#' this range will be absolutely respected. For parametric, the range serves
-#' to define the mean (midpoint) and standard deviation (1/6 of the range) of the
-#' initial parameter value distribution.
-#' @param min Minimum value.
-#' @param max Maximum value.
-#' @export
-ab <- function(min, max) {
- PM_pri$new(min, max)
-}
-
-
-
-#' @title Initial mean/SD for primary parameter values
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Define primary model parameter initial values as mean and standard
-#' deviation, which translate to a range. The mean serves as the midpoint
-#' of the range, with 3 standard deviations above and below the mean to define
-#' the min and max of the range. For nonparametric,
-#' this range will be absolutely respected. For parametric,
-#' values can be estimated beyond the range.
-#' @param mean Initial mean.
-#' @param sd Initial standard deviation.
-#' @export
-msd <- function(mean, sd) {
- min <- mean - 3 * sd
- max <- mean + 3 * sd
- if (min < 0) {
- cli::cli_warn(c(
- "i" = "Negative minimum value for primary parameter range.",
- " " = "This may not be appropriate for your model."
- ))
+
+
+ #' @title Initial range for primary parameter values
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Define primary model parameter initial values as range. For nonparametric,
+ #' this range will be absolutely respected. For parametric, the range serves
+ #' to define the mean (midpoint) and standard deviation (1/6 of the range) of the
+ #' initial parameter value distribution.
+ #' @param min Minimum value.
+ #' @param max Maximum value.
+ #' @export
+ ab <- function(min, max) {
+ PM_pri$new(min, max)
}
- PM_pri$new(min, max)
-}
-
-
-
-#' @title Model covariate declaration
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Declare whether covariates in the data are to have
-#' interpolation between values or not.
-#' @param type If `type = "lm"` (the default) or `type = "linear"`,
-#' the covariate value will be
-#' linearly interpolated between values when fitting the model to the data.
-#' in a model list `cov` item. To fix covariate values to the value at the
-#' last time point, set `type = "none"`.
-#' @return A value of 1 for "lm" and 0 for "none", which will be passed to Rust.
-#' @examples
-#' \dontrun{
-#' cov <- c(
-#' wt = interp(), # same as interp("lm") or interp("linear")
-#' visit = interp("none")
-#' )
-#' }
-#' @export
-interp <- function(type = "lm") {
- if (!type %in% c("lm", "linear", "none")) {
- cli::cli_abort(c(
- "x" = "{type} is not a valid covariate interpolation type.",
- "i" = "See help for {.help PM_model()}."
- ))
+
+
+ #' @title Initial mean/SD for primary parameter values
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Define primary model parameter initial values as mean and standard
+ #' deviation, which translate to a range. The mean serves as the midpoint
+ #' of the range, with 3 standard deviations above and below the mean to define
+ #' the min and max of the range. For nonparametric,
+ #' this range will be absolutely respected. For parametric,
+ #' values can be estimated beyond the range.
+ #' @param mean Initial mean.
+ #' @param sd Initial standard deviation.
+ #' @export
+ msd <- function(mean, sd) {
+ min <- mean - 3 * sd
+ max <- mean + 3 * sd
+ if (min < 0) {
+ cli::cli_warn(c(
+ "i" = "Negative minimum value for primary parameter range.",
+ " " = "This may not be appropriate for your model."
+ ))
+ }
+ PM_pri$new(min, max)
}
- if (type %in% c("lm", "linear")) {
- return(1)
- } else {
- return(0)
+
+
+ #' @title Model covariate declaration
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Declare whether covariates in the data are to have
+ #' interpolation between values or not.
+ #' @param type If `type = "lm"` (the default) or `type = "linear"`,
+ #' the covariate value will be
+ #' linearly interpolated between values when fitting the model to the data.
+ #' in a model list `cov` item. To fix covariate values to the value at the
+ #' last time point, set `type = "none"`.
+ #' @return A value of 1 for "lm" and 0 for "none", which will be passed to Rust.
+ #' @examples
+ #' \dontrun{
+ #' cov <- c(
+ #' wt = interp(), # same as interp("lm") or interp("linear")
+ #' visit = interp("none")
+ #' )
+ #' }
+ #' @export
+ interp <- function(type = "lm") {
+ if (!type %in% c("lm", "linear", "none")) {
+ cli::cli_abort(c(
+ "x" = "{type} is not a valid covariate interpolation type.",
+ "i" = "See help for {.help PM_model()}."
+ ))
+ }
+ if (type %in% c("lm", "linear")) {
+ return(1)
+ } else {
+ return(0)
+ }
}
-}
-
-
-
-
-# PLOT --------------------------------------------------------------------
-
-#' @title Plot PM_model objects
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Plots a [PM_model] based on differential equations using network plots from tidygraph and ggraph packages.
-#'
-#' @details
-#' This accepts a [PM_model] object and creates a network plot where nodes are compartments
-#' and edges are arrows connecting compartments.
-#' @method plot PM_model
-#' @param x The name of an [PM_model] object.
-#' @param marker Controls the characteristics of the compartments (nodes).
-#' It can be boolean or a list.
-#' `TRUE` will plot the compartments with default characteristics.
-#' `FALSE` will suppress compartment plotting.
-#' If a list, can control some marker characteristics, including overriding defaults.
-#' These include:
-#' \itemize{
-#' \item{`color`} Marker color (default: dodgerblue).
-#' \item{`opacity`} Ranging between 0 (fully transparent) to 1 (fully opaque). Default is 0.5.
-#' \item{`size`} Relative size of boxes, ranging from 0 to 1. Default is 0.25.
-#' \item{`line`} A list of additional attributes governing the outline for filled shapes, most commonly
-#' color (default: black) and width (default: 0.5).
-#' }
-#'
-#'
-#' Example: `marker = list(color = "red", opacity = 0.8, line = list(color = "black", width = 1))`
-#' @param line Controls characteristics of arrows (edges).
-#' `TRUE` will plot default lines. `FALSE` will suppress lines.
-#' If a list, can control some line characteristics, including overriding defaults.
-#' These include:
-#' \itemize{
-#' \item{`color`} Line color (default: black)
-#' \item{`width`} Thickness in points (default: 1).
-#' }
-#'
-#'
-#' Example: `line = list(color = "red", width = 2)`
-#' @param explicit A data frame or tibble containing two columns named `from` and `to`
-#' to add additional connecting arrows to the plot indicating transfer between
-#' compartments. For each row, the `from` column contains the compartment number of the arrow origin, and the
-#' `to` column contains the compartment number of the arrow destination. Use 0 to indicate
-#' a destination to the external sink. e.g., `explicit = data.frame(from = 3, to = 0)`
-#' @param implicit Similar to `explicit`, used to add dashed connecting arrows
-#' to the plot indicating implicit transfer between
-#' compartments. For each row, the `from` column contains the compartment number of the arrow origin, and the
-#' `to` column contains the compartment number of the arrow destination. Use 0 to indicate
-#' a destination to the external sink. e.g., `implicit = data.frame(from = 2, to = 4)`
-#' @param print If `TRUE`, will print the object and return it. If `FALSE`, will only return the object.
-#' @param ... Not used.
-#' @return A plot object of the model.
-#' @author Markus Hovd, Julian Otalvaro, Michael Neely
-#' @seealso [PM_model], [ggraph::ggraph()], [ggplot2::ggplot()]
-#' @export
-#' @examples
-#' \dontrun{
-#' NPex$model$plot()
-#' }
-#' @family PMplots
-
-plot.PM_model <- function(x,
- marker = TRUE,
- line = TRUE,
- explicit,
- implicit,
- print = TRUE,
- ...) {
+
+
+ # PLOT --------------------------------------------------------------------
+
+ #' @title Plot PM_model objects
+ #' @description
+ #' `r lifecycle::badge("stable")`
+ #'
+ #' Plots a [PM_model] based on differential equations using network plots from tidygraph and ggraph packages.
+ #'
+ #' @details
+ #' This accepts a [PM_model] object and creates a network plot where nodes are compartments
+ #' and edges are arrows connecting compartments.
+ #' @method plot PM_model
+ #' @param x The name of an [PM_model] object.
+ #' @param marker Controls the characteristics of the compartments (nodes).
+ #' It can be boolean or a list.
+ #' `TRUE` will plot the compartments with default characteristics.
+ #' `FALSE` will suppress compartment plotting.
+ #' If a list, can control some marker characteristics, including overriding defaults.
+ #' These include:
+ #' \itemize{
+ #' \item{`color`} Marker color (default: dodgerblue).
+ #' \item{`opacity`} Ranging between 0 (fully transparent) to 1 (fully opaque). Default is 0.5.
+ #' \item{`size`} Relative size of boxes, ranging from 0 to 1. Default is 0.25.
+ #' \item{`line`} A list of additional attributes governing the outline for filled shapes, most commonly
+ #' color (default: black) and width (default: 0.5).
+ #' }
+ #'
+ #'
+ #' Example: `marker = list(color = "red", opacity = 0.8, line = list(color = "black", width = 1))`
+ #' @param line Controls characteristics of arrows (edges).
+ #' `TRUE` will plot default lines. `FALSE` will suppress lines.
+ #' If a list, can control some line characteristics, including overriding defaults.
+ #' These include:
+ #' \itemize{
+ #' \item{`color`} Line color (default: black)
+ #' \item{`width`} Thickness in points (default: 1).
+ #' }
+ #'
+ #'
+ #' Example: `line = list(color = "red", width = 2)`
+ #' @param explicit A data frame or tibble containing two columns named `from` and `to`
+ #' to add additional connecting arrows to the plot indicating transfer between
+ #' compartments. For each row, the `from` column contains the compartment number of the arrow origin, and the
+ #' `to` column contains the compartment number of the arrow destination. Use 0 to indicate
+ #' a destination to the external sink. e.g., `explicit = data.frame(from = 3, to = 0)`
+ #' @param implicit Similar to `explicit`, used to add dashed connecting arrows
+ #' to the plot indicating implicit transfer between
+ #' compartments. For each row, the `from` column contains the compartment number of the arrow origin, and the
+ #' `to` column contains the compartment number of the arrow destination. Use 0 to indicate
+ #' a destination to the external sink. e.g., `implicit = data.frame(from = 2, to = 4)`
+ #' @param print If `TRUE`, will print the object and return it. If `FALSE`, will only return the object.
+ #' @param ... Not used.
+ #' @return A plot object of the model.
+ #' @author Markus Hovd, Julian Otalvaro, Michael Neely
+ #' @seealso [PM_model], [ggraph::ggraph()], [ggplot2::ggplot()]
+ #' @export
+ #' @examples
+ #' \dontrun{
+ #' NPex$model$plot()
+ #' }
+ #' @family PMplots
+
+ plot.PM_model <- function(
+ x,
+ marker = TRUE,
+ line = TRUE,
+ explicit,
+ implicit,
+ print = TRUE,
+ ...
+ ) {
model <- x
marker <- if (is.list(marker) || marker) {
amendMarker(marker,
@@ -2028,9 +2029,6 @@ plot.PM_model <- function(x,
unlist()
-
-
-
#### INTERNAL FUNCTIONS
# Parse the function body
parse_equations <- function(func) {
@@ -2387,9 +2385,8 @@ plot.PM_model <- function(x,
}
-
# Modify layout logic to use circular positioning
- create_plot <- function(connections, compartments, outputs) {
+ create_plot <- function(connections, compartments, outputs) {
box_width <- 1.2
box_height <- 0.8
@@ -2546,12 +2543,14 @@ plot.PM_model <- function(x,
if (length(outputs) > 0) {
out_df <- bind_rows(lapply(outputs, function(out) {
comp <- out$compartment
- if (is.null(comp)) return(data.frame(x = NA, y = NA, label = NA))
+ if (is.null(comp)) {
+ return(data.frame(x = NA, y = NA, label = NA))
+ }
txt <- paste0("y[", out$output_num, "]")
pos <- layout_df %>% filter(compartment == comp)
data.frame(x = pos$x, y = pos$y - 0.2, label = txt)
}))
- if (any(is.na(out_df$x))){
+ if (any(is.na(out_df$x))) {
missing_out <- as.character(which(is.na(out_df$x)))
cli::cli_warn(c("!" = "{?This/These} output equation{?s} did not contain a parsable compartment number on the right side of the equation and {?was/were} not plotted: {missing_out}."))
out_df <- out_df %>% filter(!is.na(x))
@@ -2587,7 +2586,13 @@ plot.PM_model <- function(x,
expanded_equations <- purrr::map(parse(text = tolower(eqns)), expand_distribute)
outputs <- parse_output_equations(as.list(parse(text = tolower(outs))))
- out_comp <- map_chr(outputs, function(o) if (!is.null(o$compartment)) {as.character(o$compartment)} else {"unknown"})
+ out_comp <- map_chr(outputs, function(o) {
+ if (!is.null(o$compartment)) {
+ as.character(o$compartment)
+ } else {
+ "unknown"
+ }
+ })
result <- extract_connections(expanded_equations)
elim_count <- sum(sapply(result$connections, function(c) c$to == 0))
elim_coeff <- map_chr(result$connections, function(c) if (c$to == 0) c$coeff else NA) %>% keep(~ !is.na(.))
diff --git a/R/PM_sim.R b/R/PM_sim.R
index 70fa3eeb2..7a6b3e1dd 100755
--- a/R/PM_sim.R
+++ b/R/PM_sim.R
@@ -571,6 +571,8 @@ PM_sim <- R6::R6Class(
))
}
+ useTheta <- FALSE # default, unless poppar is theta.csv format
+
# CASE 1 - poppar is PM_result
if (inherits(poppar, "PM_result")) {
@@ -666,8 +668,13 @@ PM_sim <- R6::R6Class(
# not returning because going on to simulate below
### This is for loading a saved simulation from file
+ } else if (inherits(poppar, "data.frame")){ # poppar is in the form of theta.csv
+ poppar$prob <- 1/nrow(poppar)
+ final <- list(popPoints = poppar)
+ useTheta <- TRUE
+ case <- 8
- # CASE 8 - last option, poppar is filename
+ # CASE 9 - last option, poppar is filename
} else {
if (file.exists(poppar)) {
if (grepl("rds$", poppar, perl = TRUE)) { # poppar is rds filename
@@ -695,9 +702,9 @@ PM_sim <- R6::R6Class(
} # end if poppar is filename
# If we reach this point, we are creating a new simulation
-
+
# check model and data
- if(case %in% c(2, 3, 7)) { # need model and data if not from PM_result
+ if(case %in% c(2, 3, 7, 8)) { # need model and data if not from PM_result
if (missing(model)) { model <- "model.txt" } # try the default
if (!inherits(model, "PM_model")) {model <- PM_model$new(model, compile = FALSE)} # compile later
@@ -791,7 +798,7 @@ PM_sim <- R6::R6Class(
seed = seed, ode = ode,
noise = noise,
makecsv = makecsv, outname = outname, clean = clean,
- quiet = quiet,
+ quiet = quiet, useTheta = useTheta,
nocheck = nocheck, overwrite = overwrite, msg = msg
)
@@ -899,14 +906,14 @@ PM_sim <- R6::R6Class(
covariate, usePost,
seed, ode,
noise,
- makecsv, outname, clean, quiet,
+ makecsv, outname, clean, quiet, useTheta,
nocheck, overwrite, msg) {
# DATA PROCESSING AND VALIDATION ------------------------------------------
###### POPPAR
- npar <- nrow(poppar$popCov)
+ npar <- ncol(poppar$popPoints) - 1
###### MODEL
@@ -1182,13 +1189,13 @@ PM_sim <- R6::R6Class(
"i" = "E.g. {.code limits = list(wt = c(40, 80), age = c(10, 50))}. See {.fn PM_sim} for help."
))
}
-
+
# figure out which covariates have different limits and change them
covUpdates <- tibble::enframe(covariate$limits, name = "par", value = "rng") %>%
tidyr::unnest_wider(rng, names_sep = "") %>%
dplyr::rename(min = rng1, max = rng2)
-
+
covLimits <- dplyr::rows_update(covLimits, covUpdates, by = "par")
# goodNames <- which(names(covMean) %in% names(covariate$limits))
@@ -1350,17 +1357,21 @@ PM_sim <- R6::R6Class(
} else { # postToUse is false
# set theta as nsim rows drawn from prior
- thisPrior <- private$getSimPrior(
- i = 1,
- poppar = poppar,
- split = split,
- postToUse = NULL,
- limits = limits,
- seed = seed[1],
- nsim = nsim,
- toInclude = toInclude,
- msg = msg
- )
+ if(!useTheta){
+ thisPrior <- private$getSimPrior(
+ i = 1,
+ poppar = poppar,
+ split = split,
+ postToUse = NULL,
+ limits = limits,
+ seed = seed[1],
+ nsim = nsim,
+ toInclude = toInclude,
+ msg = msg
+ )
+ } else {
+ thisPrior <- list(thetas = poppar$popPoints)
+ }
self$data <- private$getSim(thisPrior, template, mod, noise2, msg = msg)
}
@@ -1506,7 +1517,6 @@ PM_sim <- R6::R6Class(
# call simulator and process results
getSim = function(thisPrior, template, mod, noise2, msg = NULL) {
-
thetas <- thisPrior$thetas %>%
select(-prob) %>%
as.matrix()
diff --git a/R/PM_tutorial.R b/R/PM_tutorial.R
index b9a599f68..b2a54b734 100755
--- a/R/PM_tutorial.R
+++ b/R/PM_tutorial.R
@@ -61,9 +61,9 @@ PM_tutorial <- function() {
cli::cli_text("Click {.file {file.path(ans, 'Learn/Rscript/Learn.R')}} to proceed with the tutorial.")
# create the sample data files
- data(modEx, dataEx)
+ data(dataEx)
+ # example data
readr::write_csv(dataEx$data, file = file.path(ans, "Learn", "src", "ex.csv" ), na = ".")
- modEx$save(file = file.path(ans, "Learn", "src", "model.txt" ))
# simulation template
PM_data$new()$
addEvent(id = 1, time = 0, dose = 500, addl = 5, ii = 24, wt = 46.7, africa = 1, age = 21, gender = 1, height = 180)$
diff --git a/R/PMbuild.R b/R/PMbuild.R
index e397be881..30fd0bc40 100755
--- a/R/PMbuild.R
+++ b/R/PMbuild.R
@@ -16,10 +16,11 @@
PM_build <- function() {
- clear_build() # clean prior template/artifacts
+
if (is_rustup_installed()) {
cli::cli_text("Rust was detected in your system, Fetching dependencies and building base project.")
- dummy_compile(template_path = getPMoptions("model_template_path"))
+ template_path <- if (Sys.getenv("env") == "Development") { file.path(temporary_path(), "template") } else { system.file(package = "Pmetrics")}
+ dummy_compile(template_path = template_path)
} else {
cli::cli_text("Rust was not detected in your system, this can be caused by multiple reasons:")
ul <- cli::cli_ul()
diff --git a/R/PMoptions.R b/R/PMoptions.R
index d2d8ea235..13e96cbbf 100755
--- a/R/PMoptions.R
+++ b/R/PMoptions.R
@@ -100,208 +100,452 @@ setPMoptions <- function(launch.app = TRUE) {
# --- UI ---
ui = bslib::page_fluid(
- theme = bslib::bs_theme(bootswatch = "flatly"),
+ theme = bslib::bs_theme(
+ bootswatch = "flatly",
+ primary = "#2c3e50",
+ "card-border-radius" = "0.5rem"
+ ),
title = "Pmetrics Options",
- tags$details(
- tags$summary("Data File Reading"),
- selectInput("sep", "Field separator",
- choices = c(Comma = ",", Semicolon = ";", Tab = "\t"),
- selected = ","),
+ shiny::tags$div(
+ class = "container-fluid p-4",
- selectInput("dec", "Decimal mark",
- choices = c(Period = ".", Comma = ","),
- selected = ".")
- ),
- # Formatting options
- tags$details(
- tags$summary("Formatting Options"),
- numericInput("digits", "Number of digits to display",
- value = 3, min = 0, max = 10, step = 1)
- ),
-
-
- #Compile options
- # tags$details(
- # tags$summary("Compile Options"),
- # markdown("Default Rust model template path is in Pmetrics package installation folder. Change if you have write permission errors."),
- # tags$div(
- # style = "display: flex; align-items: flex-start; gap: 8px;",
- # textAreaInput("model_template_path", NULL, value = system.file(package = "Pmetrics"), autoresize = TRUE),
- # actionButton("reset_model_template", "Reset to default", class = "btn-secondary")
- # ),
- # conditionalPanel(
- # condition = "input.show == false",selectInput("backend", "Default backend",
- # choices = c("Rust" = "rust"),
- # selected = "rust"),
- # markdown("*Rust is the only backend currently supported by Pmetrics.*")
- # )
- # ),
-
- tags$details(
- tags$summary("Prediction Error Metrics"),
- br(),
- checkboxInput("show_metrics", "Display error metrics on obs-pred plots with linear regression", TRUE),
- selectInput("bias_method", "Bias Method",
- choices = c(
- "Mean absolute error (MAE)" = "mae",
- "Mean weighted error (MWE)" = "mwe"
+ # Header
+ shiny::tags$div(
+ class = "mb-4",
+ shiny::tags$h2(
+ class = "mb-1",
+ shiny::icon("cog", class = "me-2"),
+ "Pmetrics Options"
+ ),
+ shiny::tags$p(class = "text-muted mb-0", "Configure your Pmetrics preferences")
),
- selected = "mwe"),
- selectInput("imp_method", "Imprecision Method",
- choices = c(
+ # Main content layout - use fluidRow for proper spacing
+ shiny::fluidRow(
+ # Left column
+ shiny::column(
+ width = 6,
+ # Data File Reading Card
+ bslib::card(
+ class = "mb-3",
+ bslib::card_header(
+ class = "bg-primary text-white",
+ shiny::icon("file-csv", class = "me-2"),
+ "Data File Reading"
+ ),
+ bslib::card_body(
+ shiny::fluidRow(
+ shiny::column(
+ width = 6,
+ shiny::selectInput(
+ "sep",
+ bslib::tooltip(
+ shiny::tags$span("Field separator", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Character used to separate fields in data files"
+ ),
+ choices = c(Comma = ",", Semicolon = ";", Tab = "\t"),
+ selected = ","
+ )
+ ),
+ shiny::column(
+ width = 6,
+ shiny::selectInput(
+ "dec",
+ bslib::tooltip(
+ shiny::tags$span("Decimal mark", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Character used as decimal point in numbers"
+ ),
+ choices = c(Period = ".", Comma = ","),
+ selected = "."
+ )
+ )
+ )
+ )
+ ),
+
+ # Formatting Options Card
+ bslib::card(
+ class = "mb-3",
+ bslib::card_header(
+ class = "bg-primary text-white",
+ shiny::icon("hashtag", class = "me-2"),
+ "Display Formatting"
+ ),
+ bslib::card_body(
+ shiny::numericInput(
+ "digits",
+ bslib::tooltip(
+ shiny::tags$span("Decimal places", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Number of decimal places to show in output"
+ ),
+ value = 3, min = 0, max = 10, step = 1
+ )
+ )
+ ),
+
+ # Report Generation Card
+ bslib::card(
+ class = "mb-3",
+ bslib::card_header(
+ class = "bg-primary text-white",
+ shiny::icon("file-lines", class = "me-2"),
+ "Fit Report Template"
+ ),
+ bslib::card_body(
+ shiny::selectInput(
+ "report_template",
+ bslib::tooltip(
+ shiny::tags$span("Plot library", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "HTML summary of model fit to open in browser"
+ ),
+ choices = c(
+ "Interactive (plotly)" = "plotly",
+ "Static (ggplot2)" = "ggplot2"
+ ),
+ selected = "plotly"
+ )
+ )
+ )
+ ), # end left column
- "Mean squared error (MSE)" = "mse",
- "Mean weighted squared error (MWSE)" = "mwse",
- "Root mean squared error (RMSE)" = "rmse",
- "Mean, bias-adjusted, squared error (MBASE)" = "mbase",
- "Mean, bias-adjusted, weighted, squared error (MBAWSE)" = "mbawse",
- "Root mean, bias-adjusted, weighted, squared error (RMBAWSE)" = "rmbawse"
- ),
- selected = "rmbawse"),
-
- checkboxInput("use_percent", "Use percent for error metrics", value = TRUE),
-
- selectInput("ic_method", "Information Criterion Method",
- choices = c(
- "Akaike Information Criterion (AIC)" = "aic",
- "Bayesian Information Criterion (BIC)" = "bic"
- ),
- selected = "aic")
+ # Right column - Prediction Error Metrics Card
+ shiny::column(
+ width = 6,
+ bslib::card(
+ class = "mb-3",
+ bslib::card_header(
+ class = "bg-primary text-white",
+ shiny::icon("chart-line", class = "me-2"),
+ "Prediction Error Metrics"
+ ),
+ bslib::card_body(
+ shiny::tags$div(
+ class = "mb-3",
+ bslib::input_switch(
+ "show_metrics",
+ shiny::tags$span(
+ "Show metrics on plots",
+ bslib::tooltip(
+ shiny::icon("circle-question", class = "ms-1 text-muted"),
+ "Display error metrics on observed vs. predicted plots"
+ )
+ ),
+ value = TRUE
+ )
+ ),
+
+ shiny::tags$hr(class = "my-3"),
+
+ shiny::selectInput(
+ "bias_method",
+ bslib::tooltip(
+ shiny::tags$span("Bias method", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Method to calculate prediction bias (accuracy)"
+ ),
+ choices = c(
+ "Mean Absolute Error (MAE)" = "mae",
+ "Mean Weighted Error (MWE)" = "mwe"
+ ),
+ selected = "mwe"
+ ),
+
+ shiny::selectInput(
+ "imp_method",
+ bslib::tooltip(
+ shiny::tags$span("Imprecision method", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Method to calculate prediction imprecision (scatter)"
+ ),
+ choices = c(
+ "Mean Squared Error (MSE)" = "mse",
+ "Mean Weighted Squared Error (MWSE)" = "mwse",
+ "Root Mean Squared Error (RMSE)" = "rmse",
+ "Mean Bias-Adjusted Squared Error (MBASE)" = "mbase",
+ "Mean Bias-Adjusted Weighted Squared Error (MBAWSE)" = "mbawse",
+ "Root Mean Bias-Adjusted Weighted Squared Error (RMBAWSE)" = "rmbawse"
+ ),
+ selected = "rmbawse"
+ ),
+
+ shiny::tags$div(
+ class = "mb-3",
+ bslib::input_switch(
+ "use_percent",
+ shiny::tags$span(
+ "Report as percentages",
+ bslib::tooltip(
+ shiny::icon("circle-question", class = "ms-1 text-muted"),
+ "Express error metrics as percentages"
+ )
+ ),
+ value = TRUE
+ )
+ ),
+
+ shiny::tags$hr(class = "my-3"),
+
+ shiny::selectInput(
+ "ic_method",
+ bslib::tooltip(
+ shiny::tags$span("Information criterion", shiny::icon("circle-question", class = "ms-1 text-muted")),
+ "Method for model comparison"
+ ),
+ choices = c(
+ "Akaike Information Criterion (AIC)" = "aic",
+ "Bayesian Information Criterion (BIC)" = "bic"
+ ),
+ selected = "aic"
+ )
+ )
+ )
+ ) # end right column
+ ), # end fluidRow
- ),
-
- tags$details(
- tags$summary("Report Generation"),
- selectInput("report_template", "Default report template",
- choices = c("plotly", "ggplot2"),
- selected = "plotly")
- ),
- br(),
- div(
- class = "d-flex gap-2",
- actionButton("save", "Save"),
- actionButton("exit", "Exit"),
- ),
-
- br(),
- br(),
- shiny::verbatimTextOutput("settings_location"),
- br(),
-
- actionButton("open_file", "Open Options File",
- icon = icon("folder-open"), class = "btn-primary")
+ # Footer with buttons and file location
+ shiny::fluidRow(
+ shiny::column(
+ width = 12,
+ bslib::card(
+ class = "mt-3",
+ bslib::card_body(
+ class = "py-3",
+ shiny::fluidRow(
+ # Left side: action buttons with unsaved indicator below
+ shiny::column(
+ width = 6,
+ shiny::tags$div(
+ id = "button-container",
+ style = "display: inline-block;",
+ shiny::tags$div(
+ class = "d-flex gap-2",
+ shiny::actionButton(
+ "save",
+ shiny::tags$span(shiny::icon("floppy-disk", class = "me-1"), "Save"),
+ class = "btn-success"
+ ),
+ shiny::actionButton(
+ "exit",
+ shiny::tags$span(shiny::icon("xmark", class = "me-1"), "Close"),
+ class = "btn-secondary"
+ )
+ ),
+ shiny::uiOutput("save_status")
+ )
+ ),
+ # Right side: file location
+ shiny::column(
+ width = 6,
+ shiny::tags$div(
+ class = "d-flex gap-2 align-items-center justify-content-end",
+ shiny::tags$small(
+ class = "text-muted me-2",
+ shiny::tags$span(
+ shiny::icon("folder", class = "me-1"),
+ "Options file: ",
+ shiny::textOutput("settings_path", inline = TRUE)
+ )
+ ),
+ shiny::actionButton(
+ "open_file",
+ shiny::tags$span(shiny::icon("external-link-alt", class = "me-1"), "Open"),
+ class = "btn-outline-primary btn-sm"
+ )
+ )
+ )
+ )
+ )
+ )
+ )
+ ) # end footer fluidRow
+ ) # end container div
),
# --- Server ---
server = function(input, output, session) {
+ # Track if there are unsaved changes
+ unsaved_changes <- shiny::reactiveVal(FALSE)
+
# Load settings from external file
settings <- tryCatch({
jsonlite::fromJSON(PMoptionsUserFile)
}, error = function(e) NULL)
- # update this list every time a new option is added
- input_types <- list(
- sep = updateSelectInput,
- dec = updateSelectInput,
- show_metrics = updateCheckboxInput,
- digits = updateNumericInput,
- bias_method = updateSelectInput,
- imp_method = updateSelectInput,
- use_percent = updateCheckboxInput,
- ic_method = updateSelectInput,
- report_template = updateSelectInput,
- backend = updateSelectInput,
- model_template_path = updateTextAreaInput
- )
+ # Apply saved settings to inputs
+ if (!is.null(settings)) {
+ # Select inputs
+ if (!is.null(settings$sep)) shiny::updateSelectInput(session, "sep", selected = settings$sep)
+ if (!is.null(settings$dec)) shiny::updateSelectInput(session, "dec", selected = settings$dec)
+ 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)
+
+ # Bias/imprecision methods - strip percent_ prefix for display
+ if (!is.null(settings$bias_method)) {
+ shiny::updateSelectInput(session, "bias_method", selected = stringr::str_remove(settings$bias_method, "^percent_"))
+ }
+ if (!is.null(settings$imp_method)) {
+ shiny::updateSelectInput(session, "imp_method", selected = stringr::str_remove(settings$imp_method, "^percent_"))
+ }
+
+ # Switch inputs - bslib::update_switch uses 'id' not 'inputId'
+ if (!is.null(settings$show_metrics)) bslib::update_switch(id = "show_metrics", value = settings$show_metrics, session = session)
+ if (!is.null(settings$use_percent)) {
+ # Determine use_percent from the bias_method prefix
+ use_pct <- grepl("^percent_", settings$bias_method)
+ bslib::update_switch(id = "use_percent", value = use_pct, session = session)
+ }
+ }
+ # Flag to track if initial load is complete
+ # We use a timer to wait for the async update cycle to complete:
+ # 1) Server sends update messages to client
+ # 2) Client updates inputs and sends new values back
+ # 3) Server receives the updated values
+ # This round-trip needs time to complete before we start tracking changes
+ initialized <- shiny::reactiveVal(FALSE)
+ init_timer <- shiny::reactiveTimer(1000, session)
- # Apply updates
- purrr::imap(settings, function(val, name) {
- updater <- input_types[[name]]
- arg_name <- input_types[[name]] %>% formals() %>% names() %>% keep(~ .x %in% c("value", "selected"))
-
- if (!is.null(updater) && !is.null(arg_name)) {
- args <- list(session = session, inputId = name)
- args[[arg_name]] <- val %>% stringr::str_remove("^percent_") # remove 'percent_' prefix if present
- do.call(updater, args)
- }
- })
+ shiny::observeEvent(init_timer(), {
+ initialized(TRUE)
+ }, once = TRUE, ignoreInit = TRUE)
+
+ # Mark changes when any input changes (only after initialization)
+ shiny::observe({
+ # Only mark changes after initial load is complete
+ if (initialized()) {
+ unsaved_changes(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,
+ ignoreInit = TRUE
+ )
- # Display path to user settings file
- output$settings_location <- renderText({
- glue::glue("Options file path:\n{PMoptionsUserFile}")
+ # Display path to user settings file (truncated for display)
+ output$settings_path <- shiny::renderText({
+ # Truncate path for display if too long
+ path <- PMoptionsUserFile
+ if (nchar(path) > 50) {
+ path <- paste0("...", substr(path, nchar(path) - 47, nchar(path)))
+ }
+ path
})
+ # Show save status indicator below the buttons (full width of button container)
+ output$save_status <- shiny::renderUI({
+ if (unsaved_changes()) {
+ shiny::tags$div(
+ class = "mt-2 badge bg-warning text-dark d-flex align-items-center justify-content-center py-2",
+ style = "width: 100%;",
+ shiny::icon("exclamation-triangle", class = "me-1"),
+ "Unsaved changes"
+ )
+ } else {
+ NULL
+ }
+ })
### Action button handlers
# Save updated settings
- observeEvent(input$save, {
- settings <- list(sep = input$sep, dec = input$dec, digits = input$digits, show_metrics = input$show_metrics,
- 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),
+ shiny::observeEvent(input$save, {
+ settings <- list(
+ sep = input$sep,
+ dec = input$dec,
+ digits = input$digits,
+ show_metrics = input$show_metrics,
+ 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, backend = input$backend,
- model_template_path = input$model_template_path)
-
- save_status <- tryCatch(jsonlite::write_json(settings, PMoptionsUserFile, pretty = TRUE, auto_unbox = TRUE),
- error = function(e) {
- shiny::showNotification(
- paste("Error saving settings:", e$message),
- type = "error", duration = 5
- )
- return(FALSE)
- })
+ report_template = input$report_template
+ # backend = input$backend,
+ # model_template_path = input$model_template_path
+ )
+
+ tryCatch({
+ jsonlite::write_json(settings, PMoptionsUserFile, pretty = TRUE, auto_unbox = TRUE)
+ unsaved_changes(FALSE)
shiny::showNotification(
- "Settings saved", type = "message", duration = 3
+ shiny::tags$span(shiny::icon("check", class = "me-1"), "Settings saved successfully!"),
+ type = "message",
+ duration = 3
)
- })
-
- # Reset model template path to default
- observeEvent(input$reset_model_template, {
- updateTextAreaInput(
- session,
- inputId = "model_template_path",
- value = system.file(package = "Pmetrics")
+ }, error = function(e) {
+ shiny::showNotification(
+ shiny::tags$span(shiny::icon("times-circle", class = "me-1"), paste("Error saving:", e$message)),
+ type = "error",
+ duration = 5
)
})
-
-
- # Exit the app
- observeEvent(input$exit, {
+ })
+
+ # # Reset model template path to default
+ # shiny::observeEvent(input$reset_model_template, {
+ # shiny::updateTextAreaInput(
+ # session,
+ # inputId = "model_template_path",
+ # value = system.file(package = "Pmetrics")
+ # )
+ # })
+
+ # Exit the app with confirmation if unsaved changes
+ shiny::observeEvent(input$exit, {
+ if (unsaved_changes()) {
+ shiny::showModal(shiny::modalDialog(
+ title = shiny::tags$span(shiny::icon("exclamation-triangle", class = "me-2 text-warning"), "Unsaved Changes"),
+ "You have unsaved changes. Are you sure you want to exit?",
+ footer = shiny::tagList(
+ shiny::actionButton("confirm_exit", "Exit without saving", class = "btn-danger"),
+ shiny::modalButton("Cancel")
+ ),
+ easyClose = TRUE
+ ))
+ } else {
shiny::stopApp()
- # if (file.access(input$model_template_path, 0) == 0 & file.access(input$model_template_path, 2) == 0){
- # shiny::stopApp()
- # } else {
- # shiny::showModal(shiny::modalDialog(
- # title = "Permission Error",
- # "The specified model template path is not writable. Please choose a different path with write permissions before exiting.",
- # easyClose = TRUE,
- # footer = NULL
- # ))
- # }
- })
-
- # Open the options file in the default application
- observeEvent(input$open_file, {
- system(glue::glue("open {PMoptionsUserFile}"))
- })
- } #end server
- ) #end shinyApp
-
+ }
+ })
+
+ # Confirm exit without saving
+ shiny::observeEvent(input$confirm_exit, {
+ shiny::removeModal()
+ shiny::stopApp()
+ })
+
+ # Open the options file in the default application (cross-platform)
+ shiny::observeEvent(input$open_file, {
+ os <- getOS()
+ if (os == 1) {
+ # macOS
+ system2("open", PMoptionsUserFile)
+ } else if (os == 2) {
+ # Windows - use shell command
+ system2("cmd", c("/c", "start", "", shQuote(PMoptionsUserFile)))
+ } else if (os == 3) {
+ # Linux
+ system2("xdg-open", PMoptionsUserFile)
+ } else {
+ shiny::showNotification(
+ "Unable to open file on this operating system.",
+ type = "warning",
+ duration = 3
+ )
+ }
+ })
+ } #end server
+ ) #end shinyApp
- # Launch the app without trying to launch another browser
- if(launch.app){
- shiny::runApp(app, launch.browser = TRUE)
- }
- return(invisible(NULL))
+ # Launch the app without trying to launch another browser
+ if(launch.app){
+ shiny::runApp(app, launch.browser = TRUE)
+ }
+
+ return(invisible(NULL))
- } # end of PM_options function
+} # end of PM_options function
diff --git a/data-raw/data-raw.R b/data-raw/data-raw.R
index e620122b9..f772af6e7 100755
--- a/data-raw/data-raw.R
+++ b/data-raw/data-raw.R
@@ -35,11 +35,44 @@ usethis::use_data(mic1, overwrite = TRUE)
# Run Files -------------------------------------------------------------------
-model <- readLines(file.path(wd, "model.txt"))
-usethis::use_data(model, overwrite = TRUE)
+# model <- readLines(file.path(wd, "model.txt"))
+# usethis::use_data(model, overwrite = TRUE)
+
+# # model file
+#modEx <- PM_model$new(file.path(wd, "model.txt"))
+modEx <- PM_model$new(
+
+ pri = list(
+ ka = ab(0.100, 0.900),
+ ke = ab(0.001, 0.100),
+ v = ab(30.000, 120.000),
+ tlag1 = ab(0.000, 4.000)
+ ),
+ cov = list(
+ wt = interp(),
+ africa = interp(),
+ age = interp(),
+ gender = interp(),
+ height = interp()
+ ),
+ lag = function ()
+ {
+ lag[1] = tlag1
+ },
+ eqn = function ()
+ {
+ dx[1] = b[1] - ka * x[1]
+ dx[2] = rateiv[1] + ka * x[1] - ke * x[2]
+ },
+ out = function ()
+ {
+ y[1] = x[2]/v
+ },
+ err = list(
+ proportional(5, c(0.0, 0.1, -0.0, 0.0))
+ )
-# model file
-modEx <- PM_model$new(file.path(wd, "model.txt"))
+)
usethis::use_data(modEx, overwrite = TRUE)
# data
diff --git a/data/modEx.rda b/data/modEx.rda
index 663006338..014ac8a24 100755
Binary files a/data/modEx.rda and b/data/modEx.rda differ
diff --git a/data/model.rda b/data/model.rda
deleted file mode 100755
index 6f5895d4d..000000000
Binary files a/data/model.rda and /dev/null differ
diff --git a/man/PM_model.Rd b/man/PM_model.Rd
index 148e63831..7695c6de1 100755
--- a/man/PM_model.Rd
+++ b/man/PM_model.Rd
@@ -6,8 +6,8 @@
\description{
\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}}
-PM_model objects contain the variables, covariates, equations and error models
-necessary to run a population analysis.
+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
@@ -95,6 +95,7 @@ the original arguments into Rust}
\item \href{#method-PM_model-map}{\code{PM_model$map()}}
\item \href{#method-PM_model-sim}{\code{PM_model$sim()}}
\item \href{#method-PM_model-compile}{\code{PM_model$compile()}}
+\item \href{#method-PM_model-save}{\code{PM_model$save()}}
\item \href{#method-PM_model-copy}{\code{PM_model$copy()}}
\item \href{#method-PM_model-clone}{\code{PM_model$clone()}}
}
@@ -697,6 +698,22 @@ file to a binary file that can be used for fitting or simulation.
If the model is already compiled, the method does nothing.
}
+}
+\if{html}{\out{
}}
+\if{html}{\out{}}
+\if{latex}{\out{\hypertarget{method-PM_model-save}{}}}
+\subsection{Method \code{save()}}{
+Save model to file (deprecated).
+\subsection{Usage}{
+\if{html}{\out{}}\preformatted{PM_model$save()}\if{html}{\out{
}}
+}
+
+\subsection{Details}{
+This method is deprecated. Existing or manually created model files may be read with \code{PM_model$new(filename)},
+but including model code in scripts is preferred, as this makes models used in runs transparent and more easily edited.
+Use the \code{PM_model$copy()} method instead to copy the model code to the clipboard and paste into scripts.
+}
+
}
\if{html}{\out{
}}
\if{html}{\out{}}
@@ -709,8 +726,7 @@ Copy model code to clipboard.
\subsection{Details}{
This method copies the R code to create the model to the clipboard.
-This is useful for saving the model code in a script, as model files
-will be deprecated in future versions of Pmetrics.
+This is useful for saving the model code in a script.
}
}
diff --git a/man/model.Rd b/man/model.Rd
deleted file mode 100755
index 71955b059..000000000
--- a/man/model.Rd
+++ /dev/null
@@ -1,19 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/DataDescriptions.R
-\docType{data}
-\name{model}
-\alias{model}
-\title{Pmetrics model}
-\format{
-Sample model text
-}
-\usage{
-model
-}
-\description{
-Pmetrics model
-}
-\author{
-Michael Neely
-}
-\keyword{datasets}