Testing private methods in R6 classes in R - r

I am currently using R6 classes in a project.
I would like to write unit tests that also test the functionality of private methods that I am using (preferably by not going through the more complicated public methods that are using these private methods).
However, I can't access seem to access the private methods.
How do I best do that?
Thanks!

Here is a solution that does not require environment hacking or altering the class you want to test, but instead creating a new class that does the testing for you.
In R6, derived classes have access to private Methods of their base classes (unlike in C++ or Java where you need the protected keyword to archieve the same result). Therefore, you can write a TesterClass that derives from the class you want to test. For example:
ClassToTest <- R6::R6Class(
private = list(
privateMember = 7,
privateFunction = function(x) {
return(x * private$privateMember)
}
)
)
TesterClass <- R6::R6Class(
inherit = ClassToTest,
public = list(
runTest = function(x = 5) {
if (x * private$privateMember != private$privateFunction(x))
cat("Oops. Somethig is wrong\n")
else
cat("Everything is fine\n")
}
)
)
t <- TesterClass$new()
t$runTest()
#> Everything is fine
One advantage of this approach is that you can save detailed test results in the TesterClass.

There is currently a way to access the private environment of an R6 object. However, since this is reaching into an object in an undocumented way, it may break in the future... I don't think that will happen any time soon though.
# Gets private environment from an R6 object
get_private <- function(x) {
x[['.__enclos_env__']]$private
}
A <- R6::R6Class("A",
private = list(x = 1)
)
a <- A$new()
get_private(a)$x
# [1] 1

you can add a helper method get to your class:
...
A <- R6::R6Class(
"A",
private = list(
private_print = function(){print("Ola")}
),
public = list(
get = function(name=NULL){
# recursion
if( length(name)>1 ){
tmp <- lapply(name, self$get)
names(tmp) <- name
return(tmp)
}
if(is.null(name)){
self$message("no input, returning NULL")
return(NULL)
}
# self
if(name=="self"){
return(self)
}
# in self
if( name %in% names(self) ){
return(base::get(name, envir=self))
}
# private or in private
if( exists("private") ){
if(name=="private"){
return(private)
}else if(name %in% names(private) ){
return(base::get(name, envir=private))
}
}
# else
self$message("name not found")
return(NULL)
}
)
)
...
Than use it like this:
a <- A$new()
a$get("private_print")()
## [1] "Ola"

Related

Use of environment in validate_that in R

I am trying to write my own test-function (test_if) that returns both the result of the test as well as an optional error message. The function is based on the validate_that function in the assertthat-package.
The test_if function seems to work, however, I further want to use test_if in a more specific function (check_input) that analyses user-inputs in shiny. There I have a problem, that the check_input-function only works, if I define the test_if function inside the check_input function.
I suppose that the problem is caused by some search scope or environment problem. However, I am really a newbie to environments in R.
How can I get my check_input-function work without the need to define the test_if function inside it?
Many thanks, Silke
Here is my minimal working example:
library(assertthat)
test_if <- function(...,msg=NULL) {
test <- validate_that(...,msg=msg)
if (is.logical(test)) {
return(list(assertation=test,msg=NULL))
}
if (is.character(test)) {
return(list(assertation=FALSE,msg=test))
}
}
test_if(2==3)
test_if(3==3)
test_if(2==3,3==4,msg="something is wrong")
### To check different inputs
check_input1 <- function(value1 = NULL,value2 = NULL) {
test_if <- function(...,msg=NULL) {
test <- validate_that(...,msg=msg)
if (is.logical(test)) {
return(list(assertation=test,msg=NULL))
}
if (is.character(test)) {
return(list(assertation=FALSE,msg=test))
}
}
error_msg <- ""
error_status <- FALSE
check <- test_if(is.numeric(value1))
error_msg <- check$msg
error_status <- check$assertation
return(list(error_msg=error_msg,error_status=error_status))
}
check_input2 <- function(value1 = NULL,value2 = NULL) {
error_msg <- ""
error_status <- FALSE
check <- test_if(is.numeric(value1))
error_msg <- check$msg
error_status <- check$assertation
return(list(error_msg=error_msg,error_status=error_status))
}
check_input1(value1=1)
check_input2(value1=1)

