Title: | Code Storage and Execution Class for 'teal' Applications |
---|---|
Description: | Introduction of 'qenv' S4 class, that facilitates code execution and reproducibility in 'teal' applications. |
Authors: | Dawid Kaledkowski [aut, cre], Aleksander Chlebowski [aut], Marcin Kosinski [aut], Pawel Rucki [aut], Nikolas Burkoff [aut], Mahmoud Hallal [aut], Maciej Nasinski [aut], Konrad Pagacz [aut], Junlue Zhao [aut], Chendi Liao [rev], Dony Unardi [rev], F. Hoffmann-La Roche AG [cph, fnd] |
Maintainer: | Dawid Kaledkowski <[email protected]> |
License: | Apache License 2.0 |
Version: | 0.5.0.9012 |
Built: | 2024-10-29 08:18:28 UTC |
Source: | https://github.com/insightsengineering/teal.code |
qenv
objectsCombine two qenv
objects by simple concatenate their environments and the code.
concat(x, y)
concat(x, y)
x |
( |
y |
( |
We recommend to use the join
method to have a stricter control
in case x
and y
contain duplicated bindings and code.
RHS argument content has priority over the LHS one.
qenv
object.
q <- qenv() q1 <- eval_code(q, expression(iris1 <- iris, mtcars1 <- mtcars)) q2 <- q1 q1 <- eval_code(q1, "iris2 <- iris") q2 <- eval_code(q2, "mtcars2 <- mtcars") qq <- concat(q1, q2) get_code(qq)
q <- qenv() q1 <- eval_code(q, expression(iris1 <- iris, mtcars1 <- mtcars)) q2 <- q1 q1 <- eval_code(q1, "iris2 <- iris") q2 <- eval_code(q2, "mtcars2 <- mtcars") qq <- concat(q1, q2) get_code(qq)
This function opens a PDF graphics device using grDevices::pdf
to suppress
the plot display in the IDE. The purpose of this function is to avoid opening graphic devices
directly in the IDE.
dev_suppress(x)
dev_suppress(x)
x |
lazy binding which generates the plot(s) |
The function uses base::on.exit
to ensure that the PDF graphics
device is closed (using grDevices::dev.off
) when the function exits,
regardless of whether it exits normally or due to an error. This is necessary to
clean up the graphics device properly and avoid any potential issues.
No return value, called for side effects.
dev_suppress(plot(1:10))
dev_suppress(plot(1:10))
qenv
The access of environment included in qenv@env
allows to e.g. list object names included in qenv@env
slot.
get_env(object)
get_env(object)
object |
( |
An environment
stored in qenv@env
slot.
q <- qenv() q1 <- within(q, { a <- 5 b <- data.frame(x = 1:10) }) get_env(q1) ls(get_env(q1))
q <- qenv() q1 <- within(q, { a <- 5 b <- data.frame(x = 1:10) }) get_env(q1) ls(get_env(q1))
qenv
Retrieve variables from the qenv
environment.
get_var(object, var) ## S4 method for signature 'qenv' x[[i]]
get_var(object, var) ## S4 method for signature 'qenv' x[[i]]
object , x
|
( |
var , i
|
( |
The value of required variable (var
) within qenv
object.
q <- qenv() q1 <- eval_code(q, code = quote(a <- 1)) q2 <- eval_code(q1, code = "b <- a") get_var(q2, "b") q2[["b"]]
q <- qenv() q1 <- eval_code(q, code = quote(a <- 1)) q2 <- eval_code(q1, code = "b <- a") get_var(q2, "b") q2[["b"]]
qenv
objectRetrieve all warnings raised during code evaluation in a qenv
.
get_warnings(object)
get_warnings(object)
object |
( |
character
containing warning information or NULL
if no warnings.
data_q <- qenv() data_q <- eval_code(data_q, "iris_data <- iris") warning_qenv <- eval_code( data_q, bquote(p <- hist(iris_data[, .("Sepal.Length")], ff = "")) ) cat(get_warnings(warning_qenv))
data_q <- qenv() data_q <- eval_code(data_q, "iris_data <- iris") warning_qenv <- eval_code( data_q, bquote(p <- hist(iris_data[, .("Sepal.Length")], ff = "")) ) cat(get_warnings(warning_qenv))
qenv
objectsChecks and merges two qenv
objects into one qenv
object.
join(x, y)
join(x, y)
x |
( |
y |
( |
Any common code at the start of the qenvs
is only placed once at the start of the joined qenv
.
This allows consistent behavior when joining qenvs
which share a common ancestor.
See below for an example.
There are some situations where join()
cannot be properly performed, such as these three scenarios:
Both qenv
objects contain an object of the same name but are not identical.
Example:
x <- eval_code(qenv(), expression(mtcars1 <- mtcars)) y <- eval_code(qenv(), expression(mtcars1 <- mtcars['wt'])) z <- join(x, y) # Error message will occur
In this example, mtcars1
object exists in both x
and y
objects but the content are not identical.
mtcars1
in the x qenv
object has more columns than mtcars1
in the y qenv
object (only has one column).
join()
will look for identical @id
values in both qenv
objects.
The index position of these @id
s must be the same to determine the evaluation order.
Otherwise, join()
will throw an error message.
Example:
common_q <- eval_code(qenv(), expression(v <- 1)) x <- eval_code( common_q, "x <- v" ) y <- eval_code( common_q, "y <- v" ) z <- eval_code( y, "z <- v" ) q <- join(x, y) join_q <- join(q, z) # Error message will occur # Check the order of evaluation based on the id slot shared_ids <- intersect(q@id, z@id) match(shared_ids, q@id) # Output: 1 3 match(shared_ids, z@id) # Output: 1 2
The error occurs because the index position of identical @id
between the two objects is not the same.
The usage of temporary variable in the code expression could cause join()
to fail.
Example:
common_q <- qenv() x <- eval_code( common_q, "x <- numeric(0) for (i in 1:2) { x <- c(x, i) }" ) y <- eval_code( common_q, "y <- numeric(0) for (i in 1:3) { y <- c(y, i) }" ) q <- join(x,y) # Error message will occur # Check the value of temporary variable i in both objects x@env$i # Output: 2 y@env$i # Output: 3
join()
fails to provide a proper result because of the temporary variable i
exists
in both objects but has different value.
To fix this, we can set i <- NULL
in the code expression for both objects.
common_q <- qenv() x <- eval_code( common_q, "x <- numeric(0) for (i in 1:2) { x <- c(x, i) } # dummy i variable to fix it i <- NULL" ) y <- eval_code( common_q, "y <- numeric(0) for (i in 1:3) { y <- c(y, i) } # dummy i variable to fix it i <- NULL" ) q <- join(x,y)
qenv
object.
q <- qenv() q1 <- eval_code(q, expression(iris1 <- iris, mtcars1 <- mtcars)) q2 <- q1 q1 <- eval_code(q1, "iris2 <- iris") q2 <- eval_code(q2, "mtcars2 <- mtcars") qq <- join(q1, q2) get_code(qq) common_q <- eval_code(q, quote(x <- 1)) y_q <- eval_code(common_q, quote(y <- x * 2)) z_q <- eval_code(common_q, quote(z <- x * 3)) join_q <- join(y_q, z_q) # get_code only has "x <- 1" occurring once get_code(join_q)
q <- qenv() q1 <- eval_code(q, expression(iris1 <- iris, mtcars1 <- mtcars)) q2 <- q1 q1 <- eval_code(q1, "iris2 <- iris") q2 <- eval_code(q2, "mtcars2 <- mtcars") qq <- join(q1, q2) get_code(qq) common_q <- eval_code(q, quote(x <- 1)) y_q <- eval_code(common_q, quote(y <- x * 2)) z_q <- eval_code(common_q, quote(z <- x * 3)) join_q <- join(y_q, z_q) # get_code only has "x <- 1" occurring once get_code(join_q)
qenv
objectCreate a qenv
object and evaluate code in it to track code history.
qenv() new_qenv(env = new.env(parent = parent.env(.GlobalEnv)), code = character()) eval_code(object, code) get_code(object, deparse = TRUE, names = NULL, ...) ## S3 method for class 'qenv' within(data, expr, ...)
qenv() new_qenv(env = new.env(parent = parent.env(.GlobalEnv)), code = character()) eval_code(object, code) get_code(object, deparse = TRUE, names = NULL, ...) ## S3 method for class 'qenv' within(data, expr, ...)
qenv()
instantiates a qenv
with an empty environment.
Any changes must be made by evaluating code in it with eval_code
or within
, thereby ensuring reproducibility.
new_qenv()
( and not recommended)
can instantiate a qenv
object with data in the environment and code registered.
eval_code
evaluates given code in the qenv
environment and appends it to the code
slot.
Thus, if the qenv
had been instantiated empty, contents of the environment are always a result of the stored code.
get_code
retrieves the code stored in the qenv
. ...
passes arguments to methods.
within
is a convenience function for evaluating inline code inside the environment of a qenv
.
It is a method for the base
generic that wraps eval_code
to provide a simplified way of passing code.
within
accepts only inline expressions (both simple and compound) and allows for injecting values into expr
through the ...
argument:
as name:value
pairs are passed to ...
, name
in expr
will be replaced with value
.
qenv
and new_qenv
return a qenv
object.
eval_code
returns a qenv
object with expr
evaluated or qenv.error
if evaluation fails.
get_code
returns the traced code (from @code
slot) in the form specified by deparse
.
within
returns a qenv
object with expr
evaluated or qenv.error
if evaluation fails.
When names
is specified, the code returned will be limited to the lines needed to create
the requested objects. The code stored in the @code
slot is analyzed statically to determine
which lines the objects of interest depend upon. The analysis works well when objects are created
with standard infix assignment operators (see ?assignOps
) but it can fail in some situations.
Consider the following examples:
Case 1: Usual assignments.
q1 <- qenv() |> within({ foo <- function(x) { x + 1 } x <- 0 y <- foo(x) }) get_code(q1, names = "y")
x
has no dependencies, so get_code(data, names = "x")
will return only the second call.y
depends on x
and foo
, so get_code(data, names = "y")
will contain all three calls.
Case 2: Some objects are created by a function's side effects.
q2 <- qenv() |> within({ foo <- function() { x <<- x + 1 } x <- 0 foo() y <- x }) get_code(q2, names = "y")
Here, y
depends on x
but x
is modified by foo
as a side effect (not by reassignment)
and so get_code(data, names = "y")
will not return the foo()
call.
To overcome this limitation, code dependencies can be specified manually.
Lines where side effects occur can be flagged by adding "# @linksto <object name>
" at the end.
Note that within
evaluates code passed to expr
as is and comments are ignored.
In order to include comments in code one must use the eval_code
function instead.
q3 <- qenv() |> eval_code(" foo <- function() { x <<- x + 1 } x <- 0 foo() # @linksto x y <- x ") get_code(q3, names = "y")
Now the foo()
call will be properly included in the code required to recreate y
.
Note that two functions that create objects as side effects, assign
and data
, are handled automatically.
Here are known cases where manual tagging is necessary:
non-standard assignment operators, e.g. %<>%
objects used as conditions in if
statements: if (<condition>)
objects used to iterate over in for
loops: for(i in <sequence>)
creating and evaluating language objects, e.g. eval(<call>)
within
Passing language objects to expr
is generally not intended but can be achieved with do.call
.
Only single expression
s will work and substitution is not available. See examples.
base::within()
, get_var()
, get_env()
, get_warnings()
, join()
, concat()
# create empty qenv qenv() # create qenv with data and code (deprecated) new_qenv(env = list2env(list(a = 1)), code = quote(a <- 1)) new_qenv(env = list2env(list(a = 1)), code = parse(text = "a <- 1", keep.source = TRUE)) new_qenv(env = list2env(list(a = 1)), code = "a <- 1") # evaluate code in qenv q <- qenv() q <- eval_code(q, "a <- 1") q <- eval_code(q, quote(library(checkmate))) q <- eval_code(q, expression(assert_number(a))) # retrieve code q <- within(qenv(), { a <- 1 b <- 2 }) get_code(q) get_code(q, deparse = FALSE) get_code(q, names = "a") q <- qenv() q <- eval_code(q, code = c("a <- 1", "b <- 2")) get_code(q, names = "a") # evaluate code using within q <- qenv() q <- within(q, { i <- iris }) q <- within(q, { m <- mtcars f <- faithful }) q get_code(q) # inject values into code q <- qenv() q <- within(q, i <- iris) within(q, print(dim(subset(i, Species == "virginica")))) within(q, print(dim(subset(i, Species == species)))) # fails within(q, print(dim(subset(i, Species == species))), species = "versicolor") species_external <- "versicolor" within(q, print(dim(subset(i, Species == species))), species = species_external) # pass language objects expr <- expression(i <- iris, m <- mtcars) within(q, expr) # fails do.call(within, list(q, expr)) exprlist <- list(expression(i <- iris), expression(m <- mtcars)) within(q, exprlist) # fails do.call(within, list(q, do.call(c, exprlist)))
# create empty qenv qenv() # create qenv with data and code (deprecated) new_qenv(env = list2env(list(a = 1)), code = quote(a <- 1)) new_qenv(env = list2env(list(a = 1)), code = parse(text = "a <- 1", keep.source = TRUE)) new_qenv(env = list2env(list(a = 1)), code = "a <- 1") # evaluate code in qenv q <- qenv() q <- eval_code(q, "a <- 1") q <- eval_code(q, quote(library(checkmate))) q <- eval_code(q, expression(assert_number(a))) # retrieve code q <- within(qenv(), { a <- 1 b <- 2 }) get_code(q) get_code(q, deparse = FALSE) get_code(q, names = "a") q <- qenv() q <- eval_code(q, code = c("a <- 1", "b <- 2")) get_code(q, names = "a") # evaluate code using within q <- qenv() q <- within(q, { i <- iris }) q <- within(q, { m <- mtcars f <- faithful }) q get_code(q) # inject values into code q <- qenv() q <- within(q, i <- iris) within(q, print(dim(subset(i, Species == "virginica")))) within(q, print(dim(subset(i, Species == species)))) # fails within(q, print(dim(subset(i, Species == species))), species = "versicolor") species_external <- "versicolor" within(q, print(dim(subset(i, Species == species))), species = species_external) # pass language objects expr <- expression(i <- iris, m <- mtcars) within(q, expr) # fails do.call(within, list(q, expr)) exprlist <- list(expression(i <- iris), expression(m <- mtcars)) within(q, exprlist) # fails do.call(within, list(q, do.call(c, exprlist)))
qenv
objectPrints the qenv
object.
## S4 method for signature 'qenv' show(object)
## S4 method for signature 'qenv' show(object)
object |
( |
object
, invisibly.
q <- qenv() q1 <- eval_code(q, expression(a <- 5, b <- data.frame(x = 1:10))) q1
q <- qenv() q1 <- eval_code(q, expression(a <- 5, b <- data.frame(x = 1:10))) q1