Multiple Code chunk handler — chunks • teal.code

chunks is a specialized stack for call objects and comments. It is intended to capture and evaluate R code for a sequence of analysis steps.

Format

An R6Class generator object

Methods

initialize(envir = new.env())

Initializes the object.

\code{envir}: (optional) environment to get objects from to chunks environment

push(x, id)

This method adds an expression code chunk or comment code chunk to this object. If no id is given a random id is generated.

  The method needs the parameter \code{x}. In case this is of type \code{call} and the code will
  be evaluated via \code{eval}. Additionally, the code can be given as a string and a comment will be inserted.

eval()

This method applies the eval_id method to each code chunk stored inside this object.

   This method should not be evaluated multiple times, else it throws a warning. This is due to the
   fact that multiple evaluations of the following second code snippet is dangerous:
   \itemize{
     \item{1 }{a <- 2}
     \item{2 }{a <- a + 1}
   }
   \code{eval} evaluates code just once and warn user if one tries to evaluate multiple times.

get_rcode()

Run get_rcode_id for all code chunks inside this object.

get_warnings()

Return warnings encountered during execution of the code inside the object.

get_messages()

Return list of warnings encountered during execution of the code inside the object.

eval_info(ids = private$get_call_ids())

Accepts a vector of chunk ids. Returns a list with evaluation information about each chunk (messages, warnings, errors). Default is to hide information about all chunk_comment objects. Pass chunk ids to see information about specific ids.

reset()

Delete all chunks handles inside this stack and reset environment.

info()

Print all private content. Used for debugging only.

info_msg()

Get an information about how the evaluation of the chunk stack went. Most useful if is_ok() returns FALSE.

get(var, inherits = FALSE)

Returns variable from chunks environment. For more information see get.

is_ok()

Checks if all chunks are evaluated and if there is any error.

get_eval_msg()

Returns error message if there is any error.

validate_is_ok(msg)

Return shiny's validation error with custom message if is_ok returns FALSE.

validate_is(var, class, msg)

Return shiny's validation error with custom message if var is not of class class.

validate_all(var, class, msg)

Return shiny's validation error with custom message if is_ok returns FALSE or var is not of class class.

ls(all.names = FALSE)

Return a vector of bindings present in the environment of a chunks object. See ls for more information.

get_reactive_summary()

Return a shiny::reactiveValues object with three elements: msgs, warnings, errors. Each element is a logical vector with values corresponding to chunk objects inside chunks. TRUE in the msgs vector indicates at least one message was returned in a corresponding chunk. TRUE in the warnings vector indicates at least one warning was returned. TRUE in the errors vector indicates an error was thrown.

Examples

x <- chunks$new()

x$push(id = "test_1", x = call("print", 1))
res <- x$eval()
#> [1] 1
res
#> [1] 1

x$push(id = "test_2", x = call("print", 2))
x$push(id = "test_3", x = call("print", 3))
res <- x$eval()
#> [1] 2
#> [1] 3
res
#> [1] 3
# Below gives a warning
if (FALSE) {
chunks_eval(chunks = x)
}

x$push(id = "test_4", x = call("print", 4))
x$get_rcode()
#>     test_1     test_2     test_3     test_4 
#> "print(1)" "print(2)" "print(3)" "print(4)" 

x$get_rcode()
#>     test_1     test_2     test_3     test_4 
#> "print(1)" "print(2)" "print(3)" "print(4)" 

# Error handling
x$push(id = "test_error", x = call("stop", "test"))
x$eval() # returns NULL, does not rise an error
#> [1] 4
x$is_ok() # FALSE
#> [1] FALSE
x$info_msg()
#> [1] "The following errors(s) occurred:\ntest\n\nwhen evaluating the following code:\nstop(\"test\")\n"
# Below used inside shiny apps
if (FALSE) {
x$validate_is_ok("This is my custom error message")
}