Is there a variable listing in RStudio (or R) like in SPSS?

RStudio provides a nice function View (with uppercase V) to take a look into the data, but with R it's still nasty to get orientation in a large data set. The most common options are...
names(df)
str(df)
If you're coming from SPSS, R seems like a downgrade in this respect. I wondered whether there is a more user-friendly option? I did not find a ready-one, so I'd like to share my solution with you.
Using RStudio's built-in function View, it's white simple to have a variable listing for a data.frame similar to the one in SPSS. This function creates a new data.frame with the variable information and displays in the RStudio GUI via View.
# Better variables view
Varlist = function(sia) {
# Init varlist output
varlist = data.frame(row.names = names(sia))
varlist[["comment"]] = NA
varlist[["type"]] = NA
varlist[["values"]] = NA
varlist[["NAs"]] = NA
# Fill with meta information
for (var in names(sia)) {
if (!is.null(comment(sia[[var]]))) {
varlist[[var, "comment"]] = comment(sia[[var]])
}
varlist[[var, "NAs"]] = sum(is.na(sia[[var]]))
if (is.factor(sia[[var]])) {
varlist[[var, "type"]] = "factor"
varlist[[var, "values"]] = paste(levels(sia[[var]]), collapse=", ")
} else if (is.character(sia[[var]])) {
varlist[[var, "type"]] = "character"
} else if (is.logical(sia[[var]])) {
varlist[[var, "type"]] = "logical"
n = sum(!is.na(sia[[var]]))
if (n > 0) {
varlist[[var, "values"]] = paste(round(sum(sia[[var]], na.rm=T) / n * 100), "% TRUE", sep="")
}
} else if (is.numeric(sia[[var]])) {
varlist[[var, "type"]] = typeof(sia[[var]])
n = sum(!is.na(sia[[var]]))
if (n > 0) {
varlist[[var, "values"]] = paste(min(sia[[var]], na.rm=T), "...", max(sia[[var]], na.rm=T))
}
} else {
varlist[[var, "type"]] = typeof(sia[[var]])
}
}
View(varlist)
}
My recommendation is to store that as a file (e.g., Varlist.R) and whever you need it, just type:
source("Varlist.R")
Varlist(df)
Again please take note of the uppercase V using as function name.
Limitation: When working with data.frame, the listing will not be updated unless Varlist(df) is run again.
Note: R has a built-in option to view data with print. If working with pure R, just replace the View(varlist) by print(varlist). Yet, depending on screen size, Hmisc::describe() could be a better option for the console.

R, R6, Formals for Public Method

How can I get the formals for a method definition in an R6 class definition?
A = R6Class("MyClass",inherit=NULL,
public = list(
fun = function(a,b,c){
# Do Something
}
)
)
So for example, in the above, I would like to get the formals for the fun definition, in the same way one can execute, for example, formals(lm)
You can do this by creating an instance of the class:
A = R6Class("MyClass",
inherit=NULL,
public = list(
a = NA,
initialize = function(a){
self$a <- a
},
fun = function(a,b,c){
# Do Something
}
)
)
B <- A$new(5)
formals(B$fun)
or by accessing the public methods of the class
formals(A$public_methods$fun)

R storing variable value in alist

