Cleaned up examples + moved outdated vignettes folder to workshops

Author: simonbeyer1

.gitignore

@@ -1,21 +1,57 @@
+# -------------------------------------------------
 # R / RStudio
+# -------------------------------------------------
 .Rproj.user/
 .Rhistory
 .RData
 .Rbuildignore
 
+# -------------------------------------------------
 # Git / Editor
+# -------------------------------------------------
 .gitignore.swp
+.DS_Store
+Thumbs.db
 
+# -------------------------------------------------
+# R CMD check / build artefacts
+# -------------------------------------------------
+*.tar.gz
+*.Rcheck/
+.Rcheck/
+inst/doc/
+
+# -------------------------------------------------
+# R Markdown / knitr
+# -------------------------------------------------
+README.html
+README_files/
+*.knit.md
+*.utf8.md
+*_cache/
+*_files/
+.cache/
+
+# -------------------------------------------------
 # Working directories
+# -------------------------------------------------
 /wd/
 /deriv2Tests/
+inst/workshops/
 
-# Files starting with .f
+# -------------------------------------------------
+# Temporary / generated files
+# -------------------------------------------------
 .f*
+*.log
+*.tmp
 
+# -------------------------------------------------
 # Compiled objects
+# -------------------------------------------------
 *.c
 *.o
 *.so
-
+*.dll
+*.a
+*.dylib

DESCRIPTION

@@ -11,7 +11,6 @@ Description: The framework provides functions to generate ODEs of reaction
     used for optimization whenever possible. Therefore, all major functions produce
     and can handle expressions for symbolic derivatives.
 License: GPL (>= 2)
-LinkingTo: BH
 Depends:
     cOde (>= 1.1)
 Imports:
@@ -35,7 +34,9 @@ Imports:
     abind,
     einsum,
     optimx,
-    nleqslv
+    nleqslv,
+    reticulate,
+    BH
 Remotes:
     simonbeyer1/CppODE@v1.0.0
 Suggests:
@@ -44,6 +45,5 @@ Suggests:
     knitr,
     rmarkdown,
 RoxygenNote: 7.3.3
-VignetteBuilder: knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -124,17 +124,16 @@ S3method(wide2long,data.frame)
 S3method(wide2long,list)
 S3method(wide2long,matrix)
 export("%.*%")
-export("+.objlist")
 export("controls<-")
 export("modelname<-")
 export(Id)
 export(P)
 export(Pexpl)
 export(Pimpl)
-export(SVDIA)
 export(Xd)
 export(Xf)
 export(Xs)
+export(Xt)
 export(Y)
 export(addEvent)
 export(addReaction)
@@ -242,8 +241,6 @@ export(plotPrediction)
 export(plotProfile)
 export(plotProfilesAndPaths)
 export(plotResiduals)
-export(plotRightVector)
-export(plotSVDs)
 export(plotValues)
 export(prdfn)
 export(prdframe)
@@ -317,7 +314,6 @@ importFrom(ggplot2,ylab)
 importFrom(graphics,par)
 importFrom(nleqslv,nleqslv)
 importFrom(optimx,optimr)
-importFrom(parallel,mclapply)
 importFrom(reticulate,import)
 importFrom(reticulate,py_run_string)
 importFrom(rjson,fromJSON)

R/classes.R

