I'm looking at the code example provided in the R6 class documentation here.
This is the class definition:
Person <- R6Class("Person",
private = list(
.age = NA,
.name = NULL
),
active = list(
age = function(value) {
if (missing(value)) {
private$.age
} else {
stop("`$age` is read only", call. = FALSE)
}
},
name = function(value) {
if (missing(value)) {
private$.name
} else {
stopifnot(is.character(value), length(value) == 1)
private$.name <- value
self
}
}
),
public = list(
initialize = function(name, age = NA) {
private$.name <- name
private$.age <- age
}
)
)
The important part is how the age field is wrapped to be read-only, and the name field is wrapped to perform a validation check before making the assignment.
In my own usecase, I'm not interested in the read-only part, but I am implementing the validation logic. So, focus on the active field for name.
I do not understand why they are following the pattern to return self after the call. How can you chain together assignments? Assuming age wasn't read only, how would it look to try to assign age and name in a chain? I've tried a number of ways, and it never seems to work:
p <- Person$new();
p$age <- 10$name <- "Jill" # obviously doesn't work because how can you reference the name field of 10?
(p$age <- 10)$name <- "Jill" # this looks more likely to work but the parens don't help
p$age(10)$name("Jill") # Does not work, you can't invoke active fields as if they were functions.
# other syntax options?
So, the heart of my question is: if you're using active fields in R6 classes to facilitate some type-checking prior to assignment, you can't really chain those operations together, so why does the official documentation show returning self in the field accessors?
I need to test package loading operations (for my multiversion package) and know that unloading namespaces and stuff is dangerous work. So I want to run every test in a fresh R session. Running my tests in parallel does not meet this demand since it will reuse slaves, and these get dirty.
So I thought callr::r would help me out. Unfortunately I am again stuck with the minimally documented reporters it seems.
The following is a minimal example. Placed in file test-mytest.R.
test_that('test 1', {
expect_equal(2+2, 5)
})
reporter_in <- testthat::get_reporter()
# -- 1 --
reporter_out <- callr::r(
function(reporter) {
reporter <- testthat::with_reporter(reporter, {
testthat::test_that("test inside", {
testthat::expect_equal('this', 'wont match')
})
})
},
args = list(reporter = reporter_in),
show = TRUE
)
# -- 2 --
testthat::set_reporter(reporter_out)
# -- 3 --
test_that('test 2', {
expect_equal(2+2, 8)
})
I called this test file using:
# to be able to check the outcome, work with a specific reporter
summary <- testthat::SummaryReporter$new()
testthat::test_file('./tests/testthat/test-mytest.R', reporter = summary)
Which seems to do what I want, but when looking at the results...
> summary$end_reporter()
== Failed ===============================================================================================
-- 1. Failure (test-load_b_pick_last_true.R:5:5): test 1 ------------------------------------------------
2 + 2 (`actual`) not equal to 5 (`expected`).
`actual`: 4
`expected`: 5
== DONE =================================================================================================
...it is only the first test that is returned.
How it works:
An ordinary test is executed.
The reporter, currently in use, is obtained (-- 1 --)
callr::r is used to call a testthat block including a test.
Within the call, I tried using set_reporter, but with_reporter is practically identical.
The callr::r call returns the reporter (tried it with get_reporter(), but with_reporter also returns the reporter (invisibly))
Now the returned reporter seems fine, but when setting it as the actual reporter with set_reporter, it seems that it is not overwriting the actual reporter.
Note that at -- 2 --, the reporter_out contains both test outcomes.
Question
I am not really sure what I expect it to do, but in the end I want the results to be added to the original reporter ((summary or) reporter_in that is, if that is not some kind of copy).
One workaround I can think of would be to move the actual test execution outside of the callr::r call, but gather the testcases inside.
I think it is neat, as long as you can place these helper functions (see the elaborate example) in your package, you can write tests with little overhead.
It doesn't answer how to work with the 'reporter' object though...
Simple example:
test_outcome <- callr::r(
function() {
# devtools::load_all()
list(
check1 = mypackage::sum(5,5), # some imaginary exported functions sum and name.
check2 = mypackage::name()
)
}
)
test_that('My test case', {
expect_equal(test_outcome$check1, 10)
expect_equal(test_outcome$check2, 'Siete')
})
Elaborate example
Note that from .add_test to .exp_true are only function definitions which can better be included in your package so they will be available when being loaded with devtools::load_all(). load_all also loads not-exported functions by default.
test_outcome <- callr::r(
function() {
# devtools::load_all()
# Defining helper functions
tst <- list(desc = 'My first test', tests = list())
.add_test <- function(type, A, B) {
# To show at least something about what is actually tested when returning the result, we can add the actual `.exp_...` call to the test.
call <- as.character(sys.call(-1))
tst$tests[[length(tst$tests) + 1]] <<- list(
type = type, a = A, b = B,
# (I couldn't find a better way to create a nice call string)
call = paste0(call[1], '(', paste0(collapse = ', ', call[2:length(call)]), ')'))
}
.exp_error <- function(expr, exp_msg) {
err_msg <- ''
tryCatch({expr}, error = function(err) {
err_msg <<- err$message
})
.add_test('error', err_msg, exp_msg)
}
.exp_match <- function(expr, regex) {
.add_test('match', expr, regex)
}
.exp_equal <- function(expr, ref) {
.add_test('equal', expr, ref)
}
.exp_false <- function(expr) {
.add_test('false', expr, FALSE)
}
.exp_true <- function(expr) {
.add_test('true', expr, TRUE)
}
# Performing the tests
.exp_match('My name is Siete', 'My name is .*')
.exp_equal(mypackage::sum(5,5), 10) # some imaginary exported functions sum and name.
.exp_match(mypackage::name(), 'Siete')
.exp_false('package:testthat' %in% search())
return(tst)
},
show = TRUE)
# Performing the actual testthat tests:
.run_test_batch <- function(test_outcome) {
test_that(test_outcome$desc, {
for (test in test_outcome$tests) {
# 'test' is a list with the fields 'type', 'a', 'b' and 'call'.
# Where 'type' can contain 'match', 'error', 'true', 'false' or 'equal'.
if (test$type == 'equal') {
with(test, expect_equal(a, b, label = call))
} else if (test$type == 'true') {
expect_true( test$a, label = test$call)
} else if (test$type == 'false') {
expect_false(test$a, label = test$call)
} else if (test$type %in% c('match', 'error')) {
with(test, expect_match(a, b, label = call))
}
}
})
}
.run_test_batch(test_outcome)
When moving the functions to your package you would need the following initialize function too.
tst <- new.env(parent = emptyenv())
tst$desc = ''
tst$tests = list()
.initialize_test <- function(desc) {
tst$desc = desc
tst$tests = list()
}
It works as follows:
An empty list is created: tst
By calling .exp_... functions, tests are added to that list
The list with tests is returned by the function in callr::r
Then we loop over the list and execute every test
I am trying to extend websocket::Websocket with a method that sends some data and returns the message, so that I can assign it to an object. My question is pretty much identical to https://community.rstudio.com/t/capture-streaming-json-over-websocket/16986. Unfortunately, the user there never revealed how they solved it themselves. My idea was to have the onMessage method return the event$data, i.e. something like:
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello") # returns NULL
but after spending a good hour on the Websocket source code, I am still completely in the dark as to where exactly the callback happens, "R environment wise".
You need to use super assignment operator <<-. <<- is most useful in conjunction with closures to maintain state. Unlike the usual single arrow assignment (<-) that always works on the current level, the double arrow operator can modify variables in parent levels.
my_websocket <- R6::R6Class("My websocket",
inherit = websocket::WebSocket,
public = list(
foo = function(x) {
msg <<- super$send(paste("x"))
return(msg)
} )
)
load_websocket <- function(){
ws <- my_websocket$new("ws://foo.local")
ws$onMessage(function(event) {
return(event$data)
})
return(ws)
}
my_ws <- load_websocket()
my_ws$foo("hello")
I'm using active bindings in an R6 class to check values before assignment to fields. I thought I could use a closure to generate the bindings as below, but this doesn't work.
The binding isn't evaluated in the way I expect (at all?) because the error shows the closure's name argument. What am I missing?
library(R6)
library(pryr)
# pass a field name to create its binding
generate_binding <- function(name) {
function(value) {
if (!missing(value) && length(value) > 0) {
private$name <- value
}
private$name
}
}
bind_x = generate_binding(x_)
# created as intended:
unenclose(bind_x)
# function (value)
# {
# if (!missing(value) && length(value) > 0) {
# private$x_ <- value
# }
# private$x_
# }
MyClass <- R6::R6Class("MyClass",
private = list(
x_ = NULL
),
active = list(
x = bind_x
),
)
my_class_instance <- MyClass$new()
my_class_instance$x <- "foo"
# Error in private$name <- value :
# cannot add bindings to a locked environment
I think you’re misunderstanding how closures work. unenclose is a red herring here (as it doesn’t actually show you what the closure looks like). The closure contains the statement private$name <- value — it does not contain the statement private$x_ <- value.
The usual solution to this problem would be to rewrite the closure such that the unevaluated name argument is deparsed into its string representation, and then used to subset the private environment (private[[name]] <- value). However, this doesn’t work here since R6 active bindings strip closures of their enclosing environment.
This is where unenclose comes in then:
MyClass <- R6::R6Class("MyClass",
private = list(
x_ = NULL
),
active = list(
x = pryr::unenclose(bind_x)
),
)
Is there a way to set options within an environment? Something like
tmp_env = new.env()
within(tmp_env, options(mc.core = 16))
with(tmp_env, {
# run parallel code here
})
I want to switch between using options(mc.core = 16) and options(mc.core = 1) explicitly and don't want to accidentally set off a parallelized computation.
Use a function or other closure (e.g., local()) to set the option, and use on.exit() to guarantee restoration on exit
fun = function() {
old.opt = options(mc.cores=12)
on.exit(options(old.opt))
## do work
}
You could get fancy with something like (based on with.default)
withp = function(expr, cores=4) {
old.opt = options(mc.cores=cores)
on.exit(options(old.opt))
eval(substitute(expr), enclos=parent.frame())
}
and use
withp({
message("hello")
res <- mclapply(1:20, function(i) Sys.getpid())
table(unlist(res))
}, cores=3)