I am trying to use a function to modify another function default settings through formals but my problem is that when I check my function defaults afterwards then nothing has changed. My code (minus unrelated stuff) is:
ScouringSettings <- function(min.MAF=NULL, eq.thresh=NULL){
if (is.null(min.MAF) && is.null(eq.thresh)){
maf <- paste0("Minimum MAF criterion is: ", formals(GeneScour)$min.maf)
eq <- paste0("ChiĀ² HW equilibrium threshold: ", formals(GeneScour)$min.eq)
cat(paste(maf, eq, sep="\n"))
} else if (is.null(eq.thresh)) {
formals(GeneScour) <- alist(gene=, min.maf = min.MAF, min.eq = formals(GeneScour)$min.eq)
} else if (is.null()){
formals(GeneScour) <- alist(gene=, min.maf = formals(GeneScour)$min.maf, min.eq = eq.thresh)
} else {
formals(GeneScour) <- alist(gene=, min.maf = min.maf, min.eq = eq.thresh)
}
}
I thought that maybe it was because of a problem of scope or something so I tried printing out the defaults while still being in my first function and it printed :
$gene
$min.maf
min.MAF
$min.eq
formals(GeneScour)$min.eq
And even when I forcefully type
formals(GeneScour) <- alist(gene=, min.maf = 2, min.eq = formals(GeneScour)$min.eq)
The modification is not carried over outside of the ScouringSettings.
I am a bit lost, how could I manage that ?

Instantiation of reference classes within reference classes - problems with lock() and immutability

I have come across some behaviour from R reference classes I would like to work around. In the following code, reference class B has two fields of reference class A in it.
These fields in B appear to be instantiated (possibly twice) with a zero-argument (default) versions of reference class A before B's initialize() method is called. These instances are then replaced with the correct versions of instance A during B's initialization process. The problem is that if I use lock() from B's instance generator, the initial empty instantiation's of A cannot be replaced in B. Another problem is that reference class A needs a default value in initialize [or a missing(c) test].
Help - suggestions - etc. appreciated.
A <- setRefClass('A',
fields = list(
count = 'numeric'
),
methods = list(
initialize = function (c=0) {
cat('DEBUG: A$initialize(c); where c='); cat(c); cat('\n')
count <<- c
}
)
)
instance.of.A <- A$new(10)
str(instance.of.A)
B <- setRefClass('B',
field = list(
a = 'A',
b = 'A'
),
methods = list(
initialize = function(c) {
a <<- instance.of.A
b <<- getRefClass('A')$new(c)
}
)
)
instance.of.b <- B$new(100)
str(instance.of.b)
Here are two possible solutions:
Don't set fields attribute:
B <- setRefClass('B',
methods = list(
initialize = function(c) {
.self$a = instance.of.A
.self$b =getRefClass('A')$new(c)
}
)
)
Set fields, but use the ANY class:
B <- setRefClass('B',
field = (a="ANY", b="ANY"),
methods = list(
initialize = function(c) {
a <<- instance.of.A
b <<- getRefClass('A')$new(c)
}
)
)
The downside of both these solutions is the type isn't enforced in a and b, i.e.
B$a = "Fred"
is now possible.
Drawing on the above, the solution I am using is (a little long because of the type checking):
A <- setRefClass('A',
fields = list(
count = function(x) {
if (!missing(x)) {
if(class(x) != 'numeric')
stop('Class A: count set by non-number')
.self$count.private <- x
}
.self$count.private
}
),
methods = list(
initialize = function (c=0) {
cat('DEBUG: A$initialize(c); where c='); cat(c); cat('\n')
count <<- c
}
)
)
instance.of.A <- A$new(10)
str(instance.of.A)
B <- setRefClass('B',
field = list(
a = function(x) {
if (!missing(x)) {
if(!inherits(x, 'envRefClass') || class(x)[1] != 'A')
stop('Class B: expecting instance of class A')
.self$a.private <- x
}
.self$a.private
},
b = function(x) {
if (!missing(x)) {
if(!inherits(x, 'envRefClass') || class(x)[1] != 'A')
stop('Class B: expecting instance of class A')
.self$b.private <- x
}
.self$b.private
}
),
methods = list(
initialize = function(c) {
a <<- instance.of.A
b <<- getRefClass('A')$new(c)
}
)
)
instance.of.b <- B$new(100)
str(instance.of.b)

Resources