@@ -1421,17 +1421,19 @@ test_conditions <- function(c1, c2) {
 #' @param ... arguments going to the appropriate S3 methods
 #' @return Either a print-out or the values of the control.
 #' @examples
-#' ## parfn with condition
-#' p <- P(eqnvec(x = "-a*x"), method = "implicit", condition = "C1")
-#' controls(p)
-#' controls(p, "C1", "keep.root")
-#' controls(p, "C1", "keep.root") <- FALSE
-#'
-#' ## obsfn with NULL condition
-#' g <- Y(g = eqnvec(y = "s*x"), f = NULL, states = "x", parameters = "s")
-#' controls(g)
-#' controls(g, NULL, "attach.input")
-#' controls(g, NULL, "attach.input") <- FALSE
+#' \dontrun{
+#'   ## parfn with condition
+#'   p <- P(eqnvec(x = "-a*x"), method = "implicit", condition = "C1")
+#'   controls(p)
+#'   controls(p, "C1", "keep.root")
+#'   controls(p, "C1", "keep.root") <- FALSE
+#'   
+#'   ## obsfn with NULL condition
+#'   g <- Y(g = eqnvec(y = "s*x"), f = NULL, states = "x", parameters = "s")
+#'   controls(g)
+#'   controls(g, NULL, "attach.input")
+#'   controls(g, NULL, "attach.input") <- FALSE
+#' }
 #' @export
 controls <- function(x, ...) {
   UseMethod("controls", x)

R/eventClass.R

@@ -15,17 +15,19 @@
 #' @export
 #'
 #' @examples
-#' eventlist(var = "A", time = "5", value = 1, method = "add")
-#' 
-#' events <- addEvent(NULL, var = "A", time = "5", value = 1, method = "add")
-#' events <- addEvent(events, var = "A", time = "10", value = 1, method = "add")
-#' 
-#' # With symbols
-#' events <- eventlist()
-#' # Set "A" to "value_switch" at time "time_Switch"
-#' events <- addEvent(events, var = "A", time = "time_switch", value = "value_switch", method = "replace")
-#' # Set "B" to 2 when "A" reaches "A_target". The time-parameter for internal use will be "time_root".
-#' events <- addEvent(events, var = "B", time = "time_root", value = 2, root = "A - A_target", method = "replace")
+#' \dontrun{
+#'   eventlist(var = "A", time = "5", value = 1, method = "add")
+#'   
+#'   events <- addEvent(NULL, var = "A", time = "5", value = 1, method = "add")
+#'   events <- addEvent(events, var = "A", time = "10", value = 1, method = "add")
+#'   
+#'   # With symbols
+#'   events <- eventlist()
+#'   # Set "A" to "value_switch" at time "time_Switch"
+#'   events <- addEvent(events, var = "A", time = "time_switch", value = "value_switch", method = "replace")
+#'   # Set "B" to 2 when "A" reaches "A_target". The time-parameter for internal use will be "time_root".
+#'   events <- addEvent(events, var = "B", time = "time_root", value = 2, root = "A - A_target", method = "replace")
+#' }
 eventlist <- function(var = NULL, time = NULL, value = NULL, root = NULL, method = NULL) {
 
   # root is NULL if all are NULL or NA if any is not NULL

R/objClass.R

@@ -1262,15 +1262,8 @@ nll_BLOQ <- function(nout.bloq,
 #' the corresponding elements of out1 and out2 as they are.
 #' @return List of length of out1. 
 #' @aliases sumobjlist
-#' @export "+.objlist"
 #' @export
 #' 
-#' @examples 
-#' objlist1 <- dMod:::init_empty_objlist(c(a = 1, b = 2))
-#' objlist1$value  = 1; objlist1$gradient[1:2] <- 1; objlist1$hessian[1:4] <- 1
-#' objlist2 <- dMod:::init_empty_objlist(c(a = 1, d = 2))
-#' objlist2$value  = 1; objlist2$gradient[1:2] <- 1; objlist2$hessian[1:4] <- 1
-#' objlist1 + objlist2
 "+.objlist" <- function(out1, out2) {
 
   if (is.null(out1)) return(out2)

R/prediction.R

@@ -188,11 +188,12 @@ Xs.deSolve <- function(odemodel,
 #'   and proper `dimnames` for variables and parameters.
 #'
 #' @examples
-#' # Example column names: "A.k1", "A.k2", "B.k1", "B.k2"
-#' mysens <- matrix(runif(40), nrow = 10)
-#' colnames(mysens) <- c("A.k1", "A.k2", "B.k1", "B.k2")
-#' reshapeSens(mysens, variables = c("A", "B"), parameters = c("k1", "k2"))
-#'
+#' \dontrun{
+#'   # Example column names: "A.k1", "A.k2", "B.k1", "B.k2"
+#'   mysens <- matrix(runif(40), nrow = 10)
+#'   colnames(mysens) <- c("A.k1", "A.k2", "B.k1", "B.k2")
+#'   reshapeSens(mysens, variables = c("A", "B"), parameters = c("k1", "k2"))
+#' }
 #' @keywords internal
 reshapeSens <- function(sensMatrix, variables, parameters) {
   n_times <- nrow(sensMatrix)
@@ -521,6 +522,7 @@ Xf <- function(odemodel, forcings = NULL, events = NULL, condition = NULL, optio
 #' the data frame), and possibly "pouter", a named numeric vector which is generated
 #' from `data$value`.
 #' @examples
+#' \dontrun{
 #' # Generate a data.frame and corresponding prediction function
 #' timesD <- seq(0, 2*pi, 0.5)
 #' mydata <- data.frame(name = "A", time = timesD, value = sin(timesD), 
@@ -533,6 +535,7 @@ Xf <- function(odemodel, forcings = NULL, events = NULL, condition = NULL, optio
 #' prediction <- x(times, pouter)
 #' plot(prediction)
 #' 
+#' }
 #' @export
 Xd <- function(data, condition = NULL) {
 
@@ -1030,51 +1033,53 @@ Y <- function(g, f = NULL, states = NULL, parameters = NULL, condition = NULL,
 }
 
 
-# #' Generate a prediction function that returns times
-# #' 
-# #' Function to deal with non-ODE models within the framework of dMod. See example.
-# #' 
-# #' @param condition  either NULL (generic prediction for any condition) or a character, denoting
-# #' the condition for which the function makes a prediction.
-# #' @return Object of class [prdfn].
-# #' @examples 
-# #' x <- Xt()
-# #' g <- Y(c(y = "a*time^2+b"), f = NULL, parameters = c("a", "b"))
-# #' 
-# #' times <- seq(-1, 1, by = .05)
-# #' pars <- c(a = .1, b = 1)
-# #' 
-# #' plot((g*x)(times, pars))
-# #' @export
-# Xt <- function(condition = NULL) {
-# 
-# 
-# 
-#   # Controls to be modified from outside
-#   controls <- list()
-# 
-#   P2X <- function(times, pars, deriv=TRUE){
-# 
-#     out <- matrix(times, ncol = 1, dimnames = list(NULL, "time"))
-#     sens <- deriv <- out
-# 
-#     prdframe(out, deriv = deriv, sensitivities = sens, parameters = pars)
-# 
-#   }
-# 
-#   attr(P2X, "parameters") <- NULL
-#   attr(P2X, "equations") <- NULL
-#   attr(P2X, "forcings") <- NULL
-#   attr(P2X, "events") <- NULL
-# 
-# 
-#   prdfn(P2X, NULL, condition)
-# 
-# 
-# 
-# 
-# }
-
+#' Generate a prediction function that returns times
+#'
+#' Function to deal with non-ODE models within the framework of dMod. See example.
+#'
+#' @param condition  either NULL (generic prediction for any condition) or a character, denoting
+#' the condition for which the function makes a prediction.
+#' @return Object of class [prdfn].
+#' @examples
+#' x <- Xt()
+#' g <- Y(c(y = "a*time^2+b"), f = NULL, parameters = c("a", "b"))
+#'
+#' times <- seq(-1, 1, by = .05)
+#' pars <- c(a = .1, b = 1)
+#'
+#' plot((g*x)(times, pars))
+#' @export
+Xt <- function(condition = NULL) {
+  # Controls to be modified from outside
+  controls <- list()
+  P2X <- function(times, pars, deriv = TRUE, deriv2 = FALSE, ...) {
+    n_times <- length(times)
+    n_pars <- length(pars)
+    par_names <- names(pars)
+    
+    # Output: matrix with time column
+    out <- matrix(times, ncol = 1, dimnames = list(NULL, "time"))
+    
+    # Sensitivities (deriv): 3D array [n_times, n_states, n_pars]
+    # time has no dependence on parameters, so all zeros
+    sens <- array(0, 
+                  dim = c(n_times, 1, n_pars),
+                  dimnames = list(NULL, "time", par_names))
+    
+    # Second derivatives (deriv2): 4D array [n_times, n_states, n_pars, n_pars]
+    # All zeros since time is independent of parameters
+    deriv2_arr <- array(0,
+                        dim = c(n_times, 1, n_pars, n_pars),
+                        dimnames = list(NULL, "time", par_names, par_names))
+    
+    prdframe(out, deriv = sens, deriv2 = deriv2_arr, parameters = pars)
+  }
+  attr(P2X, "parameters") <- NULL
+  attr(P2X, "equations") <- NULL
+  attr(P2X, "forcings") <- NULL
+  attr(P2X, "events") <- NULL
+  prdfn(P2X, NULL, condition)
+}
 
 
 #' An identity function which vanishes upon concatenation of fns