Manage double-dot environments

.github/workflows/pkgdown.yaml

@@ -1,6 +1,8 @@
 on:
   push:
-    branches: release
+    branches: 
+      - main
+      - release
 
 name: pkgdown
 

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: simstudy
 Title: Simulation of Study Data
-Version: 0.2.0
+Version: 0.1.16.9000
 Date: 2020-09-25
 Authors@R: 
     c(person(given = "Keith",

NEWS.md

@@ -4,7 +4,7 @@
 * Moved genCorOrdCat's functionality into genOrdCat. genCorOrdCat is now
   deprecated.
 * Introduced a new system for formula definitions and completely reworked the
-  underlying code. See vignette "NAME".
+  underlying code. See vignette "double-dot".
 * Added new vignettes.
 * Created documentation page: https://kgoldfeld.github.io/simstudy/
 * Fixed bug in trtAssign related new ratio argument.

R/add_correlated_data.R

@@ -95,6 +95,8 @@ addCorData <- function(dtOld, idname, mu, sigma, corMatrix = NULL,
 #' symmetrical and positive semi-definite. It is not a required field; if a
 #' matrix is not provided, then a structure and correlation coefficient rho must
 #' be specified.
+#' @param envir Environment the data definitions are evaluated in.
+#'  Defaults to [base::parent.frame].
 #' @return data.table with added column(s) of correlated data
 #' @examples
 #' defC <- defData(
@@ -143,9 +145,10 @@ addCorData <- function(dtOld, idname, mu, sigma, corMatrix = NULL,
 #' # Check global correlations - should not be as correlated
 #' cor(di[, list(A, B, C, D)])
 #' @concept correlated
+#' @md
 #' @export
 addCorFlex <- function(dt, defs, rho = 0, tau = NULL, corstr = "cs",
-                       corMatrix = NULL) {
+                       corMatrix = NULL, envir = parent.frame()) {
 
   # "Declare" vars to avoid R CMD warning
 
@@ -203,15 +206,30 @@ addCorFlex <- function(dt, defs, rho = 0, tau = NULL, corstr = "cs",
     iLink <- corDefs[i, link]
 
     if (iDist == "binary") {
-      params <- .getBinaryMean(dTemp, formula = iFormula, Size = 1, link = iLink)
+      params <- .getBinaryMean(dTemp,
+        formula = iFormula,
+        size = 1,
+        link = iLink,
+        envir = envir
+      )
 
       V <- dTemp[, stats::qbinom(Unew, 1, params[[1]])]
     } else if (iDist == "poisson") {
-      param1 <- .getPoissonMean(dTemp, formula = iFormula, link = iLink)
+      param1 <- .getPoissonMean(
+        dtSim = dTemp,
+        formula = iFormula,
+        link = iLink,
+        envir = envir
+      )
 
       V <- dTemp[, stats::qpois(Unew, param1)]
     } else if (iDist == "gamma") {
-      mn <- .getGammaMean(dTemp, formula = iFormula, link = iLink)
+      mn <- .getGammaMean(
+        dtSim = dTemp,
+        formula = iFormula,
+        link = iLink,
+        envir = envir
+      )
 
       ### Gamma parameters need to be transformed
 
@@ -221,7 +239,7 @@ addCorFlex <- function(dt, defs, rho = 0, tau = NULL, corstr = "cs",
 
       V <- dTemp[, stats::qgamma(Unew, param1, param2)]
     } else if (iDist == "negBinomial") {
-      mn <- .getNBmean(dTemp, formula = iFormula, link = iLink)
+      mn <- .getNBmean(dTemp, formula = iFormula, link = iLink, envir = envir)
 
       ### NB parameters need to be transformed
 
@@ -231,7 +249,7 @@ addCorFlex <- function(dt, defs, rho = 0, tau = NULL, corstr = "cs",
 
       V <- dTemp[, stats::qnbinom(Unew, param1, param2)]
     } else if (iDist == "normal") {
-      param1 <- .getNormalMean(dTemp, formula = iFormula)
+      param1 <- .getNormalMean(dtSim = dTemp, formula = iFormula, envir = envir)
       param2 <- sqrt(corDefs[i, variance])
 
       V <- dTemp[, stats::qnorm(Unew, param1, param2)]
@@ -645,4 +663,4 @@ addCorGen <- function(dtOld, nvars, idvar = "id", rho, corstr, corMatrix = NULL,
 
 
   return(dtTemp[])
-}
+}

R/add_data.R

@@ -2,6 +2,8 @@
 #'
 #' @param dtDefs name of definitions for added columns
 #' @param dtOld name of data table that is to be updated
+#' @param envir Environment the data definitions are evaluated in.
+#'  Defaults to [base::parent.frame].
 #' @return an updated data.table that contains the added simulated data
 #' @examples
 #' # New data set
@@ -20,8 +22,9 @@
 #' dt <- addColumns(def2, dt)
 #' dt
 #' @concept generate_data
+#' @md
 #' @export
-addColumns <- function(dtDefs, dtOld) {
+addColumns <- function(dtDefs, dtOld, envir = parent.frame()) {
 
   # "declares" varname to avoid global NOTE
   varname <- NULL
@@ -52,7 +55,13 @@ addColumns <- function(dtDefs, dtOld) {
   iter <- nrow(dtDefs)
   n <- nrow(dtOld)
   for (i in (1:iter)) {
-    dtOld <- .generate(dtDefs[i, ], n, dtOld, oldkey)
+    dtOld <- .generate(
+      args = dtDefs[i, ],
+      n = n,
+      dfSim = dtOld,
+      idname = oldkey,
+      envir = envir
+    )
   }
 
   dtOld <- data.table::data.table(dtOld)
@@ -66,7 +75,8 @@ addColumns <- function(dtDefs, dtOld) {
 #' @param condDefs Name of definitions for added column
 #' @param dtOld Name of data table that is to be updated
 #' @param newvar Name of new column to add
-#'
+#' @param envir Environment the data definitions are evaluated in.
+#'  Defaults to [base::parent.frame].
 #' @return An updated data.table that contains the added simulated data
 #' @examples
 #'
@@ -103,9 +113,10 @@ addColumns <- function(dtDefs, dtOld) {
 #' ggplot(data = dt, aes(x = y, y = NewVar, group = x)) +
 #'   geom_point(aes(color = factor(x)))
 #' @export
+#' @md
 #' @concept generate_data
 #' @concept condition
-addCondition <- function(condDefs, dtOld, newvar) {
+addCondition <- function(condDefs, dtOld, newvar, envir = parent.frame()) {
 
   # 'declare' vars
   varname <- NULL
@@ -163,7 +174,13 @@ addCondition <- function(condDefs, dtOld, newvar) {
     n <- nrow(dtTemp)
 
     if (n > 0) {
-      dtTemp <- .generate(cDefs[i, ], n, dtTemp, oldkey)
+      dtTemp <- .generate(
+        args = cDefs[i, ],
+        n = n,
+        dfSim = dtTemp,
+        idname =  oldkey,
+        envir = envir
+      )
 
       dtTemp <- data.table::data.table(dtTemp)
       dtTemp <- dtTemp[, list(get(oldkey), get(newvar))]

R/define_data.R

@@ -89,7 +89,7 @@ defCondition <- function(dtDefs = NULL,
 #' @details The possible data distributions are: `r paste0(.getDists(),collapse = ", ")`.
 #'
 #' @examples
-#' extVar <<- 2.3
+#' extVar <- 2.3
 #' def <- defData(varname = "xNr", dist = "nonrandom", formula = 7, id = "idnum")
 #' def <- defData(def, varname = "xUni", dist = "uniform", formula = "10;20")
 #' def <- defData(def,

R/generate_data.R

@@ -5,8 +5,11 @@
 #'  are provided
 #' a data set with ids only is generated.
 #' @param id The string defining the id of the record
+#' @param envir Environment the data definitions are evaluated in.
+#'  Defaults to [base::parent.frame].
 #' @return A data.table that contains the simulated data.
 #' @export
+#' @md
 #' @concept generate_data
 #' @examples
 #' genData(5)
@@ -43,7 +46,7 @@
 #' def
 #'
 #' genData(5, def)
-genData <- function(n, dtDefs = NULL, id = "id") {
+genData <- function(n, dtDefs = NULL, id = "id", envir = parent.frame()) {
   assertNotMissing(n = missing(n))
   assertValue(n = n, id = id)
   assertType(id = id, type = "character")
@@ -63,7 +66,13 @@ genData <- function(n, dtDefs = NULL, id = "id") {
     iter <- nrow(dtDefs) # generate a column of data for each row of dtDefs
 
     for (i in (1:iter)) {
-      dfSimulate <- .generate(dtDefs[i, ], n, dfSimulate, idname)
+      dfSimulate <- .generate(
+        args = dtDefs[i, ],
+        n = n,
+        dfSim = dfSimulate,
+        idname = idname,
+        envir = envir
+      )
     }
 
     dt <- data.table::data.table(dfSimulate)
@@ -824,4 +833,4 @@ genSurv <- function(dtName, survDefs, digits = 3) {
   }
 
   return(dtSurv[])
-}
+}