x$info()
#> $envir
#> <environment: 0x55ec530698f8>
#> 
#> $id
#> [1] "test_1"     "test_2"     "test_3"     "test_4"     "test_error"
#> 
#> $is_evaluated
#> [1] TRUE TRUE TRUE TRUE TRUE
#> 
#> $is_remaining
#> [1] FALSE FALSE FALSE FALSE FALSE
#> 
#> $is_error
#> [1] FALSE FALSE FALSE FALSE  TRUE
#> 
#> $is_warning
#> [1] FALSE FALSE FALSE FALSE FALSE
#> 
#> $is_message
#> [1] FALSE FALSE FALSE FALSE FALSE
#> 
#> $eval_msg
#> [1] "The following errors(s) occurred:\ntest\n\nwhen evaluating the following code:\nstop(\"test\")\n"
#> 
#> $code_chunks
#> $code_chunks[[1]]
#> <chunk_call>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     eval: function (envir = parent.frame()) 
#>     get_errors: function () 
#>     get_eval_info: function () 
#>     get_messages: function () 
#>     get_rcode: function (envir = parent.frame()) 
#>     get_warnings: function () 
#>     info: function () 
#>     info_msg: function () 
#>     initialize: function (expression = NULL) 
#>     is_errors: function () 
#>     is_evaluated: function () 
#>     is_messages: function () 
#>     is_ok: function () 
#>     is_warnings: function () 
#>     reset: function () 
#>   Private:
#>     .is_errors: FALSE
#>     .is_evaluated: TRUE
#>     .is_messages: FALSE
#>     .is_warnings: FALSE
#>     deparse: function (x) 
#>     errors: 
#>     eval_msg: 
#>     expression: call
#>     messages: 
#>     set_expression: function (expression) 
#>     warnings: 
#> 
#> $code_chunks[[2]]
#> <chunk_call>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     eval: function (envir = parent.frame()) 
#>     get_errors: function () 
#>     get_eval_info: function () 
#>     get_messages: function () 
#>     get_rcode: function (envir = parent.frame()) 
#>     get_warnings: function () 
#>     info: function () 
#>     info_msg: function () 
#>     initialize: function (expression = NULL) 
#>     is_errors: function () 
#>     is_evaluated: function () 
#>     is_messages: function () 
#>     is_ok: function () 
#>     is_warnings: function () 
#>     reset: function () 
#>   Private:
#>     .is_errors: FALSE
#>     .is_evaluated: TRUE
#>     .is_messages: FALSE
#>     .is_warnings: FALSE
#>     deparse: function (x) 
#>     errors: 
#>     eval_msg: 
#>     expression: call
#>     messages: 
#>     set_expression: function (expression) 
#>     warnings: 
#> 
#> $code_chunks[[3]]
#> <chunk_call>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     eval: function (envir = parent.frame()) 
#>     get_errors: function () 
#>     get_eval_info: function () 
#>     get_messages: function () 
#>     get_rcode: function (envir = parent.frame()) 
#>     get_warnings: function () 
#>     info: function () 
#>     info_msg: function () 
#>     initialize: function (expression = NULL) 
#>     is_errors: function () 
#>     is_evaluated: function () 
#>     is_messages: function () 
#>     is_ok: function () 
#>     is_warnings: function () 
#>     reset: function () 
#>   Private:
#>     .is_errors: FALSE
#>     .is_evaluated: TRUE
#>     .is_messages: FALSE
#>     .is_warnings: FALSE
#>     deparse: function (x) 
#>     errors: 
#>     eval_msg: 
#>     expression: call
#>     messages: 
#>     set_expression: function (expression) 
#>     warnings: 
#> 
#> $code_chunks[[4]]
#> <chunk_call>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     eval: function (envir = parent.frame()) 
#>     get_errors: function () 
#>     get_eval_info: function () 
#>     get_messages: function () 
#>     get_rcode: function (envir = parent.frame()) 
#>     get_warnings: function () 
#>     info: function () 
#>     info_msg: function () 
#>     initialize: function (expression = NULL) 
#>     is_errors: function () 
#>     is_evaluated: function () 
#>     is_messages: function () 
#>     is_ok: function () 
#>     is_warnings: function () 
#>     reset: function () 
#>   Private:
#>     .is_errors: FALSE
#>     .is_evaluated: TRUE
#>     .is_messages: FALSE
#>     .is_warnings: FALSE
#>     deparse: function (x) 
#>     errors: 
#>     eval_msg: 
#>     expression: call
#>     messages: 
#>     set_expression: function (expression) 
#>     warnings: 
#> 
#> $code_chunks[[5]]
#> <chunk_call>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     eval: function (envir = parent.frame()) 
#>     get_errors: function () 
#>     get_eval_info: function () 
#>     get_messages: function () 
#>     get_rcode: function (envir = parent.frame()) 
#>     get_warnings: function () 
#>     info: function () 
#>     info_msg: function () 
#>     initialize: function (expression = NULL) 
#>     is_errors: function () 
#>     is_evaluated: function () 
#>     is_messages: function () 
#>     is_ok: function () 
#>     is_warnings: function () 
#>     reset: function () 
#>   Private:
#>     .is_errors: TRUE
#>     .is_evaluated: TRUE
#>     .is_messages: FALSE
#>     .is_warnings: FALSE
#>     deparse: function (x) 
#>     errors: test
#>     eval_msg: test
#>     expression: call
#>     messages: 
#>     set_expression: function (expression) 
#>     warnings: 
#> 
#> 
#> $latest_result
#> NULL
#> 

# Analysis Example

x <- chunks$new()
x$push("# Prepare Data")
x$push(quote(x <- iris$Sepal.Length))
x$push(quote({
  y <- iris$Petal.Length
  {
    col <- iris$Species
  }
}))

x$eval()
#>   [1] setosa     setosa     setosa     setosa     setosa     setosa    
#>   [7] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [13] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [19] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [25] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [31] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [37] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [43] setosa     setosa     setosa     setosa     setosa     setosa    
#>  [49] setosa     setosa     versicolor versicolor versicolor versicolor
#>  [55] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [61] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [67] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [73] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [79] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [85] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [91] versicolor versicolor versicolor versicolor versicolor versicolor
#>  [97] versicolor versicolor versicolor versicolor virginica  virginica 
#> [103] virginica  virginica  virginica  virginica  virginica  virginica 
#> [109] virginica  virginica  virginica  virginica  virginica  virginica 
#> [115] virginica  virginica  virginica  virginica  virginica  virginica 
#> [121] virginica  virginica  virginica  virginica  virginica  virginica 
#> [127] virginica  virginica  virginica  virginica  virginica  virginica 
#> [133] virginica  virginica  virginica  virginica  virginica  virginica 
#> [139] virginica  virginica  virginica  virginica  virginica  virginica 
#> [145] virginica  virginica  virginica  virginica  virginica  virginica 
#> Levels: setosa versicolor virginica
x$get("col")[1:5]
#> [1] setosa setosa setosa setosa setosa
#> Levels: setosa versicolor virginica
if (FALSE) {
x$get("mean") # should not scope in getter
}

x$push("") # newline
x$push("# Analysis")
x$push(quote(plot(x, y, col = col)))

x$is_ok()
#> [1] FALSE
x$eval()

#> NULL
x$is_ok() # now all chunks were evaluated and no errors occured
#> [1] TRUE

cat(paste(x$get_rcode(), collapse = "\n"))
#> # Prepare Data
#> x <- iris$Sepal.Length
#> y <- iris$Petal.Length
#> col <- iris$Species
#>  
#> # Analysis
#> plot(x, y, col